packages feed

clash-lib 1.8.3 → 1.8.4

raw patch · 13 files changed

+170/−116 lines, 13 filesdep ~clash-preludedep ~doctest-parallelPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: clash-prelude, doctest-parallel

API changes (from Hackage documentation)

+ Clash.Netlist.Types: declTypeUsage :: DeclarationType -> Usage
- Clash.Netlist: mkFunApp :: HasCallStack => Identifier -> Id -> [Term] -> [Declaration] -> NetlistMonad [Declaration]
+ Clash.Netlist: mkFunApp :: HasCallStack => DeclarationType -> Identifier -> Id -> [Term] -> [Declaration] -> NetlistMonad [Declaration]
- Clash.Netlist: mkProjection :: Bool -> NetlistId -> Term -> Type -> Alt -> NetlistMonad (Expr, [Declaration])
+ Clash.Netlist: mkProjection :: DeclarationType -> Bool -> NetlistId -> Term -> Type -> Alt -> NetlistMonad (Expr, [Declaration])
- Clash.Netlist: toSimpleVar :: Identifier -> (Expr, Type) -> NetlistMonad (Expr, [Declaration])
+ Clash.Netlist: toSimpleVar :: DeclarationType -> Identifier -> (Expr, Type) -> NetlistMonad (Expr, [Declaration])
- Clash.Netlist.BlackBox: mkBlackBoxContext :: HasCallStack => Text -> [Id] -> [Either Term Type] -> NetlistMonad (BlackBoxContext, [Declaration])
+ Clash.Netlist.BlackBox: mkBlackBoxContext :: HasCallStack => Text -> DeclarationType -> [Id] -> [Either Term Type] -> NetlistMonad (BlackBoxContext, [Declaration])
- Clash.Rewrite.Types: bindings :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) BindingMap
+ Clash.Rewrite.Types: bindings :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) BindingMap
- Clash.Rewrite.Types: curFun :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) (Id, SrcSpan)
+ Clash.Rewrite.Types: curFun :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) (Id, SrcSpan)
- Clash.Rewrite.Types: extra :: forall extra_a4GGi extra_a4GRB. Lens (RewriteState extra_a4GGi) (RewriteState extra_a4GRB) extra_a4GGi extra_a4GRB
+ Clash.Rewrite.Types: extra :: forall extra_a4GHC extra_a4GSV. Lens (RewriteState extra_a4GHC) (RewriteState extra_a4GSV) extra_a4GHC extra_a4GSV
- Clash.Rewrite.Types: globalHeap :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) PrimHeap
+ Clash.Rewrite.Types: globalHeap :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) PrimHeap
- Clash.Rewrite.Types: nameCounter :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) Int
+ Clash.Rewrite.Types: nameCounter :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) Int
- Clash.Rewrite.Types: transformCounter :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) Word
+ Clash.Rewrite.Types: transformCounter :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) Word
- Clash.Rewrite.Types: transformCounters :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) (HashMap Text Word)
+ Clash.Rewrite.Types: transformCounters :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) (HashMap Text Word)
- Clash.Rewrite.Types: uniqSupply :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) Supply
+ Clash.Rewrite.Types: uniqSupply :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) Supply
- Clash.Rewrite.Types: workFreeBinders :: forall extra_a4GGi. Lens' (RewriteState extra_a4GGi) (VarEnv Bool)
+ Clash.Rewrite.Types: workFreeBinders :: forall extra_a4GHC. Lens' (RewriteState extra_a4GHC) (VarEnv Bool)

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Changelog for the Clash project +## 1.8.4 *Nov 6th 2025*++Changed:+* Nix flake updated to make it more suitable for use in downstream projects. [#2987](https://github.com/clash-lang/clash-compiler/pull/2987) [#3060](https://github.com/clash-lang/clash-compiler/pull/3060)++Fixed:+* `collapseRHSNoops` now runs after constant folding, making Clash able to constant fold more expressions than before. See [#3036](https://github.com/clash-lang/clash-compiler/issues/3036).+* The `unzip` family no longer retains a reference to the original input for every (unevaluated) part of the output tuple. Similarly, `mapAccumL` and `mapAccumR` are now also more eager to drop references. This can help to prevent space leaks. See [#3038](https://github.com/clash-lang/clash-compiler/issues/3038).+* Individual items of `iterateI` no longer retain a reference to the whole list, preventing space leaks. See [#3042](https://github.com/clash-lang/clash-compiler/issues/3042).+* The compiler now tracks assignment types in more places, which can prevent "clash error call" errors in some specific cases. See [#3045](https://github.com/clash-lang/clash-compiler/issues/3045).+* Test bench primitives now assign the string they want to pass to Verilog's `$display` to a variable before printing. This works around a limitation in IVerilog. See [#3046](https://github.com/clash-lang/clash-compiler/issues/3046).+ ## 1.8.3 *Oct 6th 2025*  Added:
clash-lib.cabal view
@@ -1,6 +1,6 @@ Cabal-version:        2.2 Name:                 clash-lib-Version:              1.8.3+Version:              1.8.4 Synopsis:             Clash: a functional hardware description language - As a library Description:   Clash is a functional hardware description language that borrows both its@@ -151,7 +151,7 @@                       base16-bytestring       >= 0.1.1    && < 1.1,                       binary                  >= 0.8.5    && < 0.11,                       bytestring              >= 0.10.0.2 && < 0.13,-                      clash-prelude           == 1.8.3,+                      clash-prelude           == 1.8.4,                       containers              >= 0.5.0.0  && < 0.8,                       cryptohash-sha256       >= 0.11     && < 0.12,                       data-binary-ieee754     >= 0.4.4    && < 0.6,
prims/verilog/Clash_Explicit_Testbench.primitives.yaml view
@@ -15,8 +15,8 @@       // assert begin       // pragma translate_off       always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin-        if (~ARG[6] !== ~ARG[7]) begin-          $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[5], ~ARG[7], ~ARG[6]);+        if (~VAR[checked][6] !== ~VAR[expected][7]) begin+          $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[5], ~VAR[expected][7], ~VAR[checked][6]);           $finish;         end       end@@ -46,7 +46,7 @@        always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin         if (~SYM[1] !== ~SYM[2]) begin-          $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[4], ~ARG[6], ~ARG[5]);+          $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[4], ~VAR[expected][6], ~VAR[checked][5]);           $finish;         end       end
src/Clash/Netlist.hs view
@@ -363,10 +363,10 @@       go pInfo (BlackBox {resultInits=nmDs, multiResult=True}) = withTicks ticks $ \_ -> do         tcm <- Lens.view tcCache         let (args1, res) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args0-        (bbCtx, _) <- mkBlackBoxContext (primName pInfo) res args1+        (bbCtx, _) <- mkBlackBoxContext (primName pInfo) Concurrent res args1         mapM (go' (primName pInfo) bbCtx) nmDs       go pInfo (BlackBox {resultInits=nmDs}) = withTicks ticks $ \_ -> do-        (bbCtx, _) <- mkBlackBoxContext (primName pInfo) [i] args0+        (bbCtx, _) <- mkBlackBoxContext (primName pInfo) Concurrent [i] args0         mapM (go' (primName pInfo) bbCtx) nmDs       go _ _ = pure [] @@ -413,8 +413,8 @@   -> Term   -- ^ RHS of the let-binder   -> NetlistMonad [Declaration]-mkDeclarations' _declType bndr (collectTicks -> (Var v,ticks)) =-  withTicks ticks (mkFunApp (Id.unsafeFromCoreId bndr) v [])+mkDeclarations' declType bndr (collectTicks -> (Var v,ticks)) =+  withTicks ticks (mkFunApp declType (Id.unsafeFromCoreId bndr) v [])  mkDeclarations' _declType _bndr e@(collectTicks -> (Case _ _ [],_)) = do   (_,sp) <- Lens.use curCompNm@@ -436,7 +436,7 @@   case appF of     Var f       | null tyArgs ->-        withTicks ticks (mkFunApp (Id.unsafeFromCoreId bndr) f args)+        withTicks ticks (mkFunApp declType (Id.unsafeFromCoreId bndr) f args)       | otherwise   -> do         (_,sp) <- Lens.use curCompNm         throw (ClashException sp ($(curLoc) ++ "Not in normal form: Var-application with Type arguments:\n\n" ++ showPpr app) Nothing)@@ -633,12 +633,13 @@ -- | Generate a list of Declarations for a let-binder where the RHS is a function application mkFunApp   :: HasCallStack-  => Identifier -- ^ LHS of the let-binder+  => DeclarationType+  -> Identifier -- ^ LHS of the let-binder   -> Id -- ^ Name of the applied function   -> [Term] -- ^ Function arguments   -> [Declaration] -- ^ Tick declarations   -> NetlistMonad [Declaration]-mkFunApp dstId fun args tickDecls = do+mkFunApp declType dstId fun args tickDecls = do   topAnns <- Lens.use topEntityAnns   tcm     <- Lens.view tcCache   case (isGlobalId fun, lookupVarEnv fun topAnns) of@@ -652,7 +653,7 @@       -> do         argHWTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) fArgTys1         (argExprs, concat -> argDecls) <- unzip <$>-          mapM (\(e,t) -> mkExpr False Concurrent (NetlistId dstId t) e)+          mapM (\(e,t) -> mkExpr False declType (NetlistId dstId t) e)                                  (zip args fArgTys1)          -- Filter void arguments, but make sure to render their declarations:@@ -724,7 +725,7 @@           argHWTys <- mapM coreTypeToHWTypeM' argTys            (argExprs, concat -> argDecls) <- unzip <$>-            mapM (\(e,t) -> mkExpr False Concurrent (NetlistId dstId t) e)+            mapM (\(e,t) -> mkExpr False declType (NetlistId dstId t) e)                  (zip args argTys)            -- Filter void arguments, but make sure to render their declarations:@@ -735,7 +736,7 @@           let compOutp = (\(_,x,_) -> x) <$> listToMaybe co           if length filteredTypeExprs == length compInps             then do-              (argExprs',argDecls') <- (second concat . unzip) <$> mapM (toSimpleVar dstId) filteredTypeExprs+              (argExprs',argDecls') <- (second concat . unzip) <$> mapM (toSimpleVar declType dstId) filteredTypeExprs               let inpAssigns    = zipWith (\(i,t) e -> (Identifier i Nothing,In,t,e)) compInps argExprs'                   outpAssign    = case compOutp of                     Nothing -> []@@ -799,14 +800,16 @@             "Maybe (Int -> Int)"           |] -toSimpleVar :: Identifier+toSimpleVar :: DeclarationType+            -> Identifier             -> (Expr,Type)             -> NetlistMonad (Expr,[Declaration])-toSimpleVar _ (e@(Identifier _ Nothing),_) = return (e,[])-toSimpleVar dstId (e,ty) = do+toSimpleVar _ _ (e@(Identifier _ Nothing),_) = return (e,[])+toSimpleVar declType dstId (e,ty) = do   argNm <- Id.suffix dstId "fun_arg"   hTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty-  argDecl <- mkInit Concurrent Cont argNm hTy e+  let assignTy = declTypeUsage declType+  argDecl <- mkInit declType assignTy argNm hTy e   return (Identifier argNm Nothing, argDecl)  -- | Generate an expression for a term occurring on the RHS of a let-binder@@ -844,14 +847,14 @@             ++ "Var-application with Type arguments:\n\n" ++ showPpr app) Nothing)       | otherwise -> do           argNm <- Id.suffix (netlistId1 id Id.unsafeFromCoreId bndr) "fun_arg"-          decls  <- mkFunApp argNm f tmArgs tickDecls+          decls  <- mkFunApp declType argNm f tmArgs tickDecls           if isVoid hwTyA then             return (Noop, decls)           else             -- This net was already declared in the call to mkSelection.             return ( Identifier argNm Nothing                    , NetDecl Nothing argNm hwTyA : decls)-    Case scrut ty' [alt] -> mkProjection bbEasD bndr scrut ty' alt+    Case scrut ty' [alt] -> mkProjection declType bbEasD bndr scrut ty' alt     Case scrut tyA (alt:alts) -> do       argNm <- Id.suffix (netlistId1 id Id.unsafeFromCoreId bndr) "sel_arg"       decls  <- mkSelection declType (NetlistId argNm (netlistTypes1 bndr))@@ -873,7 +876,8 @@ -- -- Works for both product types, as sum-of-product types. mkProjection-  :: Bool+  :: DeclarationType+  -> Bool   -- ^ Projection must bind to a simple variable   -> NetlistId   -- ^ Name hint for the signal to which the projection is (potentially) assigned@@ -884,8 +888,9 @@   -> Alt   -- ^ The field to be projected   -> NetlistMonad (Expr, [Declaration])-mkProjection mkDec bndr scrut altTy alt@(pat,v) = do+mkProjection declType mkDec bndr scrut altTy alt@(pat,v) = do   tcm <- Lens.view tcCache+  let assignTy = declTypeUsage declType   let scrutTy = inferCoreTypeOf tcm scrut       e = Case scrut scrutTy [alt]   (_,sp) <- Lens.use curCompNm@@ -902,7 +907,7 @@         Id.next         (\b -> Id.suffix (Id.unsafeFromCoreId b) "projection")         bndr-    (scrutExpr,newDecls) <- mkExpr False Concurrent (NetlistId scrutNm scrutTy) scrut+    (scrutExpr,newDecls) <- mkExpr False declType (NetlistId scrutNm scrutTy) scrut     case scrutExpr of       Identifier newId modM ->         pure (Right (newId, modM, newDecls))@@ -913,7 +918,7 @@         -- TODO: seems useless?         pure (Left newDecls)       _ -> do-        scrutDecl <- mkInit Concurrent Cont scrutNm sHwTy scrutExpr+        scrutDecl <- mkInit declType assignTy scrutNm sHwTy scrutExpr         pure (Right (scrutNm, Nothing, newDecls ++ scrutDecl))    case scrutRendered of@@ -950,7 +955,7 @@       case bndr of         NetlistId scrutNm _ | mkDec -> do           scrutNm' <- Id.next scrutNm-          scrutDecl <- mkInit Concurrent Cont scrutNm' vHwTy extractExpr+          scrutDecl <- mkInit declType assignTy scrutNm' vHwTy extractExpr           return (Identifier scrutNm' Nothing, scrutDecl ++ decls)         MultiId {} -> error "mkProjection: MultiId"         _ -> return (extractExpr,decls)@@ -978,7 +983,7 @@   let dcNm = nameOcc (dcName dc)   tcm <- Lens.view tcCache   let argTys = map (inferCoreTypeOf tcm) args-  argNm <- netlistId1 return (\b -> Id.suffix (Id.unsafeFromCoreId b) "_dc_arg") bndr+  argNm <- netlistId1 return (\b -> Id.suffix (Id.unsafeFromCoreId b) "dc_arg") bndr   argHWTys <- mapM coreTypeToHWTypeM' argTys    (argExprs, concat -> argDecls) <- unzip <$>
src/Clash/Netlist.hs-boot view
@@ -50,7 +50,8 @@                 -> NetlistMonad (Expr,[Declaration])  mkProjection-  :: Bool+  :: DeclarationType+  -> Bool   -> NetlistId   -> Term   -> Type@@ -73,7 +74,8 @@  mkFunApp   :: HasCallStack-  => Identifier -- ^ LHS of the let-binder+  => DeclarationType+  -> Identifier -- ^ LHS of the let-binder   -> Id -- ^ Name of the applied function   -> [Term] -- ^ Function arguments   -> [Declaration] -- ^ Tick declarations
src/Clash/Netlist/BlackBox.hs view
@@ -136,18 +136,20 @@   :: HasCallStack   => TextS.Text   -- ^ Blackbox function name+  -> DeclarationType+  -- ^ Are we concurrent or sequential?   -> [Id]   -- ^ Identifiers binding the primitive/blackbox application   -> [Either Term Type]   -- ^ Arguments of the primitive/blackbox application   -> NetlistMonad (BlackBoxContext,[Declaration])-mkBlackBoxContext bbName resIds args@(lefts -> termArgs) = do+mkBlackBoxContext bbName declType resIds args@(lefts -> termArgs) = do     -- Make context inputs     let       resNms = fmap Id.unsafeFromCoreId resIds       resNm = fromMaybe (error "mkBlackBoxContext: head") (listToMaybe resNms)     resTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc) . coreTypeOf) resIds-    (imps,impDecls) <- unzip <$> zipWithM (mkArgument bbName resNm) [0..] termArgs+    (imps,impDecls) <- unzip <$> zipWithM (mkArgument bbName resNm declType) [0..] termArgs     (funs,funDecls) <-       mapAccumLM         (addFunction (map coreTypeOf resIds))@@ -186,7 +188,7 @@          curBBlvl Lens.+= 1         (fs,ds) <- case resIds of-          (resId:_) -> unzip <$> replicateM funcPlurality (mkFunInput bbName resId arg)+          (resId:_) -> unzip <$> replicateM funcPlurality (mkFunInput bbName declType resId arg)           _ -> error "internal error: insufficient resIds"         curBBlvl Lens.-= 1 @@ -269,13 +271,15 @@   -> Identifier   -- ^ LHS of the original let-binder. Is used as a name hint to generate new   -- names in case the argument is a declaration.+  -> DeclarationType+  -- ^ Are we concurrent or sequential?   -> Int   -- ^ Argument n (zero-indexed). Used for error message.   -> Term   -> NetlistMonad ( (Expr,HWType,Bool)                   , [Declaration]                   )-mkArgument bbName bndr nArg e = do+mkArgument bbName bndr declType nArg e = do     tcm   <- Lens.view tcCache     let ty = inferCoreTypeOf tcm e     iw    <- Lens.view intWidth@@ -295,18 +299,18 @@           return ((mkLiteral iw l,hwTy,True),[])          (Prim pinfo,args,ticks) -> withTicks ticks $ \tickDecls -> do-          (e',d) <- mkPrimitive True False Concurrent (NetlistId bndr ty) pinfo args tickDecls+          (e',d) <- mkPrimitive True False declType (NetlistId bndr ty) pinfo args tickDecls           case e' of             (Identifier _ _) -> return ((e',hwTy,False), d)             _                -> return ((e',hwTy,isLiteral e), d)         (Data dc, args,_) -> do-          (exprN,dcDecls) <- mkDcApplication Concurrent [hwTy] (NetlistId bndr ty) dc (lefts args)+          (exprN,dcDecls) <- mkDcApplication declType [hwTy] (NetlistId bndr ty) dc (lefts args)           return ((exprN,hwTy,isLiteral e),dcDecls)         (Case scrut ty' [alt],[],_) -> do-          (projection,decls) <- mkProjection False (NetlistId bndr ty) scrut ty' alt+          (projection,decls) <- mkProjection declType False (NetlistId bndr ty) scrut ty' alt           return ((projection,hwTy,False),decls)         (Let _bnds _term, [], _ticks) -> do-          (exprN, letDecls) <- mkExpr False Concurrent (NetlistId bndr ty) e+          (exprN, letDecls) <- mkExpr False declType (NetlistId bndr ty) e           return ((exprN,hwTy,False),letDecls)         _ -> do           let errMsg = [I.i|@@ -402,6 +406,7 @@   where     tys = netlistTypes dst     ty = fromMaybe (error "mkPrimitive") (listToMaybe tys)+    assignTy = declTypeUsage declType      go       :: CompiledPrimitive@@ -435,7 +440,7 @@           -- from 'resBndr1'.           tcm <- Lens.view tcCache           let (args1, resArgs) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args-          (bbCtx, ctxDcls) <- mkBlackBoxContext (primName pInfo) resArgs args1+          (bbCtx, ctxDcls) <- mkBlackBoxContext (primName pInfo) declType resArgs args1           (templ, templDecl) <- prepareBlackBox name template bbCtx           let bbDecl = N.BlackBoxD name (libraries p) (imports p) (includes p) templ bbCtx           return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])@@ -445,7 +450,7 @@               resM <- resBndr1 True dst               case resM of                 Just (dst',dstNm,dstDecl) -> do-                  (bbCtx,ctxDcls)   <- mkBlackBoxContext (primName pInfo) [dst'] args+                  (bbCtx,ctxDcls)   <- mkBlackBoxContext (primName pInfo) declType [dst'] args                   (templ,templDecl) <- prepareBlackBox pNm template bbCtx                   let bbDecl = N.BlackBoxD pNm (libraries p) (imports p)                                            (includes p) templ bbCtx@@ -456,7 +461,7 @@                 Nothing | RenderVoid <- renderVoid p -> do                   -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists                   let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TDECL_NOOP__" 0)-                  (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args+                  (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) declType [dst1] args                   (templ,templDecl) <- prepareBlackBox pNm template bbCtx                   let bbDecl = N.BlackBoxD pNm (libraries p) (imports p)                                            (includes p) templ bbCtx@@ -470,7 +475,7 @@                   resM <- resBndr1 True dst                   case resM of                     Just (dst',dstNm,dstDecl) -> do-                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst'] args+                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) declType [dst'] args                       (bbTempl,templDecl) <- prepareBlackBox pNm template bbCtx                       let bbE =  BlackBoxE pNm (libraries p) (imports p) (includes p) bbTempl bbCtx bbEParen                       tmpAssgn <- case declType of@@ -482,7 +487,7 @@                     Nothing | RenderVoid <- renderVoid p -> do                       -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists                       let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TEXPRD_NOOP__" 0)-                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args+                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) declType [dst1] args                       (templ,templDecl) <- prepareBlackBox pNm template bbCtx                       let bbDecl = N.BlackBoxD pNm (libraries p) (imports p)                                                (includes p) templ bbCtx@@ -494,7 +499,7 @@                   resM <- resBndr1 False dst                   case resM of                     Just (dst',_,_) -> do-                      (bbCtx,ctxDcls)      <- mkBlackBoxContext (primName pInfo) [dst'] args+                      (bbCtx,ctxDcls)      <- mkBlackBoxContext (primName pInfo) declType [dst'] args                       (bbTempl,templDecl0) <- prepareBlackBox pNm template bbCtx                       let templDecl1 = case primName pInfo of                             "Clash.Sized.Internal.BitVector.fromInteger#"@@ -513,7 +518,7 @@                     Nothing | RenderVoid <- renderVoid p -> do                       -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists                       let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TEXPRE_NOOP__" 0)-                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args+                      (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) declType [dst1] args                       (templ,templDecl) <- prepareBlackBox pNm template bbCtx                       let bbDecl = N.BlackBoxD pNm (libraries p) (imports p)                                                (includes p) templ bbCtx@@ -535,13 +540,12 @@                   tcm     <- Lens.view tcCache                   let scrutTy = inferCoreTypeOf tcm scrut                   (scrutExpr,scrutDecls) <--                    mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$tte_rhs") scrutTy) scrut+                    mkExpr False declType (NetlistId (Id.unsafeMake "c$tte_rhs") scrutTy) scrut                   case scrutExpr of                     Identifier id_ Nothing -> return (DataTag hwTy (Left id_),scrutDecls)                     _ -> do                       scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy                       tmpRhs <- Id.make "c$tte_rhs"-                      let assignTy = case declType of { Concurrent -> Cont ; Sequential -> Proc Blocking }                       netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr                       return (DataTag hwTy (Left tmpRhs), netDecl ++ scrutDecls)                 _ -> error $ $(curLoc) ++ "tagToEnum: " ++ show (map (either showPpr showPpr) args)@@ -554,12 +558,11 @@                 let scrutTy = inferCoreTypeOf tcm scrut                 scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy                 (scrutExpr,scrutDecls) <--                  mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut+                  mkExpr False declType (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut                 case scrutExpr of                   Identifier id_ Nothing -> return (DataTag scrutHTy (Right id_),scrutDecls)                   _ -> do                     tmpRhs <- Id.make "c$dtt_rhs"-                    let assignTy = case declType of { Concurrent -> Cont ; Sequential -> Proc Blocking }                     netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr                     return (DataTag scrutHTy (Right tmpRhs),netDecl ++ scrutDecls)               _ -> error $ $(curLoc) ++ "dataToTag: " ++ show (map (either showPpr showPpr) args)@@ -574,12 +577,11 @@                 let scrutTy = inferCoreTypeOf tcm scrut                 scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy                 (scrutExpr,scrutDecls) <--                  mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut+                  mkExpr False declType (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut                 case scrutExpr of                   Identifier id_ Nothing -> return (DataTag scrutHTy (Right id_),scrutDecls)                   _ -> do                     tmpRhs <- Id.make "c$dtt_rhs"-                    let assignTy = case declType of { Concurrent -> Cont ; Sequential -> Proc Blocking }                     netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr                     return (DataTag scrutHTy (Right tmpRhs),netDecl ++ scrutDecls)               _ -> error $ $(curLoc) ++ "dataToTag: " ++ show (map (either showPpr showPpr) args)@@ -603,8 +605,9 @@                   _ -> case dstNms of                     [dstNm] -> do                       declareUse (Proc Blocking) dstNm+                      assn <- procAssign Blocking dstNm expr                       return ( Identifier dstNm Nothing-                             , dstDecl ++ decls ++ [Assignment dstNm (Proc Blocking) expr])+                             , dstDecl ++ decls ++ [assn])                     _ -> error $ $(curLoc) ++ "bindSimIO: " ++ show resM                 _ ->                   return (Noop,decls)@@ -629,7 +632,8 @@                     assn <- case expr of                               Noop -> pure []                               _ -> do declareUse (Proc Blocking) dstNm-                                      pure [Assignment dstNm (Proc Blocking) expr]+                                      assn <- procAssign Blocking dstNm expr+                                      pure [assn]                     return (Identifier dstNm Nothing, dstDecl ++ bindDecls ++ assn)                   args1 -> error ("internal error: fmapSimIO# has insufficient arguments"                                   <> showPpr args1)@@ -658,22 +662,23 @@                   _ -> case dstNms of                     [dstNm] -> do                       declareUse (Proc Blocking) dstNm+                      assn <- procAssign Blocking dstNm expr                       return ( Identifier dstNm Nothing-                             , dstDecl ++ decls ++ [Assignment dstNm (Proc Blocking) expr])+                             , dstDecl ++ decls ++ [assn])                     _ -> error "internal error"                 _ ->                   return (Noop,decls)            | pNm == "GHC.Num.Integer.IS" -> do               (expr,decls) <- case lefts args of-                (arg:_) -> mkExpr False Concurrent dst arg+                (arg:_) -> mkExpr False declType dst arg                 _ -> error "internal error: insufficient arguments"               iw <- Lens.view intWidth               return (N.DataCon (Signed iw) (DC (Void Nothing,-1)) [expr],decls)            | pNm == "GHC.Num.Integer.IP" -> do               (expr,decls) <- case lefts args of-                (arg:_) -> mkExpr False Concurrent dst arg+                (arg:_) -> mkExpr False declType dst arg                 _ -> error "internal error: insufficient arguments"               case expr of                 N.Literal Nothing (NumLit _) -> return (expr,decls)@@ -681,7 +686,7 @@            | pNm == "GHC.Num.Integer.IN" -> do               (expr,decls) <- case lefts args of-                (arg:_) -> mkExpr False Concurrent dst arg+                (arg:_) -> mkExpr False declType dst arg                 _ -> error "internal error: insufficient arguments"               case expr of                 N.Literal Nothing (NumLit i) ->@@ -690,14 +695,14 @@            | pNm == "GHC.Num.Natural.NS" -> do               (expr,decls) <- case lefts args of-                (arg:_) -> mkExpr False Concurrent dst arg+                (arg:_) -> mkExpr False declType dst arg                 _ -> error "internal error: insufficient arguments"               iw <- Lens.view intWidth               return (N.DataCon (Unsigned iw) (DC (Void Nothing,-1)) [expr],decls)            | pNm == "GHC.Num.Integer.NB" -> do               (expr,decls) <- case lefts args of-                (arg:_) -> mkExpr False Concurrent dst arg+                (arg:_) -> mkExpr False declType dst arg                 _ -> error "internal error: insufficient arguments"               case expr of                 N.Literal Nothing (NumLit _) -> return (expr,decls)@@ -1046,6 +1051,8 @@   => TextS.Text   -- ^ Name of the primitive of which the function in question is an argument.   -- Used for error reporting.+  -> DeclarationType+  -- ^ Are we concurrent or sequential?   -> Id   -- ^ Identifier binding the encompassing primitive/blackbox application. Used   -- as a name hint if 'mkFunInput' needs intermediate signals.@@ -1059,7 +1066,7 @@        ,[((TextS.Text,TextS.Text),BlackBox)]        ,BlackBoxContext)       ,[Declaration])-mkFunInput parentName resId e =+mkFunInput parentName declType resId e =  let (appE,args,ticks) = collectArgsTicks e  in  withTicks ticks $ \tickDecls -> do   tcm <- Lens.view tcCache@@ -1111,8 +1118,8 @@                 Just (_resHTy, [areVoids@(countEq False -> 1)]) -> do                   let nonVoidArgI = fromJust (elemIndex False areVoids)                   let arg = Id.unsafeMake (TextS.concat ["~ARG[", showt nonVoidArgI, "]"])-                  let assign = Assignment (Id.unsafeMake "~RESULT") Cont (Identifier arg Nothing)-                  return (Right ((Id.unsafeMake "", tickDecls ++ [assign]), Cont))+                  let assign = Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier arg Nothing)+                  return (Right ((Id.unsafeMake "", tickDecls ++ [assign]), assignTy))                  -- Because we filter void constructs, the argument indices and                 -- the field indices don't necessarily correspond anymore. We@@ -1126,8 +1133,8 @@                       mkArg i   = Id.unsafeMake ("~ARG[" <> showt i <> "]")                       dcInps    = [Identifier (mkArg x) Nothing | x <- originalIndices areVoids1]                       dcApp     = DataCon resHTy (DC (resHTy,dcI)) dcInps-                      dcAss     = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss     = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  -- CustomSP the same as SP, but with a user-defined bit                 -- level representation@@ -1138,16 +1145,16 @@                       mkArg i   = Id.unsafeMake ("~ARG[" <> showt i <> "]")                       dcInps    = [Identifier (mkArg x) Nothing | x <- originalIndices areVoids1]                       dcApp     = DataCon resHTy (DC (resHTy,dcI)) dcInps-                      dcAss     = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss     = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  -- Like SP, we have to retrieve the index BEFORE filtering voids                 Just (resHTy@(Product _ _ _), areVoids1:_) -> do                   let mkArg i    = Id.unsafeMake ("~ARG[" <> showt i <> "]")                       dcInps    = [ Identifier (mkArg x) Nothing | x <- originalIndices areVoids1]                       dcApp     = DataCon resHTy (DC (resHTy,0)) dcInps-                      dcAss     = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss     = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  -- Vectors never have defined areVoids (or all set to False), as                 -- it would be converted to Void otherwise. We can therefore@@ -1156,22 +1163,22 @@                   let mkArg i = Id.unsafeMake ("~ARG[" <> showt i <> "]")                       dcInps = [ Identifier (mkArg x) Nothing | x <- [(1::Int)..2] ]                       dcApp  = DataCon resHTy (DC (resHTy,1)) dcInps-                      dcAss  = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss  = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  -- Sum types OR a Sum type after filtering empty types:                 Just (resHTy@(Sum _ _), _areVoids) -> do                   let dcI   = dcTag dc - 1                       dcApp = DataCon resHTy (DC (resHTy,dcI)) []-                      dcAss = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  -- Same as Sum, but with user defined bit level representation                 Just (resHTy@(CustomSum {}), _areVoids) -> do                   let dcI   = dcTag dc - 1                       dcApp = DataCon resHTy (DC (resHTy,dcI)) []-                      dcAss = Assignment (Id.unsafeMake "~RESULT") Cont dcApp-                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), Cont))+                      dcAss = Assignment (Id.unsafeMake "~RESULT") assignTy dcApp+                  return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]), assignTy))                  Just (Void {}, _areVoids) ->                   return (error $ $(curLoc) ++ "Encountered Void in mkFunInput."@@ -1230,7 +1237,7 @@   let pNm = case appE of               Prim p -> primName p               _ -> "__INTERNAL__"-  (bbCtx,dcls) <- mkBlackBoxContext pNm [resId] args+  (bbCtx,dcls) <- mkBlackBoxContext pNm declType [resId] args   case templ of     Left (TDecl,outputUsage,libs,imps,inc,_,templ') -> do       (l',templDecl)@@ -1243,16 +1250,16 @@       onBlackBox         (\t -> do t' <- getAp (prettyBlackBox t)                   let t'' = Id.unsafeMake (Text.toStrict t')-                      assn = Assignment (Id.unsafeMake "~RESULT") Cont (Identifier t'' Nothing)-                  return ((Right (Id.unsafeMake "",[assn]),Cont,libs,imps,inc,bbCtx),dcls))+                      assn = Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier t'' Nothing)+                  return ((Right (Id.unsafeMake "",[assn]),assignTy,libs,imps,inc,bbCtx),dcls))         (\bbName bbHash (TemplateFunction k g _) -> do           let f' bbCtx' = do-                let assn = Assignment (Id.unsafeMake "~RESULT") Cont+                let assn = Assignment (Id.unsafeMake "~RESULT") assignTy                             (BlackBoxE nm libs imps inc templ' bbCtx' False)                 p <- getAp (Backend.blockDecl (Id.unsafeMake "") [assn])                 return p           return ((Left (BBFunction bbName bbHash (TemplateFunction k g f'))-                  ,Cont+                  ,assignTy                   ,[]                   ,[]                   ,[]@@ -1265,6 +1272,8 @@     Right (decl,u) ->       return ((Right decl,u,[],[],[],bbCtx),dcls)   where+    assignTy = declTypeUsage declType+     goExpr app@(collectArgsTicks -> (C.Var fun,args@(_:_),ticks)) = do       tcm <- Lens.view tcCache       resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (inferCoreTypeOf tcm app)@@ -1273,23 +1282,23 @@         then           withTicks ticks $ \tickDecls -> do             resNm <- Id.make "result"-            appDecls <- mkFunApp resNm fun tmArgs tickDecls-            let assn = [ Assignment (Id.unsafeMake "~RESULT") Cont (Identifier resNm Nothing)+            appDecls <- mkFunApp declType resNm fun tmArgs tickDecls+            let assn = [ Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier resNm Nothing)                        , NetDecl Nothing resNm resTy ]             nm <- Id.makeBasic "block"-            return (Right ((nm,assn++appDecls), Cont))+            return (Right ((nm,assn++appDecls), assignTy))         else do           (_,sp) <- Lens.use curCompNm           throw (ClashException sp ($(curLoc) ++ "Not in normal form: Var-application with Type arguments:\n\n" ++ showPpr app) Nothing)     goExpr e' = do       tcm <- Lens.view tcCache       let eType = inferCoreTypeOf tcm e'-      (appExpr,appDecls) <- mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$bb_res") eType) e'-      let assn = Assignment (Id.unsafeMake "~RESULT") Cont appExpr+      (appExpr,appDecls) <- mkExpr False declType (NetlistId (Id.unsafeMake "c$bb_res") eType) e'+      let assn = Assignment (Id.unsafeMake "~RESULT") assignTy appExpr       nm <- if null appDecls                then return (Id.unsafeMake "")                else Id.makeBasic "block"-      return (Right ((nm,appDecls ++ [assn]), Cont))+      return (Right ((nm,appDecls ++ [assn]), assignTy))      go is0 n (Lam id_ e') = do       lvl <- Lens.use curBBlvl@@ -1302,18 +1311,18 @@       go is1 (n+(1::Int)) e''      go _ _ (C.Var v) = do-      let assn = Assignment (Id.unsafeMake "~RESULT") Cont (Identifier (Id.unsafeFromCoreId v) Nothing)-      return (Right ((Id.unsafeMake "",[assn]), Cont))+      let assn = Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier (Id.unsafeFromCoreId v) Nothing)+      return (Right ((Id.unsafeMake "",[assn]), assignTy))      go _ _ (Case scrut ty [alt]) = do       tcm <- Lens.view tcCache       let sTy = inferCoreTypeOf tcm scrut-      (projection,decls) <- mkProjection False (NetlistId (Id.unsafeMake "c$bb_res") sTy) scrut ty alt-      let assn = Assignment (Id.unsafeMake "~RESULT") Cont projection+      (projection,decls) <- mkProjection declType False (NetlistId (Id.unsafeMake "c$bb_res") sTy) scrut ty alt+      let assn = Assignment (Id.unsafeMake "~RESULT") assignTy projection       nm <- if null decls                then return (Id.unsafeMake "")                else Id.makeBasic "projection"-      return (Right ((nm,decls ++ [assn]), Cont))+      return (Right ((nm,decls ++ [assn]), assignTy))      go _ _ (Case scrut ty (alt:alts@(_:_))) = do       resNm <- Id.make "result"@@ -1321,11 +1330,11 @@       -- It's safe to use 'mkUnsafeSystemName' here: only the name, not the       -- unique, will be used       let resId'  = NetlistId resNm ty-      selectionDecls <- mkSelection Concurrent resId' scrut ty (alt :| alts) []+      selectionDecls <- mkSelection declType resId' scrut ty (alt :| alts) []       let assn = [ NetDecl' Nothing resNm resTy Nothing-                 , Assignment (Id.unsafeMake "~RESULT") Cont (Identifier resNm Nothing) ]+                 , Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier resNm Nothing) ]       nm <- Id.makeBasic "selection"-      return (Right ((nm,assn++selectionDecls), Cont))+      return (Right ((nm,assn++selectionDecls), assignTy))      go is0 _ e'@(Let{}) = do       tcm <- Lens.view tcCache@@ -1345,8 +1354,8 @@           -- tests break when reverting to the old behavior. In some cases this           -- creates "useless" assignments. We should investigate whether we can           -- get the old behavior back.-          let resDecl = Assignment (Id.unsafeMake "~RESULT") Cont (Identifier resultId Nothing)-          return (Right ((nm,resDecl:netDecls ++ decls), Cont))+          let resDecl = Assignment (Id.unsafeMake "~RESULT") assignTy (Identifier resultId Nothing)+          return (Right ((nm,resDecl:netDecls ++ decls), assignTy))         Nothing -> return (Right ((Id.unsafeMake "",[]), Cont))      go is0 n (Tick _ e') = go is0 n e'
src/Clash/Netlist/BlackBox.hs-boot view
@@ -11,7 +11,7 @@ import Clash.Core.Term (Term) import Clash.Core.Type (Type) import Clash.Core.Var (Id)-import Clash.Netlist.Types (BlackBoxContext, Declaration, NetlistMonad)+import Clash.Netlist.Types (BlackBoxContext, Declaration, DeclarationType, NetlistMonad) import Clash.Primitives.Types (CompiledPrimitive)  extractPrimWarnOrFail@@ -23,6 +23,8 @@   :: HasCallStack   => Text   -- ^ Blackbox function name+  -> DeclarationType+  -- ^ Are we concurrent or sequential?   -> [Id]   -- ^ Identifiers binding the primitive/blackbox application   -> [Either Term Type]
src/Clash/Netlist/Types.hs view
@@ -954,6 +954,11 @@   = Concurrent   | Sequential +-- | Default usage for a type of declaration (concurrent or sequential)+declTypeUsage :: DeclarationType -> Usage+declTypeUsage Concurrent = Cont+declTypeUsage Sequential = Proc Blocking+ emptyBBContext :: Text -> BlackBoxContext emptyBBContext name   = Context
src/Clash/Netlist/Util.hs view
@@ -896,7 +896,7 @@    go :: Text -> [Id] -> [Either Term Type] -> [BlackBox] -> NetlistMonad [(Id, Id)]   go nm is0 bbArgs bbResultTemplates = do-    (bbCtx, _) <- preserveVarEnv (mkBlackBoxContext nm is0 bbArgs)+    (bbCtx, _) <- preserveVarEnv (mkBlackBoxContext nm Concurrent is0 bbArgs)     be <- Lens.use backend     let       _sameName i0 i1 = nameOcc (varName i0) == nameOcc (varName i1)@@ -1645,7 +1645,7 @@   case hwty1 of     Vector {} -> do       (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps-      let assigns = zipWith3 Assignment ids (repeat Cont) (map (indexPN 10) [0..])+      assigns <- zipWithM contAssign ids (map (indexPN 10) [0..])       if null attrs then         return (concat ports, pDecl:assigns ++ concat decls, pName)       else@@ -1653,7 +1653,7 @@      RTree {} -> do       (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps-      let assigns = zipWith3 Assignment ids (repeat Cont) (map (indexPN 10) [0..])+      assigns <- zipWithM contAssign ids (map (indexPN 10) [0..])       if null attrs then         return (concat ports, pDecl:assigns ++ concat decls, pName)       else@@ -1661,7 +1661,7 @@      Product {} -> do       (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps-      let assigns = zipWith3 Assignment ids (repeat Cont) (map (indexPN 0) [0..])+      assigns <- zipWithM contAssign ids (map (indexPN 0) [0..])       if null attrs then         return (concat ports, pDecl:assigns ++ concat decls, pName)       else@@ -1682,9 +1682,9 @@               , typeSize elTy - 1               , 0 ) -            assigns =-              [ Assignment conId Cont (Identifier pName (Just conIx))-              , Assignment elId  Cont (FromBv Nothing elTy (Identifier pName (Just elIx))) ]+          assigns <- sequence+              [ contAssign conId (Identifier pName (Just conIx))+              , contAssign elId  (FromBv Nothing elTy (Identifier pName (Just elIx))) ]            return (concat ports, pDecl:assigns ++ concat decls, pName)         _ -> error "Internal error: Unexpected error for PortProduct"@@ -1738,7 +1738,7 @@     Vector sz hwty'' -> do       (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps       let ids1 = map (flip Identifier Nothing) ids0-          netassgn = Assignment pName Cont (mkVectorChain sz hwty'' ids1)+      netassgn <- contAssign pName (mkVectorChain sz hwty'' ids1)       if null attrs then         return (concat ports, pDecl:netassgn:concat decls, pName)       else@@ -1747,7 +1747,7 @@     RTree d hwty'' -> do       (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps       let ids1 = map (flip Identifier Nothing) ids0-          netassgn = Assignment pName Cont (mkRTreeChain d hwty'' ids1)+      netassgn <- contAssign pName (mkRTreeChain d hwty'' ids1)       if null attrs then         return (concat ports, pDecl:netassgn:concat decls, pName)       else@@ -1756,7 +1756,7 @@     Product {} -> do       (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps       let ids1 = map (flip Identifier Nothing) ids0-          netassgn = Assignment pName Cont (DataCon hwty (DC (hwty,0)) ids1)+      netassgn <- contAssign pName (DataCon hwty (DC (hwty,0)) ids1)       if null attrs then         return (concat ports, pDecl:netassgn:concat decls, pName)       else@@ -1768,7 +1768,7 @@           ids2 = case ids1 of                   [conId, elId] -> [conId, ToBv Nothing elTy elId]                   _ -> error "Unexpected error for PortProduct"-          netassgn = Assignment pName Cont (DataCon hwty (DC (BitVector (typeSize hwty),0)) ids2)+      netassgn <- contAssign pName (DataCon hwty (DC (BitVector (typeSize hwty),0)) ids2)       return (concat ports, pDecl:netassgn:concat decls, pName)      _ ->
src/Clash/Normalize.hs view
@@ -381,7 +381,12 @@                  apply "reduceNonRepPrim" reduceNonRepPrim >->                  apply "removeUnusedExpr" removeUnusedExpr) >->                bottomupR (apply "flattenLet" flattenLet)) !->-      topdownSucR (apply "topLet" topLet)+      topdownSucR (apply "topLet" topLet) >->+      -- See [Note] relation `collapseRHSNoops` and `inlineCleanup`+      -- Note that we do this as the very last step, after all constant propagation+      -- has been done to avoid #3036.+      topdownSucR (apply "collapseRHSNoops" collapseRHSNoops) >->+      topdownSucR (apply "inlineCleanup" inlineCleanup)      goCheap c@(CLeaf   (nm2,(Binding _ _ inl2 _ e _)))       | isNoInline inl2  = (Nothing     ,[c])
src/Clash/Normalize/Strategy.hs view
@@ -51,8 +51,6 @@     cse        = topdownR (apply "CSE" simpleCSE)     xOptim     = bottomupR (apply "xOptimize" xOptimize)     cleanup    = topdownR (apply "etaExpandSyn" etaExpandSyn) >->-                 -- See [Note] relation `collapseRHSNoops` and `inlineCleanup`-                 topdownSucR (apply "collapseRHSNoops" collapseRHSNoops) >->                  topdownSucR (apply "inlineCleanup" inlineCleanup) !->                  innerMost (applyMany [("caseCon"        , caseCon)                                       ,("bindConstantVar", bindConstantVar)
src/Clash/Normalize/Transformations/Inline.hs view
@@ -60,6 +60,7 @@ import Clash.Core.Name (Name(..), NameSort(..)) import Clash.Core.Pretty (PrettyOptions(..), showPpr, showPpr') import Clash.Core.Subst+import qualified Clash.Core.Term as Term import Clash.Core.Term   ( CoreContext(..), Pat(..), PrimInfo(..), Term(..), WorkInfo(..), collectArgs   , collectArgsTicks, mkApps , mkTicks, stripTicks)@@ -393,11 +394,25 @@ The end result of all of this is that we get no/fewer assignments in HDL where the RHS is simply a variable reference. See issue #779 -} --- | Takes a binding and collapses its term if it is a noop+-- | Takes a binding and collapses its term if it is a noop. Only runs at+-- synthesis boundaries (NOINLINE/OPAQUE functions) to avoid running too early+-- on functions that might be inlined later. See #3036. collapseRHSNoops :: HasCallStack => NormRewrite-collapseRHSNoops _ (Letrec binds body) = do-  binds1 <- mapM runCollapseNoop binds-  return $ Letrec binds1 body+collapseRHSNoops _ letrec@(Let letBind body) = do+  (curFunId, _) <- Lens.use curFun+  curBinding <- lookupVarEnv curFunId <$> Lens.use bindings+  case curBinding of+    Just binding | isNoInline (bindingSpec binding) -> do+      -- Explicitly match on Let instead of using LetRec, because we need to+      -- preserve the structure. See https://github.com/clash-lang/clash-compiler/issues/3044.+      case letBind of+        Term.Rec binds -> do+          binds1 <- mapM runCollapseNoop binds+          pure (Let (Term.Rec binds1) body)+        Term.NonRec b0 e0 -> do+          (b1, e1) <- runCollapseNoop (b0, e0)+          pure (Let (Term.NonRec b1 e1) body)+    _ -> pure letrec   where     runCollapseNoop orig =       runMaybeT (collapseNoop orig) >>= Maybe.maybe (return orig) changed
src/Clash/Primitives/Verification.hs view
@@ -22,11 +22,11 @@ import           Clash.Core.TermLiteral          (termToDataError) import           Clash.Util                      (indexNote) import           Clash.Netlist                   (mkExpr)-import           Clash.Netlist.Util              (stripVoid)+import           Clash.Netlist.Util              (stripVoid, contAssign) import qualified Clash.Netlist.Id                as Id import           Clash.Netlist.Types   (BlackBox(BBFunction), TemplateFunction(..), BlackBoxContext, Identifier,-   NetlistMonad, Declaration(Assignment, NetDecl), Usage(Cont),+   NetlistMonad, Declaration(NetDecl),    HWType(Bool, KnownDomain), NetlistId(..),    DeclarationType(Concurrent), tcCache, bbInputs, Expr(Identifier)) import           Clash.Netlist.BlackBox.Types@@ -80,9 +80,10 @@     tcm <- Lens.view tcCache     newId <- Id.make (Text.pack nm)     (expr0, decls) <- mkExpr False Concurrent (NetlistId newId (inferCoreTypeOf tcm t)) t+    assn <- contAssign newId expr0     pure       ( newId-      , decls ++ [sigDecl Bool newId, Assignment newId Cont expr0] )+      , decls ++ [sigDecl Bool newId, assn] )    -- Simple wire without comment   sigDecl :: HWType -> Identifier -> Declaration