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 +12/−0
- clash-lib.cabal +2/−2
- prims/verilog/Clash_Explicit_Testbench.primitives.yaml +3/−3
- src/Clash/Netlist.hs +27/−22
- src/Clash/Netlist.hs-boot +4/−2
- src/Clash/Netlist/BlackBox.hs +74/−65
- src/Clash/Netlist/BlackBox.hs-boot +3/−1
- src/Clash/Netlist/Types.hs +5/−0
- src/Clash/Netlist/Util.hs +11/−11
- src/Clash/Normalize.hs +6/−1
- src/Clash/Normalize/Strategy.hs +0/−2
- src/Clash/Normalize/Transformations/Inline.hs +19/−4
- src/Clash/Primitives/Verification.hs +4/−3
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