diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,25 @@ # Changelog for the Clash project +## 1.8.5 *Mar 24th, 2026* + +Added: +* `Clash.Annotation.SynthesisAtrributes.annotateReg`, a function to add synthesis attributes (e.g. `ASYNC_REG`) to register declarations in the HDL generated by the Clash compiler. + [#3093](https://github.com/clash-lang/clash-compiler/pull/3093) +* `registerSyncReset` [#3115](https://github.com/clash-lang/clash-compiler/issues/3115) + +Fixed: +* The `Clash.Explicit.Verification.check` blackbox now correctly uses the given clock line, not assuming any longer that it is already bound to an identifier in the first place. [#2907](https://github.com/clash-lang/clash-compiler/issues/2907) +* The type of string literals passed to the `Clash.Explicit.Verification.check` blackbox now matches with the input provided via `Clash.Explicit.Verification.name`. [#2908](https://github.com/clash-lang/clash-compiler/issues/2908) +* `toInteger`, `toEnum`, and `fromEnum` now correctly sign extend when using Verilog backend. [#2729](https://github.com/clash-lang/clash-compiler/issues/2729). +* `dumpVCD` now properly aligns the first clock edges in multi-domain designs. [#3075](https://github.com/clash-lang/clash-compiler/issues/3075) +* Removed the limit on the number of traces in `dumpVCD`. Also removed unnecessary double newlines after 1-bit signals. [#3082](https://github.com/clash-lang/clash-compiler/issues/3082) +* In Clash simulation, `pack` for `Vec` and `RTree` had all bits undefined when the spine of the value had an `XException`. Now, those elements with defined bits will output those defined bits. In HDL, this was already the case. Example: consider `xs = 1 :> undefined :> Nil :: Vec 2 (Unsigned 4)` and `ys = 1 :> undefined :: Vec 2 (Unsigned 4)`. `xs` merely has an undefined element, but `ys` has an undefined spine: it is a `:>` constructor that is undefined. `pack ys` used to be `0b...._....` but is now `0b0001_....`, just as `pack xs` already was. + [#3114](https://github.com/clash-lang/clash-compiler/pull/3114) +* Clash drops cached normalization result. [#3109](https://github.com/clash-lang/clash-compiler/issues/3109) +* Fix `holdReset` glitch behavior for asynchronous resets and wrong hold cycles for sync resets. [#3115](https://github.com/clash-lang/clash-compiler/issues/3115) +* Do not emit source locations if `-g` is not passed to clash [#3132](https://github.com/clash-lang/clash-compiler/issues/3132) +* `clash-ghc`: Remove `Opt_LlvmTBAA` from unwanted flags [#2508](https://github.com/clash-lang/clash-compiler/issues/2823) + ## 1.8.4 *Nov 6th 2025* Changed: @@ -314,7 +334,7 @@ Added: * `Clash.Class.Counter`: a class that defines a odometer-style supercounter. [#1763](https://github.com/clash-lang/clash-compiler/pull/1763) * `isLike` function for BitPack types. [#1774](https://github.com/clash-lang/clash-compiler/pull/1774) - * 'seqErrorX' for catching both `XException` and `ErrorCall`. [#1774](https://github.com/clash-lang/clash-compiler/pull/1774) + * 'seqErrorX' for catching both `XException` and `ErrorCall`. [#1839](https://github.com/clash-lang/clash-compiler/pull/1839) * `Clash.Explicit.BlockRam.File.memFile`, a function for creating the contents of the data files this blockRAM uses. Can also be imported from `Clash.Prelude.BlockRam.File`, `Clash.Prelude.ROM.File` and `Clash.Explicit.ROM.File`. [#1840](https://github.com/clash-lang/clash-compiler/pull/1840) * Support for Yosys compatible SVA to `Clash.Verification`. This enables formal verification using SymbiYosis for Verilog and SystemVerilog. [#1798](https://github.com/clash-lang/clash-compiler/pull/1798) * `Clash.Explicit.Signal.Delayed.forward`, a function that can be used to retime a `DSignal` into the future without applying any logic. [#1882](https://github.com/clash-lang/clash-compiler/pull/1882) diff --git a/clash-lib.cabal b/clash-lib.cabal --- a/clash-lib.cabal +++ b/clash-lib.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: clash-lib -Version: 1.8.4 +Version: 1.8.5 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.4, + clash-prelude == 1.8.5, containers >= 0.5.0.0 && < 0.8, cryptohash-sha256 >= 0.11 && < 0.12, data-binary-ieee754 >= 0.4.4 && < 0.6, @@ -380,7 +380,7 @@ build-depends: base, clash-lib, - doctest-parallel >= 0.2 && < 0.4, + doctest-parallel >= 0.2 && < 0.5, filepath test-suite unittests diff --git a/prims/common/Clash_Annotations_SynthesisAttributes.primitives.yaml b/prims/common/Clash_Annotations_SynthesisAttributes.primitives.yaml new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Annotations_SynthesisAttributes.primitives.yaml @@ -0,0 +1,3 @@ +- Primitive: + name: Clash.Annotations.SynthesisAttributes.annotateReg + primType: Function diff --git a/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml --- a/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml +++ b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml @@ -44,7 +44,7 @@ type: 'fromEnum# :: KnownNat n => Signed n -> Int' template: ~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) - {1'b0}},~VAR[i][1]})~FI~ELSE~SIZE[~TYPO]'sd0~FI + {~VAR[i][1][~SIZE[~TYP[1]]-1]}},~VAR[i][1]})~FI~ELSE~SIZE[~TYPO]'sd0~FI workInfo: Never - BlackBox: name: Clash.Sized.Internal.Signed.size# @@ -118,7 +118,7 @@ type: 'toEnum# :: KnownNat n => Int -> Signed n' template: ~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) - {1'b0}},~VAR[i][1]})~FI + {~VAR[i][1][~SIZE[~TYP[1]]-1]}},~VAR[i][1]})~FI workInfo: Never - BlackBox: name: Clash.Sized.Internal.Signed.plus# diff --git a/prims/systemverilog/Clash_Signal_Internal.primitives.yaml b/prims/systemverilog/Clash_Signal_Internal.primitives.yaml --- a/prims/systemverilog/Clash_Signal_Internal.primitives.yaml +++ b/prims/systemverilog/Clash_Signal_Internal.primitives.yaml @@ -94,7 +94,7 @@ => Signal dom Bool -- ARG[1] -> Clock dom template: |- - // tbClockGen begin + // ~IF~ISACTIVEENABLE[1]~THENtbClockGen~ELSEclockGen~FI begin // pragma translate_off // 1 = 0.1ps localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); diff --git a/prims/verilog/Clash_Signal_Internal.primitives.yaml b/prims/verilog/Clash_Signal_Internal.primitives.yaml --- a/prims/verilog/Clash_Signal_Internal.primitives.yaml +++ b/prims/verilog/Clash_Signal_Internal.primitives.yaml @@ -93,7 +93,7 @@ => Signal dom Bool -- ARG[1] -> Clock dom template: |- - // tbClockGen begin + // ~IF~ISACTIVEENABLE[1]~THENtbClockGen~ELSEclockGen~FI begin // pragma translate_off reg ~TYPO ~GENSYM[clk][0]; // 1 = 0.1ps diff --git a/prims/vhdl/Clash_Signal_Internal.primitives.yaml b/prims/vhdl/Clash_Signal_Internal.primitives.yaml --- a/prims/vhdl/Clash_Signal_Internal.primitives.yaml +++ b/prims/vhdl/Clash_Signal_Internal.primitives.yaml @@ -141,7 +141,7 @@ => Signal dom Bool -- ARG[1] -> Clock dom template: |- - -- tbClockGen begin + -- ~IF~ISACTIVEENABLE[1]~THENtbClockGen~ELSEclockGen~FI begin -- pragma translate_off ~GENSYM[clkGen][0] : process is constant ~GENSYM[half_periodH][1] : time := ~PERIOD[0]000 fs / 2; diff --git a/src/Clash/Core/EqSolver.hs b/src/Clash/Core/EqSolver.hs --- a/src/Clash/Core/EqSolver.hs +++ b/src/Clash/Core/EqSolver.hs @@ -92,7 +92,7 @@ [] -- | Solve equations supported by @normalizeAdd@. See documentation of --- @TypeEqSolution@ to understand the return value. +-- 'TypeEqSolution' to understand the return value. solveAdd :: VarSet -> (Type, Type) @@ -134,7 +134,7 @@ lhsLit _ _ = Nothing -- | Tests for nonsencical patterns due to types being "absurd". See --- @isAbsurdEq@ for more info. +-- 'isAbsurdEq' for more info. isAbsurdPat :: TyConMap -> Pat @@ -152,7 +152,7 @@ DataPat _dc extNms _ids -> mkVarSet extNms _ -> emptyVarSet --- | Determines if an "equation" obtained through @patEqs@ or @typeEq@ is +-- | Determines if an "equation" obtained through 'patEqs' or 'typeEq' is -- absurd. That is, it tests if two types that are definitely not equal are -- asserted to be equal OR if the computation of the types yield some absurd -- (intermediate) result such as -1. diff --git a/src/Clash/Core/Evaluator/Types.hs b/src/Clash/Core/Evaluator/Types.hs --- a/src/Clash/Core/Evaluator/Types.hs +++ b/src/Clash/Core/Evaluator/Types.hs @@ -80,10 +80,10 @@ -- define partial evaluation. In this implementation, it consists of two types -- of function: -- --- * steps, which applies the reduction realtion to the current term +-- * steps, which applies the reduction relation to the current term -- * unwindings, which pop the stack and evaluate the stack frame -- --- Variants of these functions also exist for evalauting primitive operations. +-- Variants of these functions also exist for evaluating primitive operations. -- This is because there may be multiple frontends to the compiler which can -- reuse a common step and unwind, but have different primitives. -- diff --git a/src/Clash/Core/FreeVars.hs b/src/Clash/Core/FreeVars.hs --- a/src/Clash/Core/FreeVars.hs +++ b/src/Clash/Core/FreeVars.hs @@ -281,6 +281,8 @@ goTick inLocalScope = \case NameMod m ty -> NameMod m <$> typeFreeVars' interesting inLocalScope f ty + Attributes ty tm -> Attributes <$> typeFreeVars' interesting inLocalScope f ty + <*> go inLocalScope tm tick -> pure tick -- | Get the free variables of an expression and count the number of occurrences diff --git a/src/Clash/Core/Pretty.hs b/src/Clash/Core/Pretty.hs --- a/src/Clash/Core/Pretty.hs +++ b/src/Clash/Core/Pretty.hs @@ -246,7 +246,7 @@ pprPrec _ = pure . pretty instance PrettyPrec Type where - pprPrec _ t = annotate (AnnSyntax Type) <$> pprType t + pprPrec _ t = pprType t instance ClashPretty Type where clashPretty = fromPpr @@ -265,7 +265,7 @@ name <- pprPrec prec dc ty <- pprType (dcType dc) - pure (name <+> dcolon <+> ty) + pure (name <> annotate (AnnSyntax Type) (space <> dcolon <+> ty)) AlgTyCon _ nm kn _ (NewTyCon dc _) _ -> do name <- pprPrec prec nm @@ -275,7 +275,7 @@ conName <- pprPrec prec (dcName dc) conType <- pprType (dcType dc) - pure (vsep [newtype_ <+> decl, conName <+> dcolon <+> conType]) + pure (vsep [newtype_ <+> decl, conName <> annotate (AnnSyntax Type) (space <> dcolon <+> conType)]) PromotedDataCon _ _ _ _ dc -> fmap ("promoted" <+>) (pprPrec prec dc) @@ -313,7 +313,7 @@ Var x -> do v <- pprPrec prec (varName x) s <- pprPrecIdScope x - pure (v <> brackets s) + pure (v <> annotate (AnnSyntax Unique) (brackets s)) Data dc -> pprPrec prec dc Literal l -> pprPrec prec l Prim p -> pprPrecPrim prec (primName p) @@ -341,6 +341,7 @@ pprPrec prec (NameMod SetName t) = ("" <>) <$> pprPrec prec t pprPrec _ DeDup = pure "" pprPrec _ NoDeDup = pure "" + pprPrec prec (Attributes _ attrs) = ("" <>) <$> pprPrec prec attrs instance PrettyPrec SrcSpan where pprPrec _ sp = return (""<>pretty (GHC.showSDocUnsafe (GHC.ppr sp))) diff --git a/src/Clash/Core/Subst.hs b/src/Clash/Core/Subst.hs --- a/src/Clash/Core/Subst.hs +++ b/src/Clash/Core/Subst.hs @@ -56,6 +56,7 @@ -- * Alpha equivalence , aeqType , aeqTerm + , acmpTerm -- * Structural equivalence , eqTerm , eqType @@ -584,6 +585,7 @@ goTick (NameMod m ty) = NameMod m (substTy subst ty) goTick t@DeDup = t goTick t@NoDeDup = t + goTick (Attributes ty tm) = Attributes (substTy subst ty) (go tm) -- | Substitute within a case-alternative substAlt diff --git a/src/Clash/Core/Subst.hs-boot b/src/Clash/Core/Subst.hs-boot --- a/src/Clash/Core/Subst.hs-boot +++ b/src/Clash/Core/Subst.hs-boot @@ -3,6 +3,7 @@ module Clash.Core.Subst where import GHC.Stack (HasCallStack) +import {-# SOURCE #-} Clash.Core.Term (Term) import {-# SOURCE #-} Clash.Core.Type (Type) import Clash.Core.Var (TyVar) @@ -20,3 +21,7 @@ instance Eq Type instance Ord Type + +acmpTerm :: Term -> Term -> Ordering + +instance Eq Term diff --git a/src/Clash/Core/Term.hs b/src/Clash/Core/Term.hs --- a/src/Clash/Core/Term.hs +++ b/src/Clash/Core/Term.hs @@ -81,7 +81,7 @@ import Clash.Core.DataCon (DataCon) import Clash.Core.Literal (Literal) import Clash.Core.Name (Name (..)) -import {-# SOURCE #-} Clash.Core.Subst () -- instance Eq/Ord Type +import {-# SOURCE #-} Clash.Core.Subst (acmpTerm) -- instance Eq/Ord Type, Eq Term import {-# SOURCE #-} Clash.Core.Type (Type) import Clash.Core.Var (Var, Id, TyVar) import Clash.Util (curLoc, thenCompare) @@ -124,19 +124,25 @@ | NoDeDup -- ^ Do not deduplicate, i.e. /keep/, an expression inside a case-alternative; -- do not try to share expressions between multiple branches. + | Attributes Type Term + -- ^ Synthesis attributes brough into scope by + -- 'Clash.Annotations.SynthesisAttributes.annotateReg' deriving (Eq, Show, Generic, NFData, Binary) instance Ord TickInfo where compare (SrcSpan s1) (SrcSpan s2) = leftmost_smallest s1 s2 compare (NameMod m1 t1) (NameMod m2 t2) = compare m1 m2 `thenCompare` compare t1 t2 + compare (Attributes t1 a1) (Attributes t2 a2) = + compare t1 t2 `thenCompare` acmpTerm a1 a2 compare t1 t2 = compare (getRank t1) (getRank t2) where getRank :: TickInfo -> Word - getRank SrcSpan{} = 0 - getRank NameMod{} = 1 - getRank DeDup = 2 - getRank NoDeDup = 3 + getRank SrcSpan{} = 0 + getRank NameMod{} = 1 + getRank DeDup = 2 + getRank NoDeDup = 3 + getRank Attributes {} = 4 -- | Tag to indicate which instance/register name modifier was used data NameMod diff --git a/src/Clash/Core/TermLiteral.hs b/src/Clash/Core/TermLiteral.hs --- a/src/Clash/Core/TermLiteral.hs +++ b/src/Clash/Core/TermLiteral.hs @@ -129,6 +129,7 @@ instance TermLiteral Integer where termToData (Tick _ e) = termToData e termToData (Literal (IntegerLiteral n)) = Right n + termToData (collectArgs -> (_, [Left (Literal (IntLiteral n))])) = Right n termToData (collectArgs -> (_, [Left (Literal (IntegerLiteral n))])) = Right n termToData t = Left t diff --git a/src/Clash/Driver.hs b/src/Clash/Driver.hs --- a/src/Clash/Driver.hs +++ b/src/Clash/Driver.hs @@ -458,7 +458,7 @@ (topComponent, netlist) <- modifyMVar seenV $ \seen -> do (topComponent, netlist, seen') <- -- TODO My word, this has far too many arguments. - genNetlist env isTb transformedBindings topEntityMap compNames + genNetlist env peEval isTb transformedBindings topEntityMap compNames typeTrans ite (SomeBackend hdlState') seen hdlDir prefixM topEntity pure (seen', (topComponent, netlist)) diff --git a/src/Clash/Driver/Types.hs b/src/Clash/Driver/Types.hs --- a/src/Clash/Driver/Types.hs +++ b/src/Clash/Driver/Types.hs @@ -2,8 +2,8 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , QBayLogic, Google Inc., - 2020-2022, QBayLogic, 2022 , Google Inc., + 2020-2026, QBayLogic, License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -322,6 +322,11 @@ -- Command line flag: -fclash-evaluator-fuel-limit , opt_debug :: DebugOpts -- ^ Options which control debugging. See 'DebugOpts'. + , opt_ghcDebugLevel :: Int + -- ^ What the GHC debug level is (i.e. @-g@). + -- + -- Clash uses this to decide whether to emit source-location information in + -- generated HDL. , opt_cachehdl :: Bool -- ^ Reuse previously generated output from Clash. Only caches topentities. -- @@ -411,6 +416,7 @@ , opt_inlineConstantLimit = 0 , opt_evaluatorFuelLimit = 20 , opt_debug = debugNone + , opt_ghcDebugLevel = 0 , opt_cachehdl = True , opt_clear = False , opt_primWarn = True diff --git a/src/Clash/Netlist.hs b/src/Clash/Netlist.hs --- a/src/Clash/Netlist.hs +++ b/src/Clash/Netlist.hs @@ -2,8 +2,8 @@ Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2018, Google Inc., - 2021-2024, QBayLogic B.V. - 2022 , Google Inc. + 2022 , Google Inc., + 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -84,11 +84,13 @@ import Clash.Primitives.Types as P import Clash.Util import qualified Clash.Util.Interpolate as I +import Clash.Core.PartialEval (Evaluator) -- | Generate a hierarchical netlist out of a set of global binders with -- @topEntity@ at the top. genNetlist :: ClashEnv + -> Evaluator -> Bool -- ^ Whether this we're compiling a testbench (suppresses certain warnings) -> BindingMap @@ -113,9 +115,9 @@ -> Id -- ^ Name of the @topEntity@ -> IO (Component, ComponentMap, IdentifierSet) -genNetlist env isTb globals tops topNames typeTrans ite be seen0 dir prefixM topEntity = do +genNetlist env eval isTb globals tops topNames typeTrans ite be seen0 dir prefixM topEntity = do ((_meta, topComponent), s) <- - runNetlistMonad env isTb globals tops typeTrans ite be seen1 dir componentNames_ + runNetlistMonad env eval isTb globals tops typeTrans ite be seen1 dir componentNames_ $ genComponent topEntity return (topComponent, _components s, seen1) where @@ -125,6 +127,7 @@ -- | Run a NetlistMonad action in a given environment runNetlistMonad :: ClashEnv + -> Evaluator -> Bool -- ^ Whether this we're compiling a testbench (suppresses certain warnings) -> BindingMap @@ -147,8 +150,8 @@ -> NetlistMonad a -- ^ Action to run -> IO (a, NetlistState) -runNetlistMonad env isTb s tops typeTrans ite be seenIds_ dir componentNames_ - = flip runReaderT (NetlistEnv env "" "" Nothing) +runNetlistMonad env eval isTb s tops typeTrans ite be seenIds_ dir componentNames_ + = flip runReaderT (NetlistEnv env "" "" Nothing [] eval) . flip runStateT s' . runNetlist where @@ -308,16 +311,33 @@ return (ComponentMeta wereVoids sp ids u, component) mkNetDecl :: (Id, Term) -> NetlistMonad [Declaration] -mkNetDecl (id_,tm) = preserveVarEnv $ do - hwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (coreTypeOf id_) +mkNetDecl (id_,tm) | (_,_,ticks) <- collectArgsTicks tm = preserveVarEnv $ withTicks ticks $ \_ -> do + lAttrs <- Lens.view localAttrs + hwTy0 <- unsafeCoreTypeToHWTypeM' $(curLoc) (coreTypeOf id_) + let hwTy = case hwTy0 of + Annotated attrs hty0 -> Annotated (attrs ++ lAttrs) hty0 + hty0 -> annotated lAttrs hty0 + + -- GHC starts including sources notes on any debug level greater than 0 + -- we copy this behaviour here. + emitLocs <- (>0) . opt_ghcDebugLevel <$> Lens.view clashOpts + let + srcNote = + if emitLocs then + addSrcNote $ case tm of + Tick (SrcSpan s) _ -> s + _ -> nameLoc (varName id_) + else + Nothing + if | not (shouldRenderDecl hwTy tm) -> return [] | (Prim pInfo@PrimInfo{primMultiResult=MultiResult}, args) <- collectArgs tm -> - multiDecls pInfo args - | otherwise -> pure <$> singleDecl hwTy + multiDecls srcNote pInfo args + | otherwise -> pure <$> singleDecl srcNote hwTy where - multiDecls pInfo args0 = do + multiDecls srcNote pInfo args0 = do tcm <- Lens.view tcCache resInits0 <- getResInits (id_, tm) let @@ -331,7 +351,7 @@ hwTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) (mpi_resultTypes mpInfo) pure (zipWith3 netdecl res hwTys resInits1) - singleDecl hwTy = do + singleDecl srcNote hwTy = do rIM <- listToMaybe <$> getResInits (id_, tm) return (NetDecl' srcNote (Id.unsafeFromCoreId id_) hwTy rIM) @@ -339,10 +359,6 @@ | isGoodSrcSpan loc = Just (StrictText.pack (showSDocUnsafe (ppr loc))) | otherwise = Nothing - srcNote = addSrcNote $ case tm of - Tick (SrcSpan s) _ -> s - _ -> nameLoc (varName id_) - isMultiPrimSelect :: Term -> Bool isMultiPrimSelect t = case collectArgs t of (Prim (primName -> "c$multiPrimSelect"), _) -> True @@ -356,16 +372,16 @@ -- Set the initialization value of a signal when a primitive wants to set it getResInits :: (Id, Term) -> NetlistMonad [Expr] - getResInits (i,collectArgsTicks -> (k,args0,ticks)) = case k of + getResInits (i,collectArgs -> (k,args0)) = case k of Prim p -> extractPrimWarnOrFail (primName p) >>= go p _ -> return [] where - go pInfo (BlackBox {resultInits=nmDs, multiResult=True}) = withTicks ticks $ \_ -> do + go pInfo (BlackBox {resultInits=nmDs, multiResult=True}) = do tcm <- Lens.view tcCache let (args1, res) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args0 (bbCtx, _) <- mkBlackBoxContext (primName pInfo) Concurrent res args1 mapM (go' (primName pInfo) bbCtx) nmDs - go pInfo (BlackBox {resultInits=nmDs}) = withTicks ticks $ \_ -> do + go pInfo (BlackBox {resultInits=nmDs}) = do (bbCtx, _) <- mkBlackBoxContext (primName pInfo) Concurrent [i] args0 mapM (go' (primName pInfo) bbCtx) nmDs go _ _ = pure [] diff --git a/src/Clash/Netlist/Types.hs b/src/Clash/Netlist/Types.hs --- a/src/Clash/Netlist/Types.hs +++ b/src/Clash/Netlist/Types.hs @@ -75,6 +75,7 @@ import Clash.Annotations.TopEntity (TopEntity) import Clash.Backend (Backend, HasUsageMap (..)) import Clash.Core.HasType +import Clash.Core.PartialEval (Evaluator) import Clash.Core.Type (Type) import Clash.Core.Var (Id) import Clash.Core.TyCon (TyConMap) @@ -282,6 +283,11 @@ -- ^ Postfix for instance/register names , _setName :: Maybe Text -- ^ (Maybe) user given instance/register name + , _localAttrs :: [Attr Text] + -- ^ Synthesis attributes brough into scope by + -- 'Clash.Annotations.SynthesisAttributes.annotateReg' + , _peEvaluator :: Evaluator + -- ^ Evaluator to evaluate a term to Normal Form } data ComponentMeta = ComponentMeta diff --git a/src/Clash/Netlist/Util.hs b/src/Clash/Netlist/Util.hs --- a/src/Clash/Netlist/Util.hs +++ b/src/Clash/Netlist/Util.hs @@ -55,6 +55,7 @@ import Data.Maybe (catMaybes, fromMaybe, isNothing, mapMaybe, isJust, listToMaybe, maybeToList) import Text.Printf (printf) +import Data.Proxy import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Extra (showt) @@ -68,6 +69,8 @@ #endif import GHC.Stack (HasCallStack) +import GHC.TypeLits (someNatVal) +import GHC.TypeNats (SomeNat(..)) #if MIN_VERSION_ghc(9,0,0) import GHC.Utils.Monad (zipWith3M) @@ -90,11 +93,12 @@ import Clash.Core.DataCon (DataCon (..)) import Clash.Core.EqSolver (typeEq) import Clash.Core.FreeVars (typeFreeVars, typeFreeVars') -import Clash.Core.HasFreeVars (elemFreeVars) +import Clash.Core.HasFreeVars (elemFreeVars, isClosed) import Clash.Core.HasType import qualified Clash.Core.Literal as C import Clash.Core.Name - (Name (..), appendToName, nameOcc) + (Name (..), appendToName, mkUnsafeSystemName, nameOcc) +import Clash.Core.PartialEval import Clash.Core.Pretty (showPpr) import Clash.Core.Subst (Subst (..), extendIdSubst, extendIdSubstList, extendInScopeId, @@ -103,16 +107,18 @@ (primMultiResult, MultiPrimInfo(..), Alt, LetBinding, Pat (..), Term (..), TickInfo (..), NameMod (..), IsMultiPrim (..), collectArgsTicks, collectTicks, collectBndrs, PrimInfo(primName), mkTicks, stripTicks) import Clash.Core.TermInfo +import Clash.Core.TermLiteral (termToDataError) import Clash.Core.TyCon (TyCon (FunTyCon), TyConName, TyConMap, tyConDataCons) import Clash.Core.Type - (Type (..), TyVar, TypeView (..), coreView1, normalizeType, splitTyConAppM, tyView) + (LitTy (..), Type (..), TyVar, TypeView (..), coreView, coreView1, normalizeType, + splitTyConAppM, tyView) import Clash.Core.Util (substArgTys, tyLitShow) import Clash.Core.Var (Id, Var (..), mkLocalId, modifyVarName) import Clash.Core.VarEnv - (InScopeSet, extendInScopeSetList, uniqAway, lookupVarEnv) + (InScopeSet, extendInScopeSetList, uniqAway, lookupVarEnv, emptyInScopeSet) import qualified Clash.Data.UniqMap as UniqMap import {-# SOURCE #-} Clash.Netlist.BlackBox import {-# SOURCE #-} Clash.Netlist.BlackBox.Util @@ -121,8 +127,10 @@ import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types as HW import Clash.Primitives.Types +import qualified Clash.Sized.Vector as V import Clash.Util import qualified Clash.Util.Interpolate as I +import Clash.Util.Supply hmFindWithDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v #if MIN_VERSION_unordered_containers(0,2,11) @@ -220,8 +228,7 @@ :: String -> Type -> NetlistMonad HWType -unsafeCoreTypeToHWTypeM' loc ty = - stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty +unsafeCoreTypeToHWTypeM' loc ty = stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty -- | Converts a Core type to a HWType within the NetlistMonad; errors on failure unsafeCoreTypeToHWTypeM @@ -1881,6 +1888,56 @@ go decls (SrcSpan sp:ticks) = go (TickDecl (Comment (Text.pack (showSDocUnsafe (ppr sp)))):decls) ticks + go decls (Attributes ty attrs0:ticks) = do + -- We have 'Term', `attrs0`, that represents a value of type `Vec n (Attr String)`. + -- We want to convert this to an actual value of type `Vec n (Attr String)`, for + -- which we will use `termToDataError`. + -- + -- The `termToDataError` only works well for completely evaluated literals. + -- Sometimes we end up with a term which hasn't been complete beta-reduced, e.g. + -- `(/\b.Nil 0 b (0~0)) Bool` which represents a value of type `Vec 0 Bool`, for + -- which `termToDataError` would create an error-value. + -- + -- To ensure that we only pass literals to `termToDataError` we first evaluate + -- `attrs0` to Normal Form (NF) using the partial evaluators. + tcm <- Lens.view tcCache + case coreView tcm ty of + LitTy (NumTy n) + | Just (SomeNat (Proxy :: Proxy n)) <- someNatVal n + -> if isClosed attrs0 then do + -- Step 1. Evaluate to normal form + nm <- Lens.use bindings + ids <- State.liftIO newSupply + eval <- Lens.view peEvaluator + let attrsTy = inferCoreTypeOf tcm attrs0 + -- Safe to use `mkUnsafeSystemName` here, because attrs0 has no + -- free variables (it's closed), meaning there can be no shadowing + attrsName = mkUnsafeSystemName "attrs" 0 + attrsId = mkLocalId attrsTy attrsName + + genv = mkGlobalEnv nm tcm emptyInScopeSet ids 20 mempty 0 + -- Force attributes term to Normal Form so that it is a simple literal + -- that is understood by `termToDataError`. + (attrs1,_) <- State.liftIO (nf eval genv True attrsId attrs0) + + -- Step 2. Create data from the term + case termToDataError attrs1 of + Left msg -> error msg + Right attrs2 -> + -- Step 3. Finally add the attributes to the environment. + let attrs3 = fmap (fmap Text.pack) attrs2 + in local (\env -> env {_localAttrs = V.toList @n attrs3}) (go decls ticks) + else + error errFV + _ -> error errNoNum + where + errHeader = "ERROR: cannot add attribues: " <> showPpr attrs0 + errNoNum = unlines [errHeader + ,"REASON: Internal length is not a literal" <> showPpr ty] + errFV = unlines [errHeader + ,"REASON: attributes mentions variables" <> showPpr attrs0 + ] + go decls (NameMod m nm0:ticks) = do tcm <- Lens.view tcCache case runExcept (tyLitShow tcm nm0) of @@ -1904,7 +1961,7 @@ :: Text -> NetlistMonad Text affixName nm0 = do - NetlistEnv _ pre suf _ <- ask + NetlistEnv _ pre suf _ _ _ <- ask let nm1 = if Text.null pre then nm0 else pre <> "_" <> nm0 nm2 = if Text.null suf then nm1 else nm1 <> "_" <> suf return nm2 diff --git a/src/Clash/Normalize.hs b/src/Clash/Normalize.hs --- a/src/Clash/Normalize.hs +++ b/src/Clash/Normalize.hs @@ -18,7 +18,7 @@ import Control.Exception (throw) import qualified Control.Lens as Lens -import Control.Monad (when) +import Control.Monad ((>=>), when) import Control.Monad.State.Strict (State) import Data.Default (def) import Data.Either (lefts,partitionEithers) @@ -143,11 +143,24 @@ normalize :: [Id] -> NormalizeSession BindingMap -normalize [] = return emptyVarEnv -normalize top = do - (new,topNormalized) <- unzip <$> mapM normalize' top - newNormalized <- normalize (concat new) - return (unionVarEnv (mkVarEnv topNormalized) newNormalized) +normalize = go >=> unionWithCache + where + go [] = return emptyVarEnv + go top = do + (new,topNormalized) <- unzip <$> mapM normalize' top + newNormalized <- normalize (concat new) + return (unionVarEnv (mkVarEnv topNormalized) newNormalized) + + unionWithCache :: BindingMap -> NormalizeSession BindingMap + unionWithCache env = do + cache <- Lens.use (extra.normalized) + -- We need to include the cache in our final result, forgetting to do so + -- leads to https://github.com/clash-lang/clash-compiler/issues/3109 + -- + -- On the other hand, just returning the cache as our final result could + -- not be enough, because normalize' might return a non-normalized binder + -- that is later picked up and cleaned up by flattenCallTree. + return (unionVarEnv cache env) normalize' :: Id -> NormalizeSession ([Id], (Id, Binding Term)) normalize' nm = do diff --git a/src/Clash/Normalize/Transformations/Cast.hs b/src/Clash/Normalize/Transformations/Cast.hs --- a/src/Clash/Normalize/Transformations/Cast.hs +++ b/src/Clash/Normalize/Transformations/Cast.hs @@ -47,11 +47,11 @@ -- -- The reason d'etre for this transformation is that we hope to end up with -- and expression where two casts are "back-to-back" after which we can --- eliminate them in 'eliminateCastCast'. +-- eliminate them in 'elimCastCast'. argCastSpec :: HasCallStack => NormRewrite argCastSpec ctx e@(App f (stripTicks -> Cast e' _ _)) -- Don't specialise when the arguments are casts-of-casts, these casts-of-casts - -- will be eliminated by 'eliminateCastCast' during the normalization of the + -- will be eliminated by 'elimCastCast' during the normalization of the -- "current" function. We thus prevent the unnecessary introduction of a -- specialized version of 'f'. | not (isCast e') diff --git a/src/Clash/Primitives/Sized/Signed.hs b/src/Clash/Primitives/Sized/Signed.hs --- a/src/Clash/Primitives/Sized/Signed.hs +++ b/src/Clash/Primitives/Sized/Signed.hs @@ -3,7 +3,7 @@ License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. - VHDL Blackbox implementations for "Clash.Sized.Internal.Signed.toInteger#". + VHDL Blackbox implementations for 'Clash.Sized.Internal.Signed.fromInteger#'. -} {-# LANGUAGE OverloadedStrings #-} diff --git a/src/Clash/Primitives/Sized/ToInteger.hs b/src/Clash/Primitives/Sized/ToInteger.hs --- a/src/Clash/Primitives/Sized/ToInteger.hs +++ b/src/Clash/Primitives/Sized/ToInteger.hs @@ -153,7 +153,7 @@ _ -> case hty of BitVector {} -> "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[bv][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[bv][1]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" Index {} -> "~IF~SIZE[~TYP[0]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[0]]]~THEN$unsigned(~VAR[i][0][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {1'b0}},~VAR[i][0]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" - Signed {} -> "~IF~SIZE[~TYP[0]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[0]]]~THEN$signed(~VAR[i][0][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {1'b0}},~VAR[i][0]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" + Signed {} -> "~IF~SIZE[~TYP[0]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[0]]]~THEN$signed(~VAR[i][0][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {~VAR[i][0][~SIZE[~TYP[0]]-1]}},~VAR[i][0]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" Unsigned {} -> "~IF~SIZE[~TYP[0]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[0]]]~THEN$unsigned(~VAR[i][0][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {1'b0}},~VAR[i][0]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" _ -> error "internal error" diff --git a/src/Clash/Primitives/Verification.hs b/src/Clash/Primitives/Verification.hs --- a/src/Clash/Primitives/Verification.hs +++ b/src/Clash/Primitives/Verification.hs @@ -1,3 +1,11 @@ +{-| + Copyright : (C) 2019 , Myrtle Software Ltd + 2021 , Ellie Hermaszewska + 2020-2025, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + {-# LANGUAGE OverloadedStrings #-} module Clash.Primitives.Verification (checkBBF) where @@ -11,14 +19,14 @@ import Data.Maybe (listToMaybe) import Data.Monoid (Ap(getAp)) import Data.Text.Prettyprint.Doc.Extra (Doc) -import qualified Data.Text as Text +import Data.Text (Text) import GHC.Stack (HasCallStack) import Clash.Annotations.Primitive (HDL(..)) import Clash.Backend (Backend, blockDecl, hdlKind) import Clash.Core.HasType -import Clash.Core.Term (Term(Var), varToId) +import Clash.Core.Term (Term(Var)) import Clash.Core.TermLiteral (termToDataError) import Clash.Util (indexNote) import Clash.Netlist (mkExpr) @@ -41,10 +49,11 @@ case litArgs of Left err -> pure (Left err) Right (propName, renderAs, cvProperty0) -> do + clkBind <- bindMaybe (Just "clk") (indexNote "clk" (lefts args) clkArg) cvProperty1 <- mapM (uncurry bindMaybe) cvProperty0 let decls = concatMap snd cvProperty1 cvProperty2 = fmap fst cvProperty1 - pure (Right (meta, bb (checkTF decls (clkExpr, clkId) propName renderAs cvProperty2))) + pure (Right (meta, bb (checkTF decls clkBind propName renderAs cvProperty2))) where -- TODO: Improve error handling; currently errors don't indicate what -- TODO: blackbox generated them. @@ -55,8 +64,6 @@ :< renderAsArg :< propArg :< _ = ((0 :: Int)...) - (Id.unsafeFromCoreId -> clkId) = varToId (indexNote "clk" (lefts args) clkArg) - clkExpr = Identifier clkId Nothing litArgs = do propName <- termToDataError (indexNote "propName" (lefts args) propNameArg) @@ -68,7 +75,7 @@ meta = emptyBlackBoxMeta {bbKind=TDecl, bbRenderVoid=RenderVoid} bindMaybe - :: Maybe String + :: Maybe Text -- ^ Hint for new identifier -> Term -- ^ Term to bind. Does not bind if it's already a reference to a signal @@ -78,7 +85,7 @@ bindMaybe Nothing t = bindMaybe (Just "s") t bindMaybe (Just nm) t = do tcm <- Lens.view tcCache - newId <- Id.make (Text.pack nm) + newId <- Id.make nm (expr0, decls) <- mkExpr False Concurrent (NetlistId newId (inferCoreTypeOf tcm t)) t assn <- contAssign newId expr0 pure @@ -91,8 +98,8 @@ checkTF :: [Declaration] - -> (Expr, Identifier) - -> Text.Text + -> (Identifier, [Declaration]) + -> Text -> RenderAs -> Property' Identifier -> TemplateFunction @@ -104,20 +111,21 @@ . (HasCallStack, Backend s) => [Declaration] -- ^ Extra decls needed - -> (Expr, Identifier) + -> (Identifier, [Declaration]) -- ^ Clock - -> Text.Text + -> Text -- ^ Prop name -> RenderAs -> Property' Identifier -> BlackBoxContext -> State s Doc -checkTF' decls (clk, clkId) propName renderAs prop bbCtx = do +checkTF' decls (clkId, clkDecls) propName renderAs prop bbCtx = do blockName <- Id.makeBasic (propName <> "_block") - getAp (blockDecl blockName (renderedPslProperty : decls)) + getAp (blockDecl blockName (clkDecls <> (renderedPslProperty : decls))) where hdl = hdlKind (undefined :: s) + clk = Identifier clkId Nothing edge = case bbInputs bbCtx of