diff --git a/.ci/bindist/README.md b/.ci/bindist/README.md index a22d4360aa..02518a7dd7 100644 --- a/.ci/bindist/README.md +++ b/.ci/bindist/README.md @@ -28,7 +28,9 @@ triggered on any other branch a _beta_ release gets made. ## Releasing a new version major version (1.x) 1. Change version numbers in: * `clash-prelude/clash-prelude.cabal` + * `clash-prelude-hedgehog/clash-prelude-hedgehog.cabal` * `clash-lib/clash-lib.cabal` + * `clash-lib-hedgehog/clash-lib-hedgehog.cabal` * `clash-ghc/clash-ghc.cabal` * `clash-ghc/clash-cores.cabal` * `.ci/bindist/linux/snap/snap/snapcraft.yaml` diff --git a/.ci/docker/Dockerfile b/.ci/docker/Dockerfile index 3826624622..81545ffa51 100644 --- a/.ci/docker/Dockerfile +++ b/.ci/docker/Dockerfile @@ -107,7 +107,7 @@ RUN git clone https://github.com/verilator/verilator verilator \ FROM builder AS build-ghc -ARG ghcup_version="0.1.15.2" +ARG ghcup_version="0.1.17.4" # Must be explicitly set ARG ghc_version diff --git a/.ci/docker/build-and-publish-docker-image.sh b/.ci/docker/build-and-publish-docker-image.sh index 97cccaead5..df80acfdad 100755 --- a/.ci/docker/build-and-publish-docker-image.sh +++ b/.ci/docker/build-and-publish-docker-image.sh @@ -7,7 +7,7 @@ NAME="clash-ci-" DIR=$(dirname "$0") now=$(date +%F) -GHC_VERSIONS=( "9.0.1" "8.10.2" "8.8.4" "8.6.5") +GHC_VERSIONS=( "9.0.2" "8.10.2" "8.8.4" "8.6.5") CABAL_VERSIONS=("3.4.0.0" "3.2.0.0" "3.2.0.0" "3.0.0.0") # We want to use docker buildkit so that our layers are built in parallel. This diff --git a/.ci/gitlab/benchmark.yml b/.ci/gitlab/benchmark.yml index 0cc9b1267e..68e8472516 100644 --- a/.ci/gitlab/benchmark.yml +++ b/.ci/gitlab/benchmark.yml @@ -1,5 +1,5 @@ .benchmark: - image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-01-25 + image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-02-02 stage: test timeout: 2 hours variables: diff --git a/.ci/gitlab/common.yml b/.ci/gitlab/common.yml index 48345cde7e..e450ea67c0 100644 --- a/.ci/gitlab/common.yml +++ b/.ci/gitlab/common.yml @@ -1,5 +1,5 @@ .common: - image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-01-25 + image: ghcr.io/clash-lang/clash-ci-$GHC_VERSION:2022-02-02 timeout: 2 hours stage: build variables: diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ecd3a1e18c..b2fb5dab26 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -28,13 +28,13 @@ jobs: ghc: 8.10.2 multiple_hidden: yes - - name: GHC 9.0.1, Multiple Hidden - ghc: 9.0.1 + - name: GHC 9.0.2, Multiple Hidden + ghc: 9.0.2 multiple_hidden: yes # Run steps inside the clash CI docker image container: - image: ghcr.io/clash-lang/clash-ci-${{ matrix.ghc }}:2022-01-25 + image: ghcr.io/clash-lang/clash-ci-${{ matrix.ghc }}:2022-02-02 env: THREADS: 2 diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 455b9af744..a58974482a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -49,7 +49,7 @@ tests-8.10: tests-9.0: extends: .common-trigger variables: - GHC_VERSION: 9.0.1 + GHC_VERSION: 9.0.2 stack-build: extends: .common diff --git a/benchmark/benchmark-normalization.hs b/benchmark/benchmark-normalization.hs index a69a6f9caf..cc8070dbb2 100644 --- a/benchmark/benchmark-normalization.hs +++ b/benchmark/benchmark-normalization.hs @@ -44,15 +44,16 @@ benchFile idirs src = env (setupEnv idirs src) $ \ ~(clashEnv, clashDesign, supplyN) -> do bench ("normalization of " ++ src) - (nf (normalizeEntity - clashEnv - (designBindings clashDesign) - (ghcTypeToHWType (opt_intWidth (envOpts clashEnv))) - ghcEvaluator - evaluator - (fmap topId (designEntities clashDesign)) - supplyN) - (topId (head (designEntities clashDesign)))) + (nfIO + (normalizeEntity + clashEnv + (designBindings clashDesign) + (ghcTypeToHWType (opt_intWidth (envOpts clashEnv))) + ghcEvaluator + evaluator + (fmap topId (designEntities clashDesign)) + supplyN + (topId (head (designEntities clashDesign))))) setupEnv :: [FilePath] diff --git a/benchmark/common/BenchmarkCommon.hs b/benchmark/common/BenchmarkCommon.hs index 6814ef9a4a..c3390ffa25 100644 --- a/benchmark/common/BenchmarkCommon.hs +++ b/benchmark/common/BenchmarkCommon.hs @@ -60,7 +60,7 @@ runNormalisationStage idirs src = do (env, design) <- runInputStage idirs src let topEntityNames = fmap topId (designEntities design) let topEntity = head topEntityNames - let transformedBindings = + transformedBindings <- normalizeEntity env (designBindings design) (ghcTypeToHWType (opt_intWidth (opts idirs))) ghcEvaluator diff --git a/benchmark/profiling/run/profile-normalization-run.hs b/benchmark/profiling/run/profile-normalization-run.hs index dcaaf76305..f02c00619b 100644 --- a/benchmark/profiling/run/profile-normalization-run.hs +++ b/benchmark/profiling/run/profile-normalization-run.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} import Clash.Driver -import Clash.Driver.Types +import Clash.Driver.Types (ClashEnv(..), ClashOpts(opt_intWidth)) import Clash.GHC.PartialEval import Clash.GHC.Evaluator @@ -43,7 +43,7 @@ benchFile idirs src = do , envCustomReprs = reprs } - res = normalizeEntity clashEnv bindingsMap + res <- normalizeEntity clashEnv bindingsMap (ghcTypeToHWType (opt_intWidth (envOpts clashEnv))) ghcEvaluator evaluator diff --git a/changelog/2022-01-31T08_51_47+01_00_memblob b/changelog/2022-01-31T08_51_47+01_00_memblob new file mode 100644 index 0000000000..8b41620b11 --- /dev/null +++ b/changelog/2022-01-31T08_51_47+01_00_memblob @@ -0,0 +1 @@ +ADDED: The `MemBlob` structure: efficient constants for initializing memories. Depending on how the content is constructed, a `Vec` for the initial memory content can turn out to be prohibitively slow. In these cases, `MemBlob` can store your content efficiently. [#2041](https://github.com/clash-lang/clash-compiler/pull/2041) diff --git a/changelog/2022-01-31T12_23_39+01_00_spurious_integer_warnings.md b/changelog/2022-01-31T12_23_39+01_00_spurious_integer_warnings.md new file mode 100644 index 0000000000..efb35a4b7a --- /dev/null +++ b/changelog/2022-01-31T12_23_39+01_00_spurious_integer_warnings.md @@ -0,0 +1 @@ +CHANGED: toEnum/fromEnum on sized types is now less eager to report warnings about integer functions being used [#2046](https://github.com/clash-lang/clash-compiler/issues/2046). diff --git a/changelog/2022-01-31T16_53_31+01_00_werror_clash.md b/changelog/2022-01-31T16_53_31+01_00_werror_clash.md new file mode 100644 index 0000000000..8f1243f26d --- /dev/null +++ b/changelog/2022-01-31T16_53_31+01_00_werror_clash.md @@ -0,0 +1 @@ +CHANGED: Clash now respects the -Werror option from GHC diff --git a/clash-ghc/src-bin-8.10/Clash/Main.hs b/clash-ghc/src-bin-8.10/Clash/Main.hs index ba92e62d1e..ffcc2ab297 100644 --- a/clash-ghc/src-bin-8.10/Clash/Main.hs +++ b/clash-ghc/src-bin-8.10/Clash/Main.hs @@ -52,6 +52,7 @@ import Packages ( pprPackages, pprPackagesSimple ) import DriverPhases import BasicTypes ( failed ) import DynFlags hiding (WarnReason(..)) +import EnumSet as EnumSet import ErrUtils import FastString import Outputable @@ -88,7 +89,7 @@ import Data.Maybe import Paths_clash_ghc import Clash.GHCi.UI (makeHDL) import Exception (gcatch) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (IORef, newIORef, readIORef, modifyIORef') import qualified Data.Version (showVersion) import Clash.Backend (Backend) @@ -236,6 +237,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do (dflags3, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags2 args + -- Propagate -Werror to Clash + liftIO . modifyIORef' clashOpts $ \opts -> + opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) } + let dflags4 = case lang of HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) -> let platform = targetPlatform dflags3 diff --git a/clash-ghc/src-bin-861/Clash/Main.hs b/clash-ghc/src-bin-861/Clash/Main.hs index d3a12a2468..12a7f3f874 100644 --- a/clash-ghc/src-bin-861/Clash/Main.hs +++ b/clash-ghc/src-bin-861/Clash/Main.hs @@ -53,6 +53,7 @@ import Packages ( pprPackages, pprPackagesSimple ) import DriverPhases import BasicTypes ( failed ) import DynFlags hiding (WarnReason(..)) +import EnumSet as EnumSet import ErrUtils import FastString import Outputable @@ -86,7 +87,7 @@ import Data.Maybe import Paths_clash_ghc import Clash.GHCi.UI (makeHDL) import Exception (gcatch) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (IORef, newIORef, readIORef, modifyIORef') import qualified Data.Version (showVersion) import Clash.Backend (Backend) @@ -235,6 +236,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do (dflags3, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags2 args + -- Propagate -Werror to Clash + liftIO . modifyIORef' clashOpts $ \opts -> + opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) } + let dflags4 = case lang of HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) -> let platform = targetPlatform dflags3 diff --git a/clash-ghc/src-bin-881/Clash/Main.hs b/clash-ghc/src-bin-881/Clash/Main.hs index 0769622496..2763100086 100644 --- a/clash-ghc/src-bin-881/Clash/Main.hs +++ b/clash-ghc/src-bin-881/Clash/Main.hs @@ -50,6 +50,7 @@ import Packages ( pprPackages, pprPackagesSimple ) import DriverPhases import BasicTypes ( failed ) import DynFlags hiding (WarnReason(..)) +import EnumSet as EnumSet import ErrUtils import FastString import Outputable @@ -83,7 +84,7 @@ import Data.Maybe import Paths_clash_ghc import Clash.GHCi.UI (makeHDL) import Exception (gcatch) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (IORef, newIORef, readIORef, modifyIORef') import qualified Data.Version (showVersion) import Clash.Backend (Backend) @@ -230,6 +231,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do (dflags3, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags2 args + -- Propagate -Werror to Clash + liftIO . modifyIORef' clashOpts $ \opts -> + opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) } + let dflags4 = case lang of HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) -> let platform = targetPlatform dflags3 diff --git a/clash-ghc/src-bin-9.0/Clash/Main.hs b/clash-ghc/src-bin-9.0/Clash/Main.hs index 7e77a92eb2..86fa268d87 100644 --- a/clash-ghc/src-bin-9.0/Clash/Main.hs +++ b/clash-ghc/src-bin-9.0/Clash/Main.hs @@ -54,6 +54,7 @@ import GHC.Driver.Phases import GHC.Types.Basic ( failed ) import GHC.Driver.Session as DynFlags hiding (WarnReason(..)) import GHC.Utils.Error +import GHC.Data.EnumSet as EnumSet import GHC.Data.FastString import GHC.Utils.Outputable as Outputable import GHC.SysTools.BaseDir @@ -90,7 +91,7 @@ import Prelude import Paths_clash_ghc import Clash.GHCi.UI (makeHDL) import Control.Monad.Catch (catch) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (IORef, newIORef, readIORef, modifyIORef') import qualified Data.Version (showVersion) import Clash.Backend (Backend) @@ -237,6 +238,10 @@ main' postLoadMode dflags0 args flagWarnings startAction clashOpts = do (dflags3, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags2 args + -- Propagate -Werror to Clash + liftIO . modifyIORef' clashOpts $ \opts -> + opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) } + let dflags4 = case lang of HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) -> let platform = targetPlatform dflags3 diff --git a/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs b/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs index ca6580ab53..aa7c5b3d93 100644 --- a/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs +++ b/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , QBayLogic, Google Inc., - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -1929,6 +1929,12 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.BitVector.le##" | [(0,i),(0,j)] <- bitLiterals args -> reduce (boolToBoolLiteral tcm ty (i <= j)) +-- Enum + "Clash.Sized.Internal.BitVector.toEnum##" + | [i] <- intLiterals' args + -> let Bit msk val = BitVector.toEnum## (fromInteger i) + in reduce (mkBitLit ty (toInteger msk) (toInteger val)) + -- Bits "Clash.Sized.Internal.BitVector.and##" | [i,j] <- bitLiterals args @@ -2131,6 +2137,18 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of , Just val <- reifyNat kn (liftBitVector2Bool BitVector.le# ty tcm args) -> reduce val +-- Enum + + "Clash.Sized.Internal.BitVector.toEnum#" + | let resTyInfo@(_,_,kn) = extractTySizeInfo tcm ty tys + , Just val <- reifyNat kn (liftInteger2BitVector (BitVector.toEnum# . fromInteger) resTyInfo args) + -> reduce val + + "Clash.Sized.Internal.BitVector.fromEnum#" + | Just (_, kn) <- extractKnownNat tcm tys + , Just val <- reifyNat kn (liftBitVector2Int (toInteger . BitVector.fromEnum#) args) + -> reduce val + -- Bounded "Clash.Sized.Internal.BitVector.minBound#" | Just (nTy,len) <- extractKnownNat tcm tys @@ -2303,6 +2321,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of | Just (i,j) <- indexLiterals args -> reduce (boolToBoolLiteral tcm ty (i <= j)) +-- Enum + "Clash.Sized.Internal.Index.toEnum#" + | [i] <- intLiterals' args + , Just (nTy, mb) <- extractKnownNat tcm tys + -> reduce (mkIndexLit ty nTy mb i) + + "Clash.Sized.Internal.Index.fromEnum#" + | [i] <- indexLiterals' args + -> reduce (integerToIntLiteral i) + -- Bounded "Clash.Sized.Internal.Index.maxBound#" | Just (nTy,mb) <- extractKnownNat tcm tys @@ -2409,6 +2437,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.Signed.le#" | Just (i,j) <- signedLiterals args -> reduce (boolToBoolLiteral tcm ty (i <= j)) +-- Enum + "Clash.Sized.Internal.Signed.toEnum#" + | [i] <- intLiterals' args + , Just (litTy, mb) <- extractKnownNat tcm tys + -> reduce (mkSignedLit ty litTy mb i) + + "Clash.Sized.Internal.Signed.fromEnum#" + | [i] <- signedLiterals' args + -> reduce (integerToIntLiteral i) + -- Bounded "Clash.Sized.Internal.Signed.minBound#" | Just (litTy,mb) <- extractKnownNat tcm tys @@ -2616,6 +2654,16 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.Unsigned.le#" | Just (i,j) <- unsignedLiterals args -> reduce (boolToBoolLiteral tcm ty (i <= j)) +-- Enum + "Clash.Sized.Internal.Unsigned.toEnum#" + | [i] <- intLiterals' args + , Just (litTy, mb) <- extractKnownNat tcm tys + -> reduce (mkUnsignedLit ty litTy mb i) + + "Clash.Sized.Internal.Unsigned.fromEnum#" + | [i] <- unsignedLiterals' args + -> reduce (integerToIntLiteral i) + -- Bounded "Clash.Sized.Internal.Unsigned.minBound#" | Just (nTy,len) <- extractKnownNat tcm tys @@ -4403,6 +4451,32 @@ liftBitVector2Bool f ty tcm args _p in Just $ boolToBoolLiteral tcm ty val | otherwise = Nothing +liftInteger2BitVector + :: KnownNat n + => (Integer -> BitVector n) + -> (Type, Type, Integer) + -> [Value] + -> (Proxy n -> Maybe Term) +liftInteger2BitVector f resTyInfo args _p + | [i] <- intLiterals' args + = let BV msk val = f i + in Just (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val)) + + | otherwise + = Nothing + +liftBitVector2Int + :: KnownNat n + => (BitVector n -> Integer) + -> [Value] + -> (Proxy n -> Maybe Term) +liftBitVector2Int f args _p + | [i] <- bitVectorLiterals' args + = let val = f (toBV i) + in Just $ integerToIntLiteral val + | otherwise + = Nothing + liftSized2 :: (KnownNat n, Integral (sized n)) => ([Value] -> [Integer]) -- ^ literal argument extraction function diff --git a/clash-ghc/src-ghc/Clash/GHC/NetlistTypes.hs b/clash-ghc/src-ghc/Clash/GHC/NetlistTypes.hs index 12823c7873..30231c46e2 100644 --- a/clash-ghc/src-ghc/Clash/GHC/NetlistTypes.hs +++ b/clash-ghc/src-ghc/Clash/GHC/NetlistTypes.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2013-2016, University of Twente, - 2016-2017, Myrtle Software Ltd + 2016-2017, Myrtle Software Ltd, + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} @@ -232,6 +233,12 @@ ghcTypeToHWType iw = go let filtered = [replicate sz1 (isVoid, fElHWTy)] return (FilteredHWType vecHWTy filtered) + "Clash.Explicit.BlockRam.Internal.MemBlob" -> do + let [nTy, mTy] = args + n0 <- liftE (tyNatSize m nTy) + m0 <- liftE (tyNatSize m mTy) + returnN (MemBlob (fromInteger n0) (fromInteger m0)) + "Clash.Sized.RTree.RTree" -> do let [szTy,elTy] = args sz0 <- liftE (tyNatSize m szTy) @@ -252,6 +259,7 @@ ghcTypeToHWType iw = go return (FilteredHWType vecHWTy filtered) "String" -> returnN String + "GHC.Prim.Addr#" -> returnN String "GHC.Types.[]" -> case tyView (head args) of (TyConApp (nameOcc -> "GHC.Types.Char") []) -> returnN String _ -> throwE $ "Can't translate type: " ++ showPpr ty diff --git a/clash-lib/prims/commonverilog/Clash_Explicit_SimIO.primitives b/clash-lib/prims/commonverilog/Clash_Explicit_SimIO.primitives index 8b8bbdb402..3022452711 100644 --- a/clash-lib/prims/commonverilog/Clash_Explicit_SimIO.primitives +++ b/clash-lib/prims/commonverilog/Clash_Explicit_SimIO.primitives @@ -126,7 +126,7 @@ $finish_and_return(~LIT[0]); } } , { "Primitive" : - { "name" : "Clash.Explicit.SimIO.unSimIO#" + { "name" : "Clash.Explicit.SimIO.unSimIO" , "primType" : "Function" } } diff --git a/clash-lib/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives b/clash-lib/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives index e29e95e3ac..d6e60d3d29 100644 --- a/clash-lib/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives +++ b/clash-lib/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives @@ -91,6 +91,14 @@ , "template" : "~VAR[i][0][0] ? 1'bx : ~VAR[i][1][0]" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.toEnum##" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum## :: Int -> Bit" + , "template" : "~VAR[i][0][0] ? 1'b1 : 1'b0" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.BitVector.and##" , "kind" : "Expression" @@ -167,6 +175,13 @@ , "templateFunction" : "Clash.Primitives.Sized.ToInteger.bvToIntegerVerilog" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => BitVector n -> Int" + , "template" : "~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" } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.BitVector.size#" , "workInfo" : "Constant" @@ -287,6 +302,14 @@ , "template" : "~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[2]]]~THEN$unsigned(~VAR[i][2][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[2]]) {1'b0}},~VAR[i][2]})~FI" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> BitVector n" + , "template" : "~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.BitVector.plus#" , "kind" : "Declaration" diff --git a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Index.primitives b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Index.primitives index 4b0a1480df..43fe884cbb 100644 --- a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Index.primitives +++ b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Index.primitives @@ -64,6 +64,22 @@ , "template" : "~ARG[0]-~SIZE[~TYPO]'d1" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => Index n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> Index n" + , "template" : "~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Index.+#" , "kind" : "Expression" diff --git a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives index 425dce5c71..71f38dfe1f 100644 --- a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives +++ b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives @@ -46,6 +46,14 @@ , "templateFunction" : "Clash.Primitives.Sized.ToInteger.signedToIntegerVerilog" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "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" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Signed.size#" , "workInfo" : "Constant" @@ -117,6 +125,14 @@ , "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" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "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" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Signed.plus#" , "kind" : "Declaration" diff --git a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives index 0be2c82f08..e4fef99059 100644 --- a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives +++ b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives @@ -46,6 +46,14 @@ , "templateFunction" : "Clash.Primitives.Sized.ToInteger.unsignedToIntegerVerilog" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => Unsigned n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Unsigned.size#" , "workInfo" : "Constant" @@ -108,6 +116,14 @@ , "template" : "~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> Unsigned n" + , "template" : "~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$unsigned(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$unsigned({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~VAR[i][1]})~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Unsigned.plus#" , "kind" : "Declaration" diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives index c0ade59d67..123dfcdd9d 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives @@ -171,19 +171,19 @@ logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[mem][0] [~LIT[1]-1:0]; // Port A always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[6]) begin - ~SYM[1] <= ~SYM[0][~ARG[8]]; + ~SYM[1] <= ~SYM[0][~IF~SIZE[~TYP[8]]~THEN~ARG[8]~ELSE0~FI]; if(~ARG[7]) begin ~SYM[1] <= ~ARG[9]; - ~SYM[0][~ARG[8]] <= ~ARG[9]; + ~SYM[0][~IF~SIZE[~TYP[8]]~THEN~ARG[8]~ELSE0~FI] <= ~ARG[9]; end end // Port B always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[10]) begin - ~SYM[2] <= ~SYM[0][~ARG[12]]; + ~SYM[2] <= ~SYM[0][~IF~SIZE[~TYP[12]]~THEN~ARG[12]~ELSE0~FI]; if(~ARG[11]) begin ~SYM[2] <= ~ARG[13]; - ~SYM[0][~ARG[12]] <= ~ARG[13]; + ~SYM[0][~IF~SIZE[~TYP[12]]~THEN~ARG[12]~ELSE0~FI] <= ~ARG[13]; end end diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives new file mode 100644 index 0000000000..2d54baae19 --- /dev/null +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives @@ -0,0 +1,46 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.Blob.blockRamBlob#" + , "kind" : "Declaration" + , "type" : +"blockRamBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom Bool -- wren, ARG[5] + -> Signal dom Int -- wr, ARG[6] + -> Signal dom (BitVector m) -- din, ARG[7] + -> Signal dom (BitVector m)" + , "template" : +"// blockRamBlob begin +~SIGD[~GENSYM[RAM][1]][3]; +logic [~SIZE[~TYP[7]]-1:0] ~GENSYM[~RESULT_q][2]; +initial begin + ~SYM[1] = ~CONST[3]; +end~IF ~ISACTIVEENABLE[2] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + if (~ARG[2]) begin + if (~ARG[5]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + ~SYM[2] <= ~SYM[1][~ARG[4]]; + end~ELSE + if (~ARG[5] & ~ARG[2]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + if (~ARG[2]) begin + ~SYM[2] <= ~SYM[1][~ARG[4]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] + if (~ARG[5]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + ~SYM[2] <= ~SYM[1][~ARG[4]]; +end~FI +assign ~RESULT = ~SYM[2]; +// blockRamBlob end" + } + } +] diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives new file mode 100644 index 0000000000..81af4f1fb3 --- /dev/null +++ b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives @@ -0,0 +1,31 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.Blob.romBlob#" + , "kind" : "Declaration" + , "type" : +"romBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom (BitVector m)" + , "template" : +"// romBlob begin +~SIGD[~GENSYM[ROM][1]][3]; +assign ~SYM[1] = ~CONST[3]; + +logic [~SIZE[~TYPO]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[2] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][3] + if (~ARG[2]) begin + ~SYM[2] <= ~SYM[1][~ARG[4]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] + ~SYM[2] <= ~SYM[1][~ARG[4]]; +end~FI + +assign ~RESULT = ~SYM[2]; +// rom end" + } + } +] diff --git a/clash-lib/prims/systemverilog/Clash_Prelude_ROM.primitives b/clash-lib/prims/systemverilog/Clash_Prelude_ROM.primitives index ed739e0f32..1fc74ae4f0 100644 --- a/clash-lib/prims/systemverilog/Clash_Prelude_ROM.primitives +++ b/clash-lib/prims/systemverilog/Clash_Prelude_ROM.primitives @@ -9,7 +9,7 @@ , "template" : "// asyncRom begin ~SIGD[~GENSYM[ROM][0]][1]; -assign ~SYM[0] = ~LIT[1]; +assign ~SYM[0] = ~CONST[1]; assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[2]\\]][~TYPO]; // asyncRom end" diff --git a/clash-lib/prims/systemverilog/Clash_Prelude_ROM_Blob.primitives b/clash-lib/prims/systemverilog/Clash_Prelude_ROM_Blob.primitives new file mode 100644 index 0000000000..e1097b70f8 --- /dev/null +++ b/clash-lib/prims/systemverilog/Clash_Prelude_ROM_Blob.primitives @@ -0,0 +1,18 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.Blob.asyncRomBlob#" + , "kind" : "Declaration" + , "type" : +"asyncRomBlob# + :: MemBlob n m -- ARG[0] + -> Int -- ARG[1] + -> BitVector m" + , "template" : +"// asyncRomBlob begin +~SIGD[~GENSYM[ROM][0]][0]; +assign ~SYM[0] = ~CONST[0]; + +assign ~RESULT = ~SYM[0][~ARG[1]]; +// asyncRomBlob end" + } + } +] diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives index 52f648c1da..533eea6fdd 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives @@ -182,23 +182,24 @@ reg ~SIGD[~GENSYM[data_fast][2]][13]; // Port A always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[6]) begin - ~SYM[1] <= ~SYM[0][~ARG[8]]; + ~SYM[1] <= ~SYM[0][~IF~SIZE[~TYP[8]]~THEN~ARG[8]~ELSE0~FI]; if(~ARG[7]) begin ~SYM[1] <= ~ARG[9]; - ~SYM[0][~ARG[8]] <= ~ARG[9]; + ~SYM[0][~IF~SIZE[~TYP[8]]~THEN~ARG[8]~ELSE0~FI] <= ~ARG[9]; end end // Port B always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[10]) begin - ~SYM[2] <= ~SYM[0][~ARG[12]]; + ~SYM[2] <= ~SYM[0][~IF~SIZE[~TYP[12]]~THEN~ARG[12]~ELSE0~FI]; if(~ARG[11]) begin ~SYM[2] <= ~ARG[13]; - ~SYM[0][~ARG[12]] <= ~ARG[13]; + ~SYM[0][~IF~SIZE[~TYP[12]]~THEN~ARG[12]~ELSE0~FI] <= ~ARG[13]; end end assign ~RESULT = {~SYM[1], ~SYM[2]}; + // end trueDualPortBlockRam" } } diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives new file mode 100644 index 0000000000..f06043c8b1 --- /dev/null +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives @@ -0,0 +1,52 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.Blob.blockRamBlob#" + , "kind" : "Declaration" + , "type" : +"blockRamBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom Bool -- wren, ARG[5] + -> Signal dom Int -- wr, ARG[6] + -> Signal dom (BitVector m) -- din, ARG[7] + -> Signal dom (BitVector m)" + , "outputReg" : true + , "template" : +"// blockRamBlob begin +reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[3]]-1]; + +reg ~TYP[3] ~GENSYM[ram_init][3]; +integer ~GENSYM[i][4]; +initial begin + ~SYM[3] = ~CONST[3]; + for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[3]]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LENGTH[~TYP[3]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + end +end +~IF ~ISACTIVEENABLE[2] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + if (~ARG[2]) begin + if (~ARG[5]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + ~RESULT <= ~SYM[1][~ARG[4]]; + end~ELSE + if (~ARG[5] & ~ARG[2]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + if (~ARG[2]) begin + ~RESULT <= ~SYM[1][~ARG[4]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] + if (~ARG[5]) begin + ~SYM[1][~ARG[6]] <= ~ARG[7]; + end + ~RESULT <= ~SYM[1][~ARG[4]]; +end~FI +// blockRamBlob end" + } + } +] diff --git a/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives b/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives new file mode 100644 index 0000000000..5af30b10b0 --- /dev/null +++ b/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives @@ -0,0 +1,37 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.Blob.romBlob#" + , "kind" : "Declaration" + , "type" : +"romBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom (BitVector m)" + , "outputReg" : true + , "template" : +"// romBlob begin +reg ~TYPO ~GENSYM[ROM][1] [0:~LENGTH[~TYP[3]]-1]; + +reg ~TYP[3] ~GENSYM[rom_init][3]; +integer ~GENSYM[i][4]; +initial begin + ~SYM[3] = ~CONST[3]; + for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[3]]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LENGTH[~TYP[3]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + end +end +~IF ~ISACTIVEENABLE[2] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][5] + if (~ARG[2]) begin + ~RESULT <= ~SYM[1][~ARG[4]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] + ~RESULT <= ~SYM[1][~ARG[4]]; +end~FI +// romBlob end" + } + } +] diff --git a/clash-lib/prims/verilog/Clash_Prelude_ROM.primitives b/clash-lib/prims/verilog/Clash_Prelude_ROM.primitives index 24a9089367..2d8b5da24d 100644 --- a/clash-lib/prims/verilog/Clash_Prelude_ROM.primitives +++ b/clash-lib/prims/verilog/Clash_Prelude_ROM.primitives @@ -11,7 +11,7 @@ wire ~TYPO ~GENSYM[ROM][0] [0:~LIT[0]-1]; wire ~TYP[1] ~GENSYM[romflat][1]; -assign ~SYM[1] = ~LIT[1]; +assign ~SYM[1] = ~CONST[1]; genvar ~GENSYM[i][2]; ~GENERATE for (~SYM[2]=0; ~SYM[2] < ~LIT[0]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] diff --git a/clash-lib/prims/verilog/Clash_Prelude_ROM_Blob.primitives b/clash-lib/prims/verilog/Clash_Prelude_ROM_Blob.primitives new file mode 100644 index 0000000000..764e69bb66 --- /dev/null +++ b/clash-lib/prims/verilog/Clash_Prelude_ROM_Blob.primitives @@ -0,0 +1,26 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.Blob.asyncRomBlob#" + , "kind" : "Declaration" + , "type" : +"asyncRomBlob# + :: MemBlob n m -- ARG[0] + -> Int -- ARG[1] + -> BitVector m" + , "template" : +"// asyncRomBlob begin +wire ~TYPO ~GENSYM[ROM][0] [0:~LENGTH[~TYP[0]]-1]; + +wire ~TYP[0] ~GENSYM[romflat][1]; +assign ~SYM[1] = ~CONST[0]; +genvar ~GENSYM[i][2]; +~GENERATE +for (~SYM[2]=0; ~SYM[2] < ~LENGTH[~TYP[0]]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] + assign ~SYM[0][(~LENGTH[~TYP[0]]-1)-~SYM[2]] = ~SYM[1][~SYM[2]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; +end +~ENDGENERATE + +assign ~RESULT = ~SYM[0][~ARG[1]]; +// asyncRomBlob end" + } + } +] diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives index 29cf11fd51..938c1a1332 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives @@ -213,9 +213,9 @@ begin begin if(rising_edge(~ARG[6])) then if(~ARG[7]) then - mem(to_integer(~ARG[8])) := ~ARG[9]; + mem(~IF~SIZE[~TYP[8]]~THENto_integer(~ARG[8])~ELSE0~FI) := ~ARG[9]; end if; - ~SYM[2] <= mem(to_integer(~ARG[8])); + ~SYM[2] <= mem(~IF~SIZE[~TYP[8]]~THENto_integer(~ARG[8])~ELSE0~FI); end if; end process; @@ -224,9 +224,9 @@ begin begin if(rising_edge(~ARG[10])) then if(~ARG[11]) then - mem(to_integer(~ARG[12])) := ~ARG[13]; + mem(~IF~SIZE[~TYP[12]]~THENto_integer(~ARG[12])~ELSE0~FI) := ~ARG[13]; end if; - ~SYM[3] <= mem(to_integer(~ARG[12])); + ~SYM[3] <= mem(~IF~SIZE[~TYP[12]]~THENto_integer(~ARG[12])~ELSE0~FI); end if; end process; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives new file mode 100644 index 0000000000..17f688e838 --- /dev/null +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives @@ -0,0 +1,46 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.Blob.blockRamBlob#" + , "kind" : "Declaration" + , "type" : +"blockRamBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom Bool -- wren, ARG[5] + -> Signal dom Int -- wr, ARG[6] + -> Signal dom (BitVector m) -- din, ARG[7] + -> Signal dom (BitVector m)" + , "template" : +"-- blockRamBlob begin +~GENSYM[~RESULT_blockRam][1] : block + signal ~GENSYM[~RESULT_RAM][2] : ~TYP[3] := ~CONST[3]; + signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[3]] - 1; + signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[3]] - 1; +begin + ~SYM[4] <= to_integer(~VAR[rdI][4](31 downto 0)) + -- pragma translate_off + mod ~LENGTH[~TYP[3]] + -- pragma translate_on + ; + + ~SYM[5] <= to_integer(~VAR[wrI][6](31 downto 0)) + -- pragma translate_off + mod ~LENGTH[~TYP[3]] + -- pragma translate_on + ; + ~SYM[6] : process(~ARG[1]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1]) then + if ~ARG[5]~IF~ISACTIVEENABLE[2]~THEN and ~ARG[2]~ELSE~FI then + ~SYM[2](~SYM[5]) <= ~ARG[7]; + end if; + ~RESULT <= ~SYM[2](~SYM[4]); + end if; + end process; +end block; +-- blockRamBlob end" + } + } +] diff --git a/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives b/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives index 45b97509df..c4a8ede228 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives +++ b/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives @@ -16,7 +16,7 @@ signal ~GENSYM[ROM][2] : ~TYP[5]; signal ~GENSYM[rd][3] : integer range 0 to ~LIT[1]-1; begin - ~SYM[2] <= ~LIT[5]; + ~SYM[2] <= ~CONST[5]; ~SYM[3] <= to_integer(~VAR[rdI][6](31 downto 0)) -- pragma translate_off diff --git a/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives b/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives new file mode 100644 index 0000000000..285fd58083 --- /dev/null +++ b/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives @@ -0,0 +1,35 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.Blob.romBlob#" + , "kind" : "Declaration" + , "type" : +"romBlob# + :: KnownDomain dom -- ARG[0] + => Clock dom -- clk, ARG[1] + -> Enable dom -- en, ARG[2] + -> MemBlob n m -- init, ARG[3] + -> Signal dom Int -- rd, ARG[4] + -> Signal dom (BitVector m)" + , "template" : +"-- romBlob begin +~GENSYM[~COMPNAME_rom][1] : block + signal ~GENSYM[ROM][2] : ~TYP[3]; + signal ~GENSYM[rd][3] : integer range 0 to ~LENGTH[~TYP[3]]-1; +begin + ~SYM[2] <= ~CONST[3]; + + ~SYM[3] <= to_integer(~VAR[rdI][4](31 downto 0)) + -- pragma translate_off + mod ~LENGTH[~TYP[3]] + -- pragma translate_on + ; + ~GENSYM[romSync][6] : process (~ARG[1]) + begin + if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1])~IF~ISACTIVEENABLE[2]~THEN and ~ARG[2]~ELSE~FI) then + ~RESULT <= ~SYM[2](~SYM[3]); + end if; + end process; +end block; +-- romBlob end" + } + } +] diff --git a/clash-lib/prims/vhdl/Clash_Prelude_ROM.primitives b/clash-lib/prims/vhdl/Clash_Prelude_ROM.primitives index d0d5ef9e24..bcf94c3e88 100644 --- a/clash-lib/prims/vhdl/Clash_Prelude_ROM.primitives +++ b/clash-lib/prims/vhdl/Clash_Prelude_ROM.primitives @@ -12,7 +12,7 @@ signal ~GENSYM[ROM][1] : ~TYP[1]; signal ~GENSYM[rd][2] : integer range 0 to ~LIT[0]-1; begin - ~SYM[1] <= ~LIT[1]; + ~SYM[1] <= ~CONST[1]; ~SYM[2] <= to_integer(~VAR[rdI][2](31 downto 0)) -- pragma translate_off diff --git a/clash-lib/prims/vhdl/Clash_Prelude_ROM_Blob.primitives b/clash-lib/prims/vhdl/Clash_Prelude_ROM_Blob.primitives new file mode 100644 index 0000000000..454cd81f38 --- /dev/null +++ b/clash-lib/prims/vhdl/Clash_Prelude_ROM_Blob.primitives @@ -0,0 +1,27 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.Blob.asyncRomBlob#" + , "kind" : "Declaration" + , "type" : +"asyncRomBlob# + :: MemBlob n m -- ARG[0] + -> Int -- ARG[1] + -> BitVector m" + , "template" : +"-- asyncRomBlob begin +~GENSYM[asyncRom][0] : block + signal ~GENSYM[ROM][1] : ~TYP[0]; + signal ~GENSYM[rd][2] : integer range 0 to ~LENGTH[~TYP[0]]-1; +begin + ~SYM[1] <= ~CONST[0]; + + ~SYM[2] <= to_integer(~VAR[rdI][1](31 downto 0)) + -- pragma translate_off + mod ~LENGTH[~TYP[0]] + -- pragma translate_on + ; + ~RESULT <= ~SYM[1](~SYM[2]); +end block; +-- asyncRomBlob end" + } + } +] diff --git a/clash-lib/prims/vhdl/Clash_Sized_Internal_BitVector.primitives b/clash-lib/prims/vhdl/Clash_Sized_Internal_BitVector.primitives index 62090cec74..8529ef9ceb 100644 --- a/clash-lib/prims/vhdl/Clash_Sized_Internal_BitVector.primitives +++ b/clash-lib/prims/vhdl/Clash_Sized_Internal_BitVector.primitives @@ -86,6 +86,14 @@ , "template" : "~IF~LIT[0]~THEN'U'~ELSE~ARG[1](0)~FI" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.toEnum##" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum## :: Int -> Bit" + , "template" : "~ARG[0](0)" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.BitVector.and##" , "kind" : "Expression" @@ -457,6 +465,22 @@ end process; , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[2])),~SIZE[~TYPO]))" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> BitVector n" + , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => BitVector n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THENsigned(std_logic_vector(resize(unsigned(~ARG[1]),~SIZE[~TYPO])))~ELSEto_signed(0,~SIZE[~TYPO])~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.BitVector.plus#" , "kind" : "Expression" diff --git a/clash-lib/prims/vhdl/Clash_Sized_Internal_Index.primitives b/clash-lib/prims/vhdl/Clash_Sized_Internal_Index.primitives index e9f43c38dd..0251e358d3 100644 --- a/clash-lib/prims/vhdl/Clash_Sized_Internal_Index.primitives +++ b/clash-lib/prims/vhdl/Clash_Sized_Internal_Index.primitives @@ -64,6 +64,22 @@ , "template" : "to_unsigned(~LIT[0]-1,~SIZE[~TYPO])" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> Index n" + , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => Index n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THENsigned(std_logic_vector(resize(~ARG[1],~SIZE[~TYPO])))~ELSEto_signed(0,~SIZE[~TYPO])~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Index.+#" , "kind" : "Expression" diff --git a/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives b/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives index 935c596c6e..5a55793f4f 100644 --- a/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives +++ b/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives @@ -112,6 +112,22 @@ , "templateFunction" : "Clash.Primitives.Sized.Signed.fromIntegerTF" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> Signed n" + , "template" : "resize(signed(std_logic_vector(~ARG[1])),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => Signed n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THENresize(~ARG[1],~SIZE[~TYPO])~ELSEto_signed(0,~SIZE[~TYPO])~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Signed.plus#" , "kind" : "Expression" diff --git a/clash-lib/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives b/clash-lib/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives index c92dc0e946..0d7b215155 100644 --- a/clash-lib/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives +++ b/clash-lib/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives @@ -102,6 +102,22 @@ , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~LIT[0])" } } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.toEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "toEnum# :: KnownNat n => Int -> Unsigned n" + , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.fromEnum#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromEnum# :: KnownNat n => Unsigned n -> Int" + , "template" : "~IF~SIZE[~TYP[1]]~THENsigned(std_logic_vector(resize(~ARG[1],~SIZE[~TYPO])))~ELSEto_signed(0,~SIZE[~TYPO])~FI" + } + } , { "BlackBox" : { "name" : "Clash.Sized.Internal.Unsigned.plus#" , "kind" : "Expression" diff --git a/clash-lib/prims/vhdl/Clash_Sized_Vector.primitives b/clash-lib/prims/vhdl/Clash_Sized_Vector.primitives index b45dcb29c6..15c0b03f97 100644 --- a/clash-lib/prims/vhdl/Clash_Sized_Vector.primitives +++ b/clash-lib/prims/vhdl/Clash_Sized_Vector.primitives @@ -312,14 +312,6 @@ end block; -- replace end" } } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.maxIndex" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxIndex :: KnownNat n => Vec n a -> Int" - , "template" : "to_signed(~LIT[0] - 1,~SIZE[~TYPO])" - } - } , { "BlackBox" : { "name" : "Clash.Sized.Vector.length" , "workInfo" : "Constant" diff --git a/clash-lib/src/Clash/Backend/SystemVerilog.hs b/clash-lib/src/Clash/Backend/SystemVerilog.hs index e7f335dbe1..9dc3813f1a 100644 --- a/clash-lib/src/Clash/Backend/SystemVerilog.hs +++ b/clash-lib/src/Clash/Backend/SystemVerilog.hs @@ -23,6 +23,7 @@ import Control.Monad (forM,liftM,zipWithM) import Control.Monad.State (State) import Data.Bifunctor (first) import Data.Bits (Bits, testBit) +import qualified Data.ByteString.Char8 as B8 import Data.Coerce (coerce) import Data.Function (on) import Data.HashMap.Lazy (HashMap) @@ -53,6 +54,7 @@ import Clash.Backend import Clash.Backend.Verilog (bits, bit_char, encodingNote, exprLit, include, noEmptyInit, uselibs) import Clash.Driver.Types (ClashOpts(..)) +import Clash.Explicit.BlockRam.Internal (unpackNats) import Clash.Netlist.BlackBox.Types (HdlSyn (..)) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) @@ -135,6 +137,7 @@ instance Backend SystemVerilogState where Vector {} -> pure UserType RTree {} -> pure UserType Product {} -> pure UserType + MemBlob {} -> pure UserType BiDirectional _ ty -> hdlHWTypeKind ty Annotated _ ty -> hdlHWTypeKind ty _ -> pure PrimitiveType @@ -296,6 +299,7 @@ topSortHWTys hwtys = sorted normaliseType :: HWType -> SystemVerilogM HWType normaliseType (Annotated _ ty) = normaliseType ty normaliseType (Vector n ty) = Vector n <$> (normaliseType ty) +normaliseType (MemBlob n m) = return (Vector n (BitVector m)) normaliseType (RTree d ty) = RTree d <$> (normaliseType ty) normaliseType (Product nm lbls tys) = Product nm lbls <$> (mapM normaliseType tys) normaliseType ty@(SP _ elTys) = do @@ -597,6 +601,7 @@ tyName :: HWType -> SystemVerilogM Doc tyName Bool = "logic" tyName Bit = "logic" tyName (Vector n elTy) = "array_of_" <> int n <> "_" <> tyName elTy +tyName (MemBlob n m) = tyName (Vector n (BitVector m)) tyName (RTree n elTy) = "tree_of_" <> int n <> "_" <> tyName elTy tyName (BitVector n) = "logic_vector_" <> int n tyName t@(Index _) = "logic_vector_" <> int (typeSize t) @@ -1113,6 +1118,18 @@ expr_ _ e@(DataCon ty@(Vector _ elTy) _ [e1,e2]) = case vectorChain e of Just es -> "'" <> listBraces (mapM (toSLV elTy) es) Nothing -> verilogTypeMark ty <> "_cons" <> parens (expr_ False e1 <> comma <+> expr_ False e2) +expr_ _ (DataCon (MemBlob n m) _ [n0, m0, _, runs, _, ends]) + | Literal _ (NumLit n1) <- n0 + , n == fromInteger n1 + , Literal _ (NumLit m1) <- m0 + , m == fromInteger m1 + , Literal Nothing (StringLit runs0) <- runs + , Literal Nothing (StringLit ends0) <- ends + , es <- unpackNats n m (B8.pack runs0) (B8.pack ends0) = + let el val = exprLitSV (Just (BitVector m, m)) + (BitVecLit 0 $ toInteger val) + in "'" <> listBraces (mapM el es) + expr_ _ (DataCon (RTree 0 elTy) _ [e]) = "'" <> braces (toSLV elTy e) expr_ _ e@(DataCon ty@(RTree _ elTy) _ [e1,e2]) = case rtreeChain e of @@ -1273,18 +1290,21 @@ toSLV :: HWType -> Expr -> SystemVerilogM Doc toSLV t e = case t of Vector _ _ -> braces (verilogTypeMark t <> "_to_lv" <> parens (expr_ False e)) RTree _ _ -> braces (verilogTypeMark t <> "_to_lv" <> parens (expr_ False e)) + MemBlob n m -> toSLV (Vector n (BitVector m)) e _ -> expr_ False e fromSLV :: HWType -> IdentifierText -> Int -> Int -> SystemVerilogM Doc fromSLV t@(Vector _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (pretty id_ <> brackets (int start <> colon <> int end)) fromSLV t@(RTree _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (pretty id_ <> brackets (int start <> colon <> int end)) fromSLV (Signed _) id_ start end = "$signed" <> parens (pretty id_ <> brackets (int start <> colon <> int end)) +fromSLV (MemBlob n m) id_ start end = fromSLV (Vector n (BitVector m)) id_ start end fromSLV _ id_ start end = pretty id_ <> brackets (int start <> colon <> int end) simpleFromSLV :: HWType -> IdentifierText -> SystemVerilogM Doc simpleFromSLV t@(Vector _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (pretty id_) simpleFromSLV t@(RTree _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (pretty id_) simpleFromSLV (Signed _) id_ = "$signed" <> parens (pretty id_) +simpleFromSLV (MemBlob n m) id_ = simpleFromSLV (Vector n (BitVector m)) id_ simpleFromSLV _ id_ = pretty id_ expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc diff --git a/clash-lib/src/Clash/Backend/VHDL.hs b/clash-lib/src/Clash/Backend/VHDL.hs index 8b0837c373..c6abfd7a9c 100644 --- a/clash-lib/src/Clash/Backend/VHDL.hs +++ b/clash-lib/src/Clash/Backend/VHDL.hs @@ -26,6 +26,7 @@ import Control.Monad (forM,join,zipWithM) import Control.Monad.State (State, StateT) import Data.Bifunctor (first) import Data.Bits (testBit, Bits) +import qualified Data.ByteString.Char8 as B8 import Data.Coerce (coerce) import Data.Function (on) import Data.HashMap.Lazy (HashMap) @@ -65,6 +66,7 @@ import Clash.Backend import Clash.Core.Var (Attr'(..),attrName) import Clash.Debug (traceIf) import Clash.Driver.Types (ClashOpts(..)) +import Clash.Explicit.BlockRam.Internal (unpackNats) import Clash.Netlist.BlackBox.Types (HdlSyn (..)) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) @@ -156,6 +158,7 @@ instance Backend VHDLState where Vector {} -> pure UserType RTree {} -> pure UserType Product {} -> pure UserType + MemBlob {} -> pure UserType Sum {} -> do -- If an enum is rendered, it is a user type. If not, an std_logic_vector @@ -568,6 +571,8 @@ tyDec hwty = do <+> parens (hsep (punctuate comma variantNames)) <> semi + MemBlob n m -> tyDec (Vector n (BitVector m)) + -- Type aliases: Clock _ -> typAliasDec hwty Reset _ -> typAliasDec hwty @@ -1048,6 +1053,7 @@ appendSize baseType sizedType = case sizedType of Unsigned n -> baseType <> parens (int (n-1) <+> "downto 0") Vector n _ -> baseType <> parens ("0 to" <+> int (n-1)) RTree d _ -> baseType <> parens ("0 to" <+> int ((2^d)-1)) + MemBlob n _ -> baseType <> parens ("0 to" <+> int (n-1)) Annotated _ elTy -> appendSize baseType elTy _ -> baseType @@ -1172,6 +1178,8 @@ tyName' rec0 (filterTransparent -> t) = do BiDirectional _ hwTy -> tyName' rec0 hwTy FileType -> return "file" + ty -> return (error ($(curLoc) ++ show ty ++ + " not filtered by filterTransparent")) -- | Returns underlying type of given HWType. That is, the type by which it -- eventually will be represented in VHDL. @@ -1195,6 +1203,7 @@ normaliseType enums@(RenderEnums e) hwty = case hwty of RTree _ _ -> hwty Product _ _ _ -> hwty Sum _ _ -> if e then hwty else BitVector (typeSize hwty) + MemBlob n m -> Vector n (BitVector m) -- Simple types, for which a subtype (without qualifiers) will be made in VHDL: Clock _ -> Bit @@ -1228,6 +1237,8 @@ filterTransparent hwty = case hwty of CustomSum _ _ _ _ -> hwty FileType -> hwty + MemBlob n m -> Vector n (BitVector m) + Vector n elTy -> Vector n (filterTransparent elTy) RTree n elTy -> RTree n (filterTransparent elTy) Product nm labels elTys -> @@ -1605,6 +1616,17 @@ expr_ _ e@(DataCon ty@(Vector _ elTy) _ [e1,e2]) = do Just es -> align (tupled (mapM (expr_ False) es)) Nothing -> parens (qualTyName elTy <> "'" <> parens (expr_ False e1) <+> "&" <+> expr_ False e2) +expr_ _ (DataCon ty@(MemBlob n m) _ [n0, m0, _, runs, _, ends]) + | Literal _ (NumLit n1) <- n0 + , n == fromInteger n1 + , Literal _ (NumLit m1) <- m0 + , m == fromInteger m1 + , Literal Nothing (StringLit runs0) <- runs + , Literal Nothing (StringLit ends0) <- ends + , es <- unpackNats n m (B8.pack runs0) (B8.pack ends0) = + let el val = exprLit (Just (BitVector m, m)) (BitVecLit 0 $ toInteger val) + in qualTyName ty <> "'" <> (align $ tupled $ mapM el es) + expr_ _ (DataCon ty@(RTree 0 elTy) _ [e]) = do syn <- Ap hdlSyn case syn of diff --git a/clash-lib/src/Clash/Backend/Verilog.hs b/clash-lib/src/Clash/Backend/Verilog.hs index 3095295949..cfb59d6ea0 100644 --- a/clash-lib/src/Clash/Backend/Verilog.hs +++ b/clash-lib/src/Clash/Backend/Verilog.hs @@ -37,6 +37,7 @@ import Control.Monad (forM) import Control.Monad.State (State) import Data.Bifunctor (first, second) import Data.Bits (Bits, testBit) +import qualified Data.ByteString.Char8 as B8 import Data.Coerce (coerce) import Data.Function (on) import Data.HashMap.Strict (HashMap) @@ -67,6 +68,7 @@ import Clash.Core.Var (Attr'(..)) import Clash.Backend import Clash.Debug (traceIf) import Clash.Driver.Types (ClashOpts(..)) +import Clash.Explicit.BlockRam.Internal (unpackNats) import Clash.Netlist.BlackBox.Types (HdlSyn) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) @@ -994,6 +996,17 @@ expr_ _ (DataCon (Vector 1 _) _ [e]) = expr_ False e expr_ _ e@(DataCon (Vector _ _) _ es@[_,_]) = listBraces $ mapM (expr_ False) $ fromMaybe es $ vectorChain e +expr_ _ (DataCon (MemBlob n m) _ [n0, m0, _, runs, _, ends]) + | Literal _ (NumLit n1) <- n0 + , n == fromInteger n1 + , Literal _ (NumLit m1) <- m0 + , m == fromInteger m1 + , Literal Nothing (StringLit runs0) <- runs + , Literal Nothing (StringLit ends0) <- ends + , es <- unpackNats n m (B8.pack runs0) (B8.pack ends0) = + let el val = exprLitV (Just (BitVector m, m)) (BitVecLit 0 $ toInteger val) + in listBraces $ mapM el es + expr_ _ (DataCon (RTree 0 _) _ [e]) = expr_ False e expr_ _ e@(DataCon (RTree _ _) _ es@[_,_]) = listBraces $ mapM (expr_ False) $ fromMaybe es $ rtreeChain e diff --git a/clash-lib/src/Clash/Driver.hs b/clash-lib/src/Clash/Driver.hs index 56d1d9bcd7..14a1172e28 100644 --- a/clash-lib/src/Clash/Driver.hs +++ b/clash-lib/src/Clash/Driver.hs @@ -441,8 +441,8 @@ generateHDL env design hdlState typeTrans peEval eval mainTopEntity startTime = -- 2. Normalize topEntity supplyN <- Supply.newSupply - let transformedBindings = normalizeEntity env bindingsMap typeTrans peEval - eval topEntityNames supplyN topEntity + transformedBindings <- normalizeEntity env bindingsMap typeTrans peEval + eval topEntityNames supplyN topEntity normTime <- transformedBindings `deepseq` Clock.getCurrentTime let prepNormDiff = reportTimeDiff normTime prevTime @@ -1068,7 +1068,7 @@ normalizeEntity -- ^ Unique supply -> Id -- ^ root of the hierarchy - -> BindingMap + -> IO BindingMap normalizeEntity env bindingsMap typeTrans peEval eval topEntities supply tm = transformedBindings where doNorm = do norm <- normalize [tm] diff --git a/clash-lib/src/Clash/Driver/Types.hs b/clash-lib/src/Clash/Driver/Types.hs index 0685eba57c..73d5ac27fe 100644 --- a/clash-lib/src/Clash/Driver/Types.hs +++ b/clash-lib/src/Clash/Driver/Types.hs @@ -288,7 +288,11 @@ debugAll = debugApplied { dbg_transformationInfo = TryTerm } -- | Options passed to Clash compiler data ClashOpts = ClashOpts - { opt_inlineLimit :: Int + { opt_werror :: Bool + -- ^ Are warnings treated as errors. + -- + -- Command line flag: -Werror + , opt_inlineLimit :: Int -- ^ Change the number of times a function f can undergo inlining inside -- some other function g. This prevents the size of g growing dramatically. -- @@ -392,6 +396,7 @@ data ClashOpts = ClashOpts instance NFData ClashOpts where rnf o = + opt_werror o `deepseq` opt_inlineLimit o `deepseq` opt_specLimit o `deepseq` opt_inlineFunctionLimit o `deepseq` @@ -422,6 +427,7 @@ instance NFData ClashOpts where instance Eq ClashOpts where s0 == s1 = + opt_werror s0 == opt_werror s1 && opt_inlineLimit s0 == opt_inlineLimit s1 && opt_specLimit s0 == opt_specLimit s1 && opt_inlineFunctionLimit s0 == opt_inlineFunctionLimit s1 && @@ -459,6 +465,7 @@ instance Eq ClashOpts where instance Hashable ClashOpts where hashWithSalt s ClashOpts {..} = s `hashWithSalt` + opt_werror `hashWithSalt` opt_inlineLimit `hashWithSalt` opt_specLimit `hashWithSalt` opt_inlineFunctionLimit `hashWithSalt` @@ -495,7 +502,8 @@ instance Hashable ClashOpts where defClashOpts :: ClashOpts defClashOpts = ClashOpts - { opt_inlineLimit = 20 + { opt_werror = False + , opt_inlineLimit = 20 , opt_specLimit = 20 , opt_inlineFunctionLimit = 15 , opt_inlineConstantLimit = 0 diff --git a/clash-lib/src/Clash/Netlist.hs b/clash-lib/src/Clash/Netlist.hs index c715c36b7e..da65f447c5 100644 --- a/clash-lib/src/Clash/Netlist.hs +++ b/clash-lib/src/Clash/Netlist.hs @@ -851,7 +851,7 @@ mkExpr _ _ _ (stripTicks -> Core.Literal l) = do #else ByteArrayLiteral (ByteArray ba) -> return (HW.Literal Nothing (NumLit (Jp# (BN# ba))),[]) #endif - _ -> error $ $(curLoc) ++ "not an integer or char literal" + StringLiteral s -> return (HW.Literal Nothing $ StringLit s, []) mkExpr bbEasD declType bndr app = let (appF,args,ticks) = collectArgsTicks app @@ -1086,6 +1086,11 @@ mkDcApplication [dstHType] bndr dc args = do Vector _ _ -> case argExprsFiltered of [e1,e2] -> return (HW.DataCon dstHType VecAppend [e1,e2]) _ -> error $ $(curLoc) ++ "Unexpected number of arguments for `Cons`: " ++ showPpr args + MemBlob _ _ -> + case compare 6 (length argExprsFiltered) of + EQ -> return (HW.DataCon dstHType (DC (dstHType,0)) argExprsFiltered) + LT -> error $ $(curLoc) ++ "Over-applied constructor" + GT -> error $ $(curLoc) ++ "Under-applied constructor" RTree 0 _ -> case argExprsFiltered of [e] -> return (HW.DataCon dstHType RTreeAppend [e]) _ -> error $ $(curLoc) ++ "Unexpected number of arguments for `LR`: " ++ showPpr args diff --git a/clash-lib/src/Clash/Netlist/BlackBox.hs b/clash-lib/src/Clash/Netlist/BlackBox.hs index 0bf19bab53..0296ddcbca 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox.hs @@ -46,7 +46,7 @@ import GHC.Stack (HasCallStack, callStack, prettyCallStack) import qualified System.Console.ANSI as ANSI import System.Console.ANSI - ( hSetSGR, SGR(SetConsoleIntensity, SetColor), Color(Magenta) + ( hSetSGR, SGR(SetConsoleIntensity, SetColor), Color(Magenta, Red) , ConsoleIntensity(BoldIntensity), ConsoleLayer(Foreground), ColorIntensity(Vivid)) import System.IO (hPutStrLn, stderr, hFlush, hIsTerminalDevice) @@ -88,7 +88,7 @@ import {-# SOURCE #-} Clash.Netlist import qualified Clash.Backend as Backend import Clash.Debug (debugIsOn) import Clash.Driver.Types - (opt_primWarn, opt_color, ClashOpts) + (ClashOpts(opt_primWarn, opt_color, opt_werror)) import Clash.Netlist.BlackBox.Types as B import Clash.Netlist.BlackBox.Util as B import Clash.Netlist.Types as N @@ -115,10 +115,17 @@ warn opts msg = do Auto -> hIsTerminalDevice stderr hSetSGR stderr [SetConsoleIntensity BoldIntensity] - when useColor $ hSetSGR stderr [SetColor Foreground Vivid Magenta] - hPutStrLn stderr $ "[WARNING] " ++ msg - hSetSGR stderr [ANSI.Reset] - hFlush stderr + + case opt_werror opts of + True -> do + when useColor $ hSetSGR stderr [SetColor Foreground Vivid Red] + throw (ClashException noSrcSpan msg Nothing) + + False -> do + when useColor $ hSetSGR stderr [SetColor Foreground Vivid Magenta] + hPutStrLn stderr $ "[WARNING] " ++ msg + hSetSGR stderr [ANSI.Reset] + hFlush stderr -- | Generate the context for a BlackBox instantiation. mkBlackBoxContext diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs index 07da487305..fee9fbcb66 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs @@ -1,7 +1,7 @@ {-| Copyright : (C) 2012-2016, University of Twente, 2017 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -131,7 +131,7 @@ data Element | Err !(Maybe Int) -- ^ Error value hole | TypElem !Element - -- ^ Select element type from a vector type + -- ^ Select element type from a vector-like type | CompName -- ^ Hole for the name of the component in which the blackbox is instantiated | IncludeName !Int @@ -140,11 +140,11 @@ data Element | Size !Element -- ^ Size of a type hole | Length !Element - -- ^ Length of a vector hole + -- ^ Length of a vector-like hole | Depth !Element -- ^ Depth of a tree hole | MaxIndex !Element - -- ^ Max index into a vector + -- ^ Max index into a vector-like type | FilePath !Element -- ^ Hole containing a filepath for a data file | Template [Element] [Element] diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index ae1cc2a387..81e186de7f 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -1,7 +1,7 @@ {-| Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -435,9 +435,11 @@ renderElem b (IF c t f) = do check xOpt iw syn c' = case c' of (Size e) -> typeSize (lineToType b [e]) (Length e) -> case lineToType b [e] of - (Vector n _) -> n - Void (Just (Vector n _)) -> n - _ -> 0 -- HACK: So we can test in splitAt if one of the + (Vector n _) -> n + Void (Just (Vector n _)) -> n + (MemBlob n _) -> n + Void (Just (MemBlob n _)) -> n + _ -> 0 -- HACK: So we can test in splitAt if one of the -- vectors in the tuple had a zero length (Lit n) -> case bbInputs b !! n of (l,_,_) @@ -583,7 +585,8 @@ lineToType b [(Typ (Just n))] = let (_,ty,_) = bbInputs b !! n in ty lineToType b [(TypElem t)] = case lineToType b [t] of Vector _ elTy -> elTy - _ -> error $ $(curLoc) ++ "Element type selection of a non-vector type" + MemBlob _ m -> BitVector m + _ -> error $ $(curLoc) ++ "Element type selection of a non-vector-like type" lineToType b [(IndexType (Lit n))] = case bbInputs b !! n of (Literal _ (NumLit n'),_,_) -> Index (fromInteger n') @@ -673,10 +676,12 @@ renderTag b (Size e) = return . Text.pack . show . typeSize $ lineToType renderTag b (Length e) = return . Text.pack . show . vecLen $ lineToType b [e] where - vecLen (Vector n _) = n - vecLen (Void (Just (Vector n _))) = n + vecLen (Vector n _) = n + vecLen (Void (Just (Vector n _))) = n + vecLen (MemBlob n _) = n + vecLen (Void (Just (MemBlob n _))) = n vecLen thing = - error $ $(curLoc) ++ "vecLen of a non-vector type: " ++ show thing + error $ $(curLoc) ++ "vecLen of a non-vector-like type: " ++ show thing renderTag b (Depth e) = return . Text.pack . show . treeDepth $ lineToType b [e] where @@ -687,9 +692,10 @@ renderTag b (Depth e) = return . Text.pack . show . treeDepth $ lineToType b [e] renderTag b (MaxIndex e) = return . Text.pack . show . vecLen $ lineToType b [e] where - vecLen (Vector n _) = n-1 + vecLen (Vector n _) = n-1 + vecLen (MemBlob n _) = n-1 vecLen thing = - error $ $(curLoc) ++ "vecLen of a non-vector type: " ++ show thing + error $ $(curLoc) ++ "vecLen of a non-vector-like type: " ++ show thing renderTag b e@(TypElem _) = let ty = lineToType b [e] in renderOneLine <$> getAp (hdlType Internal ty) diff --git a/clash-lib/src/Clash/Netlist/Types.hs b/clash-lib/src/Clash/Netlist/Types.hs index 15ebcaa175..d4bae04bb6 100644 --- a/clash-lib/src/Clash/Netlist/Types.hs +++ b/clash-lib/src/Clash/Netlist/Types.hs @@ -431,6 +431,8 @@ data HWType -- ^ Unsigned integer of a specified size | Vector !Size !HWType -- ^ Vector type + | MemBlob !Size !Size + -- ^ MemBlob type | RTree !Size !HWType -- ^ RTree type | Sum !Text [Text] diff --git a/clash-lib/src/Clash/Netlist/Util.hs b/clash-lib/src/Clash/Netlist/Util.hs index c4c61caacd..b2f135d54b 100644 --- a/clash-lib/src/Clash/Netlist/Util.hs +++ b/clash-lib/src/Clash/Netlist/Util.hs @@ -683,6 +683,7 @@ typeSize (Index u) = fromMaybe 0 (clogBase 2 u) typeSize (Signed i) = i typeSize (Unsigned i) = i typeSize (Vector n el) = n * typeSize el +typeSize (MemBlob n m) = n * m typeSize (RTree d el) = (2^d) * typeSize el typeSize t@(SP _ cons) = conSize t + maximum (map (sum . map typeSize . snd) cons) diff --git a/clash-lib/src/Clash/Normalize.hs b/clash-lib/src/Clash/Normalize.hs index 342f78e3ed..70d7e504af 100644 --- a/clash-lib/src/Clash/Normalize.hs +++ b/clash-lib/src/Clash/Normalize.hs @@ -112,7 +112,7 @@ runNormalization -- ^ topEntities -> NormalizeSession a -- ^ NormalizeSession to run - -> a + -> IO a runNormalization env supply globals typeTrans peEval eval rcsMap topEnts = runRewriteSession rwEnv rwState where diff --git a/clash-lib/src/Clash/Rewrite/Types.hs b/clash-lib/src/Clash/Rewrite/Types.hs index 79616489b8..da4ddfd28d 100644 --- a/clash-lib/src/Clash/Rewrite/Types.hs +++ b/clash-lib/src/Clash/Rewrite/Types.hs @@ -11,6 +11,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -23,14 +24,18 @@ import Control.Concurrent.Supply (Supply, freshId) import Control.DeepSeq (NFData) import Control.Lens (Lens', use, (.=)) import qualified Control.Lens as Lens -#if !MIN_VERSION_base(4,13,0) -import Control.Monad.Fail (MonadFail(fail)) -#endif -import Control.Monad.Fix (MonadFix (..), fix) +import Control.Monad.Fix (MonadFix) +import Control.Monad.State.Strict (State) +#if MIN_VERSION_transformers(0,5,6) import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State (MonadState (..)) -import Control.Monad.State.Strict (State) +import Control.Monad.Trans.RWS.CPS (RWST) +import qualified Control.Monad.Trans.RWS.CPS as RWS import Control.Monad.Writer (MonadWriter (..)) +#else +import Control.Monad.Trans.RWS.Strict (RWST) +import qualified Control.Monad.Trans.RWS.Strict as RWS +#endif import Data.Binary (Binary) import Data.HashMap.Strict (HashMap) import Data.IntMap.Strict (IntMap) @@ -162,83 +167,63 @@ normalizeUltra = clashEnv . Lens.to (opt_ultra . envOpts) -- generate fresh variables and unique identifiers. In addition, it keeps track -- if a transformation/rewrite has been successfully applied. newtype RewriteMonad extra a = R - { unR :: RewriteEnv -> RewriteState extra -> Any -> (a,RewriteState extra,Any) } + { unR :: RWST RewriteEnv Any (RewriteState extra) IO a } + deriving newtype + ( Applicative + , Functor + , Monad + , MonadFix + ) -- | Run the computation in the RewriteMonad runR :: RewriteMonad extra a -> RewriteEnv -> RewriteState extra - -> (a, RewriteState extra, Any) -runR m r s = unR m r s mempty - -instance MonadFail (RewriteMonad extra) where - fail err = error ("RewriteMonad.fail: " ++ err) - -instance Functor (RewriteMonad extra) where - fmap f m = R $ \ r s w -> case unR m r s w of (a, s', w') -> (f a, s', w') - {-# INLINE fmap #-} - -instance Applicative (RewriteMonad extra) where - pure a = R $ \ _ s w -> (a, s, w) - {-# INLINE pure #-} - R mf <*> R mx = R $ \ r s w -> case mf r s w of - (f,s',w') -> case mx r s' w' of - (x,s'',w'') -> (f x, s'', w'') - {-# INLINE (<*>) #-} - -instance Monad (RewriteMonad extra) where - return a = R $ \ _ s w -> (a, s, w) - {-# INLINE return #-} - m >>= k = - R $ \ r s w -> case unR m r s w of - (a,s',w') -> unR (k a) r s' w' - {-# INLINE (>>=) #-} + -> IO (a, RewriteState extra, Any) +runR m = RWS.runRWST (unR m) +#if MIN_VERSION_transformers(0,5,6) && !MIN_VERSION_mtl(2,3,0) +-- For Control.Monad.Trans.RWS.Strict these are already defined, however the +-- CPS version of RWS is not included in `mtl` yet. instance MonadState (RewriteState extra) (RewriteMonad extra) where - get = R $ \_ s w -> (s,s,w) + get = R RWS.get {-# INLINE get #-} - put s = R $ \_ _ w -> ((),s,w) + put = R . RWS.put {-# INLINE put #-} - state f = R $ \_ s w -> case f s of (a,s') -> (a,s',w) + state = R . RWS.state {-# INLINE state #-} -instance MonadUnique (RewriteMonad extra) where - getUniqueM = do - sup <- use uniqSupply - let (a,sup') = freshId sup - uniqSupply .= sup' - a `seq` return a - instance MonadWriter Any (RewriteMonad extra) where - writer (a,w') = R $ \_ s w -> let wt = w `mappend` w' in wt `seq` (a,s,wt) + writer = R . RWS.writer {-# INLINE writer #-} - tell w' = R $ \_ s w -> let wt = w `mappend` w' in wt `seq` ((),s,wt) + tell = R . RWS.tell {-# INLINE tell #-} - listen m = R $ \r s w -> case runR m r s of - (a,s',w') -> let wt = w `mappend` w' in wt `seq` ((a,w'),s',wt) + listen = R . RWS.listen . unR {-# INLINE listen #-} - pass m = R $ \r s w -> case runR m r s of - ((a,f),s',w') -> let wt = w `mappend` f w' in wt `seq` (a, s', wt) + pass = R . RWS.pass . unR {-# INLINE pass #-} -censor :: (Any -> Any) -> RewriteMonad extra a -> RewriteMonad extra a -censor f m = R $ \r s w -> case runR m r s of - (a,s',w') -> let wt = w `mappend` f w' in wt `seq` (a, s', wt) -{-# INLINE censor #-} - instance MonadReader RewriteEnv (RewriteMonad extra) where - ask = R $ \r s w -> (r,s,w) + ask = R RWS.ask {-# INLINE ask #-} - local f m = R $ \r s w -> unR m (f r) s w + local f = R . RWS.local f . unR {-# INLINE local #-} - reader f = R $ \r s w -> (f r,s,w) + reader = R . RWS.reader {-# INLINE reader #-} +#endif + +instance MonadUnique (RewriteMonad extra) where + getUniqueM = do + sup <- use uniqSupply + let (a,sup') = freshId sup + uniqSupply .= sup' + a `seq` return a -instance MonadFix (RewriteMonad extra) where - mfix f = R $ \r s w -> fix $ \ ~(a,_,_) -> unR (f a) r s w - {-# INLINE mfix #-} +censor :: (Any -> Any) -> RewriteMonad extra a -> RewriteMonad extra a +censor f = R . RWS.censor f . unR +{-# INLINE censor #-} data TransformContext = TransformContext diff --git a/clash-lib/src/Clash/Rewrite/Util.hs b/clash-lib/src/Clash/Rewrite/Util.hs index a4d15cc951..93630450a7 100644 --- a/clash-lib/src/Clash/Rewrite/Util.hs +++ b/clash-lib/src/Clash/Rewrite/Util.hs @@ -30,10 +30,12 @@ import Control.Exception (throw) import Control.Lens ((%=), (+=), (^.)) import qualified Control.Lens as Lens import qualified Control.Monad as Monad -#if !MIN_VERSION_base(4,13,0) -import Control.Monad.Fail (MonadFail) -#endif import qualified Control.Monad.State.Strict as State +#if MIN_VERSION_transformers(0,5,6) +import qualified Control.Monad.Trans.RWS.CPS as RWS +#else +import qualified Control.Monad.Trans.RWS.Strict as RWS +#endif import qualified Control.Monad.Writer as Writer import Data.Bifunctor (second) import Data.Coerce (coerce) @@ -92,10 +94,10 @@ import Clash.Util.Eq (fastEqBy) import qualified Clash.Util.Interpolate as I -- | Lift an action working in the '_extra' state to the 'RewriteMonad' -zoomExtra :: State.State extra a - -> RewriteMonad extra a -zoomExtra m = R (\_ s w -> case State.runState m (s ^. extra) of - (a,s') -> (a,s {_extra = s'},w)) +zoomExtra :: State.State extra a -> RewriteMonad extra a +zoomExtra m = R . RWS.rwsT $ \_ s -> + let (a, st') = State.runState m (_extra s) + in pure (a, s { _extra = st' }, mempty) -- | Some transformations might erroneously introduce shadowing. For example, -- a transformation might result in: @@ -277,15 +279,15 @@ runRewrite name is rewrite expr = apply name rewrite (TransformContext is []) ex runRewriteSession :: RewriteEnv -> RewriteState extra -> RewriteMonad extra a - -> a -runRewriteSession r s m = + -> IO a +runRewriteSession r s m = do + (a, s', _) <- runR m r s traceIf (dbg_countTransformations (opt_debug (envOpts (_clashEnv r)))) ("Clash: Transformations:\n" ++ Text.unpack (showCounters (s' ^. transformCounters))) $ traceIf (None < dbg_transformationInfo (opt_debug (envOpts (_clashEnv r)))) ("Clash: Applied " ++ show (s' ^. transformCounter) ++ " transformations") - a + pure a where - (a,s',_) = runR m r s showCounters = Text.unlines . map (\(nm,cnt) -> nm <> ": " <> Text.pack (show cnt)) @@ -315,19 +317,19 @@ mkDerivedName (TransformContext _ ctx) sf = case closestLetBinder ctx of -- | Make a new binder and variable reference for a term mkTmBinderFor - :: (MonadUnique m, MonadFail m) + :: (MonadUnique m) => InScopeSet -> TyConMap -- ^ TyCon cache -> Name a -- ^ Name of the new binder -> Term -- ^ Term to bind -> m Id -mkTmBinderFor is tcm name e = do - Left r <- mkBinderFor is tcm name (Left e) - return r +mkTmBinderFor is tcm name e = + either id (error "mkTmBinderFor: Result is a TyVar") + <$> mkBinderFor is tcm name (Left e) -- | Make a new binder and variable reference for either a term or a type mkBinderFor - :: (MonadUnique m, MonadFail m) + :: (MonadUnique m) => InScopeSet -> TyConMap -- ^ TyCon cache -> Name a -- ^ Name of the new binder diff --git a/clash-lib/tests/Test/Clash/Rewrite.hs b/clash-lib/tests/Test/Clash/Rewrite.hs index 026b20e48d..c202e119e1 100644 --- a/clash-lib/tests/Test/Clash/Rewrite.hs +++ b/clash-lib/tests/Test/Clash/Rewrite.hs @@ -111,9 +111,10 @@ runSingleTransformation -- ^ Transformation to perform -> C.Term -- ^ Term to transform - -> C.Term -runSingleTransformation rwEnv rwState is trans term = t - where (t, _, _) = runR (runRewrite "" is trans term) rwEnv rwState + -> IO C.Term +runSingleTransformation rwEnv rwState is trans term = do + (t, _, _) <- runR (runRewrite "" is trans term) rwEnv rwState + pure t -- | Run a single transformation with an empty environment and empty -- InScopeSet. See Default instances ^ to inspect the precise definition of @@ -123,7 +124,7 @@ runSingleTransformation rwEnv rwState is trans term = t -- include a type translator, evaluator, current function, or global heap. Maps, -- like the primitive and tycon map, are also empty. If the transformation under -- test needs these definitions, you should add them manually. -runSingleTransformationDef :: Default extra => Rewrite extra -> C.Term -> C.Term +runSingleTransformationDef :: Default extra => Rewrite extra -> C.Term -> IO C.Term runSingleTransformationDef = runSingleTransformation def def def diff --git a/clash-prelude/clash-prelude.cabal b/clash-prelude/clash-prelude.cabal index 2e2c1e6198..57c4ef65a9 100644 --- a/clash-prelude/clash-prelude.cabal +++ b/clash-prelude/clash-prelude.cabal @@ -51,7 +51,7 @@ Maintainer: QBayLogic B.V. Copyright: Copyright © 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2019, QBayLogic B.V., Google Inc., - 2021, QBayLogic B.V. + 2021-2022, QBayLogic B.V. Category: Hardware Build-type: Simple @@ -198,12 +198,15 @@ Library Clash.Clocks.Deriving Clash.Explicit.BlockRam + Clash.Explicit.BlockRam.Blob Clash.Explicit.BlockRam.File + Clash.Explicit.BlockRam.Internal Clash.Explicit.DDR Clash.Explicit.Mealy Clash.Explicit.Moore Clash.Explicit.RAM Clash.Explicit.ROM + Clash.Explicit.ROM.Blob Clash.Explicit.ROM.File Clash.Explicit.Prelude Clash.Explicit.Prelude.Safe @@ -236,12 +239,14 @@ Library Clash.Prelude.BitIndex Clash.Prelude.BitReduction Clash.Prelude.BlockRam + Clash.Prelude.BlockRam.Blob Clash.Prelude.BlockRam.File Clash.Prelude.DataFlow Clash.Prelude.Mealy Clash.Prelude.Moore Clash.Prelude.RAM Clash.Prelude.ROM + Clash.Prelude.ROM.Blob Clash.Prelude.ROM.File Clash.Prelude.Safe Clash.Prelude.Testbench @@ -386,6 +391,7 @@ test-suite unittests ghc-typelits-extra, base, + bytestring, deepseq, hedgehog >= 1.0.3 && < 1.1, hint >= 0.7 && < 0.10, @@ -402,6 +408,7 @@ test-suite unittests Clash.Tests.BitPack Clash.Tests.BitVector Clash.Tests.BlockRam + Clash.Tests.BlockRam.Blob Clash.Tests.Counter Clash.Tests.DerivingDataRepr Clash.Tests.DerivingDataReprTypes diff --git a/clash-prelude/src/Clash/Annotations/BitRepresentation/Deriving.hs b/clash-prelude/src/Clash/Annotations/BitRepresentation/Deriving.hs index 3a063b0885..09930c1da8 100644 --- a/clash-prelude/src/Clash/Annotations/BitRepresentation/Deriving.hs +++ b/clash-prelude/src/Clash/Annotations/BitRepresentation/Deriving.hs @@ -1,7 +1,8 @@ {-| -Copyright : (C) 2018, Google Inc. +Copyright : (C) 2018, Google Inc., + 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. This module contains: @@ -58,6 +59,7 @@ import Clash.Annotations.BitRepresentation.Util import qualified Clash.Annotations.BitRepresentation.Util as Util +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack, BitSize, pack, packXWith, unpack) import Clash.Class.Resize (resize) @@ -851,6 +853,7 @@ buildPack dataRepr@(DataReprAnn _name _size constrs) = do dontApplyInHDL :: (a -> b) -> a -> b dontApplyInHDL f a = f a {-# NOINLINE dontApplyInHDL #-} +{-# ANN dontApplyInHDL hasBlackBox #-} buildUnpackField :: Name diff --git a/clash-prelude/src/Clash/Explicit/BlockRam.hs b/clash-prelude/src/Clash/Explicit/BlockRam.hs index db9aa5465a..83f6199229 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam.hs @@ -377,6 +377,7 @@ This concludes the short introduction to using 'blockRam'. -} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -424,6 +425,7 @@ import GHC.Arr import qualified Data.Sequence as Seq import Data.Sequence (Seq) import Data.Tuple (swap) +import GHC.Generics (Generic) import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^), type (<=)) import Unsafe.Coerce (unsafeCoerce) @@ -736,6 +738,10 @@ prog2 = -- 0 := 4 -- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' clk rst ('blockRam' clk inits) rd wrM@. +-- * A large 'Vec' for the initial content might be too inefficient, depending +-- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFile' and +-- 'Clash.Explicit.BlockRam.Blob.blockRamBlob' for different approaches that +-- scale well. blockRam :: ( KnownDomain dom , HasCallStack @@ -783,6 +789,10 @@ blockRam = \clk gen content rd wrM -> -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' clk rst ('blockRamPow2' clk inits) rd wrM@. +-- * A large 'Vec' for the initial content might be too inefficient, depending +-- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFilePow2' +-- and 'Clash.Explicit.BlockRam.Blob.blockRamBlobPow2' for different approaches +-- that scale well. blockRamPow2 :: ( KnownDomain dom , HasCallStack @@ -1112,6 +1122,7 @@ readNew clk rst en ram rdAddr wrM = mux wasSame wasWritten $ ram rdAddr wrM data RamOp n a = RamRead (Index n) | RamWrite (Index n) a + deriving (Generic, NFDataX) ramOpAddr :: RamOp n a -> Index n ramOpAddr (RamRead addr) = addr diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs b/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs new file mode 100644 index 0000000000..666e432e42 --- /dev/null +++ b/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs @@ -0,0 +1,384 @@ +{-| +Copyright : (C) 2021-2022, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + += Efficient bundling of initial RAM content with the compiled code + +Leveraging Template Haskell, the initial content for the blockRAM components in +this module is stored alongside the compiled Haskell code. It covers use cases +where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be +problematically slow. + +The data is stored efficiently, with very little overhead (worst-case 7%, often +no overhead at all). + +Unlike "Clash.Explicit.BlockRam.File", "Clash.Explicit.BlockRam.Blob" +generates practically the same HDL as "Clash.Explicit.BlockRam" and is +compatible with all tools consuming the generated HDL. +-} + +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK show-extensions #-} + +module Clash.Explicit.BlockRam.Blob + ( -- * BlockRAMs initialized with a 'MemBlob' + blockRamBlob + , blockRamBlobPow2 + -- * Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob + -- * Internal + , blockRamBlob# + ) where + +import Control.Exception (catch, throw) +import Control.Monad (forM_) +import Control.Monad.ST (ST, runST) +import Control.Monad.ST.Unsafe (unsafeInterleaveST, unsafeIOToST, unsafeSTToIO) +import Data.Array.MArray (newListArray) +import qualified Data.ByteString.Lazy as L +import Data.Maybe (isJust) +import GHC.Arr (STArray, unsafeReadSTArray, unsafeWriteSTArray) +import GHC.Stack (withFrozenCallStack) +import GHC.TypeLits (KnownNat, type (^)) +import Language.Haskell.TH + (DecsQ, ExpQ, integerL, litE, litT, mkName, normalB, numTyLit, sigD, + stringPrimL, valD, varP) + +import Clash.Annotations.Primitive (hasBlackBox) +import Clash.Explicit.BlockRam.Internal + (MemBlob(..), packBVs, unpackMemBlob, unpackMemBlob0) +import Clash.Explicit.Signal (KnownDomain, Enable, fromEnable) +import Clash.Promoted.Nat (natToInteger, natToNum) +import Clash.Signal.Bundle (unbundle) +import Clash.Signal.Internal (Clock, Signal(..), (.&&.)) +import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..)) +import Clash.Sized.Internal.Unsigned (Unsigned) +import Clash.XException + (maybeIsX, deepErrorX, defaultSeqX, fromJustX, XException (..), seqX) + +-- $setup +-- >>> :set -XTemplateHaskell +-- >>> :set -fplugin GHC.TypeLits.Normalise +-- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver +-- >>> :m -Prelude +-- >>> import Clash.Explicit.Prelude + +-- | Create a blockRAM with space for @n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- +-- Additional helpful information: +-- +-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a +-- Block RAM. +-- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining +-- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' +-- clk rst en ('blockRamBlob' clk en content) rd wrM@. +blockRamBlob + :: forall dom addr m n + . ( KnownDomain dom + , Enum addr + ) + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob n m + -- ^ Initial content of the RAM, also determines the size, @n@, of the RAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom addr + -- ^ Read address @r@ + -> Signal dom (Maybe (addr, BitVector m)) + -- ^ (write address @w@, value to write) + -> Signal dom (BitVector m) + -- ^ Value of the blockRAM at address @r@ from the previous clock cycle +blockRamBlob = \clk gen content rd wrM -> + let en = isJust <$> wrM + (wr,din) = unbundle (fromJustX <$> wrM) + in blockRamBlob# clk gen content (fromEnum <$> rd) en (fromEnum <$> wr) din +{-# INLINE blockRamBlob #-} + +-- | Create a blockRAM with space for 2^@n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a +-- Block RAM. +-- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining +-- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' +-- clk rst en ('blockRamBlobPow2' clk en content) rd wrM@. +blockRamBlobPow2 + :: forall dom m n + . ( KnownDomain dom + , KnownNat n + ) + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob (2^n) m + -- ^ Initial content of the RAM, also determines the size, 2^@n@, of the RAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom (Unsigned n) + -- ^ Read address @r@ + -> Signal dom (Maybe (Unsigned n, BitVector m)) + -- ^ (write address @w@, value to write) + -> Signal dom (BitVector m) + -- ^ Value of the blockRAM at address @r@ from the previous clock cycle +blockRamBlobPow2 = blockRamBlob +{-# INLINE blockRamBlobPow2 #-} + +-- | BlockRAM primitive +blockRamBlob# + :: forall dom m n + . KnownDomain dom + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob n m + -- ^ Initial content of the RAM, also determines the size, @n@, of the RAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom Int + -- ^ Read address @r@ + -> Signal dom Bool + -- ^ Write enable + -> Signal dom Int + -- ^ Write address @w@ + -> Signal dom (BitVector m) + -- ^ Value to write (at address @w@) + -> Signal dom (BitVector m) + -- ^ Value of the blockRAM at address @r@ from the previous clock cycle +blockRamBlob# !_ gen content@MemBlob{} = \rd wen waS wd -> runST $ do + bvList <- unsafeIOToST (unpackMemBlob0 content) + ramStart <- newListArray (0,szI-1) bvList + go + ramStart + (withFrozenCallStack (deepErrorX "blockRamBlob: intial value undefined")) + (fromEnable gen) + rd + (fromEnable gen .&&. wen) + waS + wd + where + szI = natToNum @n @Int + + go :: STArray s Int (BitVector m) -> BitVector m -> Signal dom Bool + -> Signal dom Int -> Signal dom Bool -> Signal dom Int + -> Signal dom (BitVector m) -> ST s (Signal dom (BitVector m)) + go !ram o ret@(~(re :- res)) rt@(~(r :- rs)) et@(~(e :- en)) wt@(~(w :- wr)) + dt@(~(d :- din)) = do + o `seqX` (o :-) <$> (ret `seq` rt `seq` et `seq` wt `seq` dt `seq` + unsafeInterleaveST + (do o' <- unsafeIOToST + (catch (if re then unsafeSTToIO (ram `safeAt` r) else pure o) + (\err@XException {} -> pure (throw err))) + d `defaultSeqX` upd ram e w d + go ram o' res rs en wr din)) + + upd :: STArray s Int (BitVector m) -> Bool -> Int -> BitVector m -> ST s () + upd ram we waddr d = case maybeIsX we of + Nothing -> case maybeIsX waddr of + Nothing -> -- Put the XException from `waddr` as the value in all + -- locations of `ram`. + forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) + Just wa -> -- Put the XException from `we` as the value at address + -- `waddr`. + safeUpdate wa (seq we d) ram + Just True -> case maybeIsX waddr of + Nothing -> -- Put the XException from `waddr` as the value in all + -- locations of `ram`. + forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) + Just wa -> safeUpdate wa d ram + _ -> return () + + safeAt :: STArray s Int (BitVector m) -> Int -> ST s (BitVector m) + safeAt s i = + if (0 <= i) && (i < szI) then + unsafeReadSTArray s i + else pure $ + withFrozenCallStack + (deepErrorX ("blockRamBlob: read address " <> show i <> + " not in range [0.." <> show szI <> ")")) + {-# INLINE safeAt #-} + + safeUpdate :: Int -> BitVector m -> STArray s Int (BitVector m) -> ST s () + safeUpdate i a s = + if (0 <= i) && (i < szI) then + unsafeWriteSTArray s i a + else + let d = withFrozenCallStack + (deepErrorX ("blockRam: write address " <> show i <> + " not in range [0.." <> show szI <> ")")) + in forM_ [0..(szI-1)] (\j -> unsafeWriteSTArray s j d) + {-# INLINE safeUpdate #-} +{-# ANN blockRamBlob# hasBlackBox #-} +{-# NOINLINE blockRamBlob# #-} + +-- | Create a 'MemBlob' binding from a list of values +-- +-- Since this uses Template Haskell, nothing in the arguments given to +-- 'createMemBlob' can refer to something defined in the same module. +-- +-- === __Example__ +-- +-- @ +-- 'createMemBlob' @8 "content" 'Nothing' [15 .. 17] +-- +-- ram clk en = 'blockRamBlob' clk en content +-- @ +-- +-- The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value +-- does not matter. But the bits need a defined value in the memory. Either 0 or +-- 1 can be used, and both are valid representations of the data. +-- +-- >>> import qualified Prelude as P +-- >>> let es = P.map pack [ Nothing, Just (7 :: Unsigned 8), Just 8 ] +-- >>> :{ +-- createMemBlob "content0" (Just 0) es +-- createMemBlob "content1" (Just 1) es +-- x = 1 +-- :} +-- +-- >>> let pr = mapM_ (putStrLn . show) +-- >>> pr es +-- 0b0_...._.... +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> pr $ unpackMemBlob content0 +-- 0b0_0000_0000 +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> pr $ unpackMemBlob content1 +-- 0b0_1111_1111 +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> :{ +-- createMemBlob "contentN" Nothing es +-- x = 1 +-- :} +-- +-- :...: error: +-- packBVs: cannot convert don't care values. Please specify a mapping to a definite value. +-- +-- Note how we hinted to @clashi@ that our multi-line command was a list of +-- declarations by including a dummy declaration @x = 1@. Without this trick, +-- @clashi@ would expect an expression and the Template Haskell would not work. +createMemBlob + :: forall m f + . ( Foldable f + , KnownNat m + ) + => String + -- ^ Name of the binding to generate + -> Maybe Bit + -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on + -- don't care bits. + -> f (BitVector m) + -- ^ The content for the 'MemBlob' + -> DecsQ +createMemBlob name care es = + case packed of + Left err -> fail err + Right _ -> sequence + [ sigD name0 [t| MemBlob $(n) $(m) |] + , valD (varP name0) (normalB [| MemBlob { memBlobRunsLen = $(runsLen) + , memBlobRuns = $(runs) + , memBlobEndsLen = $(endsLen) + , memBlobEnds = $(ends) + } |]) [] + ] + where + name0 = mkName name + n = litT . numTyLit . toInteger $ len + m = litT . numTyLit $ natToInteger @m + runsLen = litE . integerL . toInteger $ L.length runsB + runs = litE . stringPrimL $ L.unpack runsB + endsLen = litE . integerL . toInteger $ L.length endsB + ends = litE . stringPrimL $ L.unpack endsB + Right (len, runsB, endsB) = packed + packed = packBVs care es + +-- | Create a 'MemBlob' from a list of values +-- +-- Since this uses Template Haskell, nothing in the arguments given to +-- 'memBlobTH' can refer to something defined in the same module. +-- +-- === __Example__ +-- +-- @ +-- ram clk en = 'blockRamBlob' clk en $(memBlobTH @8 Nothing [15 .. 17]) +-- @ +-- +-- The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value +-- does not matter. But the bits need a defined value in the memory. Either 0 or +-- 1 can be used, and both are valid representations of the data. +-- +-- >>> import qualified Prelude as P +-- >>> let es = P.map pack [ Nothing, Just (7 :: Unsigned 8), Just 8 ] +-- >>> content0 = $(memBlobTH (Just 0) es) +-- >>> content1 = $(memBlobTH (Just 1) es) +-- >>> let pr = mapM_ (putStrLn . show) +-- >>> pr es +-- 0b0_...._.... +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> pr $ unpackMemBlob content0 +-- 0b0_0000_0000 +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> pr $ unpackMemBlob content1 +-- 0b0_1111_1111 +-- 0b1_0000_0111 +-- 0b1_0000_1000 +-- >>> $(memBlobTH Nothing es) +-- +-- :...: error: +-- • packBVs: cannot convert don't care values. Please specify a mapping to a definite value. +-- • In the untyped splice: $(memBlobTH Nothing es) +memBlobTH + :: forall m f + . ( Foldable f + , KnownNat m + ) + => Maybe Bit + -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on + -- don't care bits. + -> f (BitVector m) + -- ^ The content for the 'MemBlob' + -> ExpQ +memBlobTH care es = + case packed of + Left err -> fail err + Right _ -> [| MemBlob { memBlobRunsLen = $(runsLen) + , memBlobRuns = $(runs) + , memBlobEndsLen = $(endsLen) + , memBlobEnds = $(ends) + } + :: MemBlob $(n) $(m) |] + where + n = litT . numTyLit . toInteger $ len + m = litT . numTyLit $ natToInteger @m + runsLen = litE . integerL . toInteger $ L.length runsB + runs = litE . stringPrimL $ L.unpack runsB + endsLen = litE . integerL . toInteger $ L.length endsB + ends = litE . stringPrimL $ L.unpack endsB + Right (len, runsB, endsB) = packed + packed = packBVs care es diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs index 9ecfedff82..8333a06d45 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs @@ -116,6 +116,7 @@ import GHC.TypeLits (KnownNat) import Numeric (readInt) import System.IO +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack, BitSize, pack) import Clash.Promoted.Nat (SNat (..), pow2SNat, natToNum, snatToNum) import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..), undefined#) @@ -420,6 +421,7 @@ blockRamFile# (Clock _) ena sz file = \rd wen waS wd -> runST $ do Nothing -> undefined# parseBV' = fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt {-# NOINLINE blockRamFile# #-} +{-# ANN blockRamFile# hasBlackBox #-} -- | __NB:__ Not synthesizable initMem :: KnownNat n => FilePath -> IO [BitVector n] diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/Internal.hs b/clash-prelude/src/Clash/Explicit/BlockRam/Internal.hs new file mode 100644 index 0000000000..b17849963c --- /dev/null +++ b/clash-prelude/src/Clash/Explicit/BlockRam/Internal.hs @@ -0,0 +1,191 @@ +{-| +Copyright : (C) 2021-2022, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} + +module Clash.Explicit.BlockRam.Internal where + +import Data.Bits ((.&.), (.|.), shiftL, xor) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Builder (Builder, toLazyByteString, word8, word64BE) +import qualified Data.ByteString.Unsafe as B +import Data.Foldable (foldl') +import Data.Word (Word64) +import GHC.Exts (Addr#) +import GHC.TypeLits (KnownNat, Nat) +import Numeric.Natural (Natural) +import System.IO.Unsafe (unsafePerformIO) + +import Clash.Promoted.Nat (natToNum) +import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..)) + +-- | Efficient storage of memory content +-- +-- It holds @n@ words of @'BitVector' m@. +data MemBlob (n :: Nat) (m :: Nat) where + MemBlob + :: ( KnownNat n + , KnownNat m + ) + => { memBlobRunsLen :: !Int + , memBlobRuns :: Addr# + , memBlobEndsLen :: !Int + , memBlobEnds :: Addr# + } + -> MemBlob n m + +instance Show (MemBlob n m) where + showsPrec _ x@MemBlob{} = + ("$(memBlobTH @" ++) . shows (natToNum @m @Int) . (" Nothing " ++) . + shows (unpackMemBlob x) . (')':) + +-- | Convert a 'MemBlob' back to a list +-- +-- __NB__: Not synthesizable +unpackMemBlob + :: forall n m + . MemBlob n m + -> [BitVector m] +unpackMemBlob = unsafePerformIO . unpackMemBlob0 + +unpackMemBlob0 + :: forall n m + . MemBlob n m + -> IO [BitVector m] +unpackMemBlob0 MemBlob{..} = do + runsB <- B.unsafePackAddressLen memBlobRunsLen memBlobRuns + endsB <- B.unsafePackAddressLen memBlobEndsLen memBlobEnds + return $ map (BV 0) $ + unpackNats (natToNum @n) (natToNum @m) runsB endsB + +packBVs + :: forall m f + . ( Foldable f + , KnownNat m + ) + => Maybe Bit + -> f (BitVector m) + -> Either String (Int, L.ByteString, L.ByteString) +packBVs care es = + case lenOrErr of + Nothing -> Left err + Just len -> let (runs, ends) = packAsNats mI knownBVVal es + in Right (len, runs, ends) + where + lenOrErr = case care of + Just (Bit 0 _) -> Just $ length es + _ -> foldl' lenOrErr0 (Just 0) es + lenOrErr0 (Just len) (BV 0 _) = Just $ len + 1 + lenOrErr0 _ _ = Nothing + + knownBVVal bv@(BV _ val) = case care of + Just (Bit 0 bm) -> maskBVVal bm bv + _ -> val + + maskBVVal _ (BV 0 val) = val + maskBVVal 0 (BV mask val) = val .&. (mask `xor` fullMask) + maskBVVal _ (BV mask val) = val .|. mask + + mI = natToNum @m @Int + fullMask = (1 `shiftL` mI) - 1 + err = "packBVs: cannot convert don't care values. " ++ + "Please specify a mapping to a definite value." + +packAsNats + :: forall a f + . Foldable f + => Int + -> (a -> Natural) + -> f a + -> (L.ByteString, L.ByteString) +packAsNats width trans es = (toLazyByteString runs0, toLazyByteString ends) + where + (runL, endL) = width `divMod` 8 + ends | endC0 > 0 = word64BE endA0 <> ends0 + | otherwise = ends0 + (runs0, ends0, endC0, endA0) = foldr pack0 (mempty, mempty, 0, 0) es + + pack0 :: a -> (Builder, Builder, Int, Word64) -> + (Builder, Builder, Int, Word64) + pack0 val (runs1, ends1, endC1, endA1) = + let (ends2, endC2, endA2) = packEnd val2 ends1 endC1 endA1 + (val2, runs2) = packRun runL (trans val) runs1 + in (runs2, ends2, endC2, endA2) + + packRun :: Int -> Natural -> Builder -> (Natural, Builder) + packRun 0 val1 runs1 = (val1, runs1) + packRun runC val1 runs1 = let (val2, runB) = val1 `divMod` 256 + runs2 = word8 (fromIntegral runB) <> runs1 + in packRun (runC - 1) val2 runs2 + + packEnd :: Natural -> Builder -> Int -> Word64 -> (Builder, Int, Word64) + packEnd val2 ends1 endC1 endA1 + | endL == 0 = (ends1, endC1, endA1) + | endC2 <= 64 = let endA2 = endA1 * (2 ^ endL) + valEnd + in (ends1, endC2, endA2) + | otherwise = let ends2 = word64BE endA1 <> ends1 + in (ends2, endL, valEnd) + where + endC2 = endC1 + endL + valEnd = fromIntegral val2 + +unpackNats + :: Int + -> Int + -> B.ByteString + -> B.ByteString + -> [Natural] +unpackNats 0 _ _ _ = [] +unpackNats len width runBs endBs + | width < 8 = ends + | otherwise = go (head ends) runL runBs (tail ends) + where + (runL, endL) = width `divMod` 8 + ends = if endL == 0 then + repeat 0 + else + unpackEnds endL len $ unpackW64s endBs + + go val 0 runBs0 ~(end0:ends0) = val : go end0 runL runBs0 ends0 + go _ _ runBs0 _ | B.null runBs0 = [] + go val runC runBs0 ends0 + = let Just (runB, runBs1) = B.uncons runBs0 + val0 = val * 256 + fromIntegral runB + in go val0 (runC - 1) runBs1 ends0 + +unpackW64s + :: B.ByteString + -> [Word64] +unpackW64s = go 8 0 + where + go :: Int -> Word64 -> B.ByteString -> [Word64] + go 8 _ endBs | B.null endBs = [] + go 0 val endBs = val : go 8 0 endBs + go n val endBs = let Just (endB, endBs0) = B.uncons endBs + val0 = val * 256 + fromIntegral endB + in go (n - 1) val0 endBs0 + +unpackEnds + :: Int + -> Int + -> [Word64] + -> [Natural] +unpackEnds _ _ [] = [] +unpackEnds endL len (w:ws) = go endCInit w ws + where + endPerWord = 64 `div` endL + leader = len `mod` endPerWord + endCInit | leader == 0 = endPerWord + | otherwise = leader + + go 0 _ [] = [] + go 0 _ (w0:ws0) = go endPerWord w0 ws0 + go n endA ws0 = let (endA0, valEnd) = endA `divMod` (2 ^ endL) + in fromIntegral valEnd : go (n - 1) endA0 ws0 diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs index c17982265e..bb1f365240 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -32,7 +32,12 @@ module Clash.Explicit.Prelude , asyncRomPow2 , rom , romPow2 - -- ** ROMs initialized with a data file + -- ** ROMs defined by a 'MemBlob' + , asyncRomBlob + , asyncRomBlobPow2 + , romBlob + , romBlobPow2 + -- ** ROMs defined by a data file , asyncRomFile , asyncRomFilePow2 , romFile @@ -46,6 +51,14 @@ module Clash.Explicit.Prelude , blockRamU , blockRam1 , ResetStrategy(..) + -- ** BlockRAM primitives initialized with a 'MemBlob' + , blockRamBlob + , blockRamBlobPow2 + -- *** Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob -- ** BlockRAM primitives initialized with a data file , blockRamFile , blockRamFilePow2 @@ -144,11 +157,13 @@ import Clash.Class.Resize import Clash.Magic import Clash.NamedTypes import Clash.Explicit.BlockRam +import Clash.Explicit.BlockRam.Blob import Clash.Explicit.BlockRam.File import Clash.Explicit.Mealy import Clash.Explicit.Moore import Clash.Explicit.RAM import Clash.Explicit.ROM +import Clash.Explicit.ROM.Blob import Clash.Explicit.ROM.File import Clash.Explicit.Prelude.Safe import Clash.Explicit.Reset diff --git a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs index 7913d783da..d3519bc488 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -34,12 +34,25 @@ module Clash.Explicit.Prelude.Safe , asyncRomPow2 , rom , romPow2 + -- ** ROMs defined by a 'MemBlob' + , asyncRomBlob + , asyncRomBlobPow2 + , romBlob + , romBlobPow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * BlockRAM primitives , blockRam , blockRamPow2 + -- ** BlockRAM primitives initialized with a 'MemBlob' + , blockRamBlob + , blockRamBlobPow2 + -- *** Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob -- ** BlockRAM read/write conflict resolution , readNew -- * Utility functions @@ -110,14 +123,17 @@ import Clash.Class.Resize import Clash.NamedTypes import Clash.Explicit.BlockRam +import Clash.Explicit.BlockRam.Blob import Clash.Explicit.Mealy import Clash.Explicit.Moore import Clash.Explicit.RAM import Clash.Explicit.ROM +import Clash.Explicit.ROM.Blob import Clash.Explicit.Signal import Clash.Explicit.Signal.Delayed import Clash.Explicit.Synchronizer (dualFlipFlopSynchronizer, asyncFIFOSynchronizer) +import Clash.Prelude.ROM.Blob (asyncRomBlob, asyncRomBlobPow2) import Clash.Prelude.ROM (asyncRom, asyncRomPow2) import Clash.Promoted.Nat import Clash.Promoted.Nat.TH diff --git a/clash-prelude/src/Clash/Explicit/RAM.hs b/clash-prelude/src/Clash/Explicit/RAM.hs index c3a65b885a..b3eac6cc85 100644 --- a/clash-prelude/src/Clash/Explicit/RAM.hs +++ b/clash-prelude/src/Clash/Explicit/RAM.hs @@ -35,6 +35,7 @@ import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownNat) import qualified Data.Sequence as Seq +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.Signal (unbundle, KnownDomain, andEnable) import Clash.Promoted.Nat (SNat (..), snatToNum, pow2SNat) import Clash.Signal.Internal (Clock (..), Signal (..), Enable, fromEnable) @@ -214,3 +215,4 @@ asyncRam# !_ !_ en sz rd we wr din = dout in d <$ s {-# INLINE safeUpdate #-} {-# NOINLINE asyncRam# #-} +{-# ANN asyncRam# hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Explicit/ROM.hs b/clash-prelude/src/Clash/Explicit/ROM.hs index 41a725d4c2..5e28b54189 100644 --- a/clash-prelude/src/Clash/Explicit/ROM.hs +++ b/clash-prelude/src/Clash/Explicit/ROM.hs @@ -2,7 +2,7 @@ Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -33,6 +33,7 @@ import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding (length) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Internal (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) import Clash.Sized.Unsigned (Unsigned) @@ -49,6 +50,10 @@ import Clash.XException (deepErrorX, seqX, NFDataX) -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Explicit.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Explicit.ROM.File.romFilePow2' and +-- 'Clash.Explicit.ROM.Blob.romBlobPow2' for different approaches that scale +-- well. romPow2 :: (KnownDomain dom, KnownNat n, NFDataX a) => Clock dom @@ -76,6 +81,9 @@ romPow2 = rom -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Explicit.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Explicit.ROM.File.romFile' and +-- 'Clash.Explicit.ROM.Blob.romBlob' for different approaches that scale well. rom :: (KnownDomain dom, KnownNat n, NFDataX a, Enum addr) => Clock dom @@ -129,6 +137,7 @@ rom# !_ en content = else withFrozenCallStack (deepErrorX ("rom: address " ++ show i ++ - "not in range [0.." ++ show szI ++ ")")) + " not in range [0.." ++ show szI ++ ")")) {-# INLINE safeAt #-} {-# NOINLINE rom# #-} +{-# ANN rom# hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Explicit/ROM/Blob.hs b/clash-prelude/src/Clash/Explicit/ROM/Blob.hs new file mode 100644 index 0000000000..0b9be5e51b --- /dev/null +++ b/clash-prelude/src/Clash/Explicit/ROM/Blob.hs @@ -0,0 +1,153 @@ +{-| +Copyright : (C) 2021-2022, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + += Efficient bundling of ROM content with the compiled code + +Leveraging Template Haskell, the content for the ROM components in this module +is stored alongside the compiled Haskell code. It covers use cases where passing +the initial content as a 'Clash.Sized.Vector.Vec' turns out to be +problematically slow. + +The data is stored efficiently, with very little overhead (worst-case 7%, often +no overhead at all). + +Unlike "Clash.Explicit.ROM.File", "Clash.Explicit.ROM.Blob" generates +practically the same HDL as "Clash.Explicit.ROM" and is compatible with all +tools consuming the generated HDL. +-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Trustworthy #-} + +{-# OPTIONS_HADDOCK show-extensions #-} + +module Clash.Explicit.ROM.Blob + ( -- * ROMs defined by a 'MemBlob' + romBlob + , romBlobPow2 + -- * Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob + -- * Internal + , romBlob# + ) where + +import Data.Array (listArray) +import Data.Array.Base (unsafeAt) +import GHC.Stack (withFrozenCallStack) +import GHC.TypeLits (KnownNat, type (^)) + +import Clash.Annotations.Primitive (hasBlackBox) +import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH) +import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob) +import Clash.Promoted.Nat (natToNum) +import Clash.Signal.Internal + (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) +import Clash.Sized.Internal.BitVector (BitVector) +import Clash.Sized.Internal.Unsigned (Unsigned) +import Clash.XException (deepErrorX, seqX) + +-- | A ROM with a synchronous read port, with space for @n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs +romBlob + :: forall dom addr m n + . ( KnownDomain dom + , Enum addr + ) + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob n m + -- ^ ROM content, also determines the size, @n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom addr + -- ^ Read address @r@ + -> Signal dom (BitVector m) + -- ^ The value of the ROM at address @r@ from the previous clock cycle +romBlob = \clk en content rd -> romBlob# clk en content (fromEnum <$> rd) +{-# INLINE romBlob #-} + +-- | A ROM with a synchronous read port, with space for 2^@n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs +romBlobPow2 + :: forall dom m n + . ( KnownDomain dom + , KnownNat n + ) + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob (2^n) m + -- ^ ROM content, also determines the size, 2^@n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom (Unsigned n) + -- ^ Read address @r@ + -> Signal dom (BitVector m) + -- ^ The value of the ROM at address @r@ from the previous clock cycle +romBlobPow2 = romBlob +{-# INLINE romBlobPow2 #-} + +-- | ROM primitive +romBlob# + :: forall dom m n + . KnownDomain dom + => Clock dom + -- ^ 'Clock' to synchronize to + -> Enable dom + -- ^ 'Enable' line + -> MemBlob n m + -- ^ ROM content, also determines the size, @n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom Int + -- ^ Read address @r@ + -> Signal dom (BitVector m) + -- ^ The value of the ROM at address @r@ from the previous clock cycle +romBlob# !_ en content@MemBlob{} = + go + (withFrozenCallStack (deepErrorX "romBlob: initial value undefined")) + (fromEnable en) + where + szI = natToNum @n @Int + arr = listArray (0,szI-1) $ unpackMemBlob content + + go o (e :- es) rd@(~(r :- rs)) = + let o1 = if e then safeAt r else o + -- See [Note: register strictness annotations] + in o `seqX` o :- (rd `seq` go o1 es rs) + + safeAt :: Int -> BitVector m + safeAt i = + if (0 <= i) && (i < szI) then + unsafeAt arr i + else + withFrozenCallStack + (deepErrorX ("romBlob: address " ++ show i ++ + " not in range [0.." ++ show szI ++ ")")) + {-# INLINE safeAt #-} +{-# NOINLINE romBlob# #-} +{-# ANN romBlob# hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Explicit/ROM/File.hs b/clash-prelude/src/Clash/Explicit/ROM/File.hs index a7b52faf37..5ee18c535a 100644 --- a/clash-prelude/src/Clash/Explicit/ROM/File.hs +++ b/clash-prelude/src/Clash/Explicit/ROM/File.hs @@ -2,7 +2,7 @@ Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2019 , Myrtle Software Ltd., - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -97,7 +97,8 @@ import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.TypeLits (KnownNat) import System.IO.Unsafe (unsafePerformIO) --- + +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.File (initMem, memFile) import Clash.Promoted.Nat (SNat (..), pow2SNat, snatToNum) import Clash.Sized.BitVector (BitVector) @@ -222,3 +223,4 @@ romFile# clk en sz file rd = " not in range [0.." ++ show szI ++ ")") {-# INLINE safeAt #-} {-# NOINLINE romFile# #-} +{-# ANN romFile# hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Explicit/SimIO.hs b/clash-prelude/src/Clash/Explicit/SimIO.hs index 6f200e815c..36091cab9d 100644 --- a/clash-prelude/src/Clash/Explicit/SimIO.hs +++ b/clash-prelude/src/Clash/Explicit/SimIO.hs @@ -1,5 +1,6 @@ {-| - Copyright : (C) 2019, Google Inc + Copyright : (C) 2019, Google Inc., + 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -69,6 +70,7 @@ data SimIO a = SimIO {unSimIO :: !(IO a)} #else newtype SimIO a = SimIO {unSimIO :: IO a} #endif +{-# ANN unSimIO hasBlackBox #-} instance Functor SimIO where fmap = fmapSimIO# @@ -76,6 +78,7 @@ instance Functor SimIO where fmapSimIO# :: (a -> b) -> SimIO a -> SimIO b fmapSimIO# f (SimIO m) = SimIO (fmap f m) {-# NOINLINE fmapSimIO# #-} +{-# ANN fmapSimIO# hasBlackBox #-} instance Applicative SimIO where pure = pureSimIO# @@ -84,10 +87,12 @@ instance Applicative SimIO where pureSimIO# :: a -> SimIO a pureSimIO# a = SimIO (pure a) {-# NOINLINE pureSimIO# #-} +{-# ANN pureSimIO# hasBlackBox #-} apSimIO# :: SimIO (a -> b) -> SimIO a -> SimIO b apSimIO# (SimIO f) (SimIO m) = SimIO (f <*> m) {-# NOINLINE apSimIO# #-} +{-# ANN apSimIO# hasBlackBox #-} instance Monad SimIO where return = pureSimIO# @@ -100,6 +105,7 @@ bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` unSimIO (k x))) bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` coerce k x)) #endif {-# NOINLINE bindSimIO# #-} +{-# ANN bindSimIO# hasBlackBox #-} -- | Display a string on /stdout/ display diff --git a/clash-prelude/src/Clash/Intel/ClockGen.hs b/clash-prelude/src/Clash/Intel/ClockGen.hs index ad821cabcb..ebb9d0d446 100644 --- a/clash-prelude/src/Clash/Intel/ClockGen.hs +++ b/clash-prelude/src/Clash/Intel/ClockGen.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2017-2018, Google Inc 2019 , Myrtle Software + 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. PLL and other clock-related components for Intel (Altera) FPGAs -} @@ -14,6 +15,7 @@ module Clash.Intel.ClockGen , alteraPll ) where +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Clocks (Clocks (..)) import Clash.Promoted.Symbol (SSymbol) import Clash.Signal.Internal @@ -57,6 +59,7 @@ altpll -- ^ (Stable PLL clock, PLL lock) altpll !_ = knownDomain @domIn `seq` knownDomain @domOut `seq` clocks {-# NOINLINE altpll #-} +{-# ANN altpll hasBlackBox #-} -- | A clock source that corresponds to the Intel/Quartus \"Altera PLL\" -- component (Arria V, Stratix V, Cyclone V) with settings to provide a stable @@ -100,3 +103,4 @@ alteraPll -> t alteraPll !_ = clocks {-# NOINLINE alteraPll #-} +{-# ANN alteraPll hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Prelude.hs b/clash-prelude/src/Clash/Prelude.hs index 70729b356b..fd8b0c9ad8 100644 --- a/clash-prelude/src/Clash/Prelude.hs +++ b/clash-prelude/src/Clash/Prelude.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017 , Google Inc., - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -60,7 +60,12 @@ module Clash.Prelude , asyncRomPow2 , rom , romPow2 - -- ** ROMs initialized with a data file + -- ** ROMs defined by a 'MemBlob' + , asyncRomBlob + , asyncRomBlobPow2 + , romBlob + , romBlobPow2 + -- ** ROMs defined by a data file , asyncRomFile , asyncRomFilePow2 , romFile @@ -74,6 +79,14 @@ module Clash.Prelude , blockRamU , blockRam1 , E.ResetStrategy(..) + -- ** BlockRAM primitives initialized with a 'MemBlob' + , blockRamBlob + , blockRamBlobPow2 + -- *** Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob -- ** BlockRAM primitives initialized with a data file , blockRamFile , blockRamFilePow2 @@ -176,7 +189,9 @@ import Clash.Hidden import Clash.Magic import Clash.NamedTypes import Clash.Prelude.BlockRam +import Clash.Prelude.BlockRam.Blob import Clash.Prelude.BlockRam.File +import Clash.Prelude.ROM.Blob import Clash.Prelude.ROM.File import Clash.Prelude.Safe #ifdef CLASH_MULTIPLE_HIDDEN diff --git a/clash-prelude/src/Clash/Prelude/BlockRam.hs b/clash-prelude/src/Clash/Prelude/BlockRam.hs index e30b18200c..7bfb5074ab 100644 --- a/clash-prelude/src/Clash/Prelude/BlockRam.hs +++ b/clash-prelude/src/Clash/Prelude/BlockRam.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2019, Myrtle Software Ltd, 2017 , Google Inc., - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -692,6 +692,10 @@ prog2 = -- 0 := 4 -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @readNew (blockRam inits) rd wrM@. +-- * A large 'Vec' for the initial content might be too inefficient, depending +-- on how it is constructed. See 'Clash.Prelude.BlockRam.File.blockRamFile' and +-- 'Clash.Prelude.BlockRam.Blob.blockRamBlob' for different approaches that +-- scale well. blockRam :: ( HasCallStack , HiddenClock dom @@ -790,6 +794,10 @@ blockRam1 = -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @readNew (blockRamPow2 inits) rd wrM@. +-- * A large 'Vec' for the initial content might be too inefficient, depending +-- on how it is constructed. See 'Clash.Prelude.BlockRam.File.blockRamFilePow2' +-- and 'Clash.Prelude.BlockRam.Blob.blockRamBlobPow2' for different approaches +-- that scale well. blockRamPow2 :: ( HasCallStack , HiddenClock dom diff --git a/clash-prelude/src/Clash/Prelude/BlockRam/Blob.hs b/clash-prelude/src/Clash/Prelude/BlockRam/Blob.hs new file mode 100644 index 0000000000..cb9c0c58f7 --- /dev/null +++ b/clash-prelude/src/Clash/Prelude/BlockRam/Blob.hs @@ -0,0 +1,107 @@ +{-| +Copyright : (C) 2022 , QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + += Efficient bundling of initial RAM content with the compiled code + +Leveraging Template Haskell, the initial content for the blockRAM components in +this module is stored alongside the compiled Haskell code. It covers use cases +where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be +problematically slow. + +The data is stored efficiently, with very little overhead (worst-case 7%, often +no overhead at all). + +Unlike "Clash.Prelude.BlockRam.File", "Clash.Prelude.BlockRam.Blob" generates +practically the same HDL as "Clash.Prelude.BlockRam" and is compatible with all +tools consuming the generated HDL. +-} + +{-# LANGUAGE Safe #-} + +{-# OPTIONS_HADDOCK show-extensions #-} + +module Clash.Prelude.BlockRam.Blob + ( -- * BlockRAMs initialized with a 'E.MemBlob' + blockRamBlob + , blockRamBlobPow2 + -- * Creating and inspecting 'E.MemBlob' + , E.MemBlob + , E.createMemBlob + , E.memBlobTH + , E.unpackMemBlob + ) +where + +import GHC.TypeLits (KnownNat, type (^)) + +import qualified Clash.Explicit.BlockRam.Blob as E +import Clash.Signal (hideClock, hideEnable, HiddenClock, HiddenEnable, Signal) +import Clash.Sized.BitVector (BitVector) +import Clash.Sized.Unsigned (Unsigned) + +-- | Create a blockRAM with space for @n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- +-- Additional helpful information: +-- +-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a +-- Block RAM. +-- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining +-- write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' +-- ('blockRamBlob' content) rd wrM@. +blockRamBlob + :: forall dom addr m n + . ( HiddenClock dom + , HiddenEnable dom + , Enum addr + ) + => E.MemBlob n m + -- ^ Initial content of the RAM, also determines the size, @n@, of the RAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom addr + -- ^ Read address @r@ + -> Signal dom (Maybe (addr, BitVector m)) + -- ^ (write address @w@, value to write) + -> Signal dom (BitVector m) + -- ^ Value of the blockRAM at address @r@ from the previous clock cycle +blockRamBlob = hideEnable (hideClock E.blockRamBlob) +{-# INLINE blockRamBlob #-} + +-- | Create a blockRAM with space for 2^@n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a +-- Block RAM. +-- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining +-- write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' +-- ('blockRamBlobPow2' content) rd wrM@. +blockRamBlobPow2 + :: forall dom m n + . ( HiddenClock dom + , HiddenEnable dom + , KnownNat n + ) + => E.MemBlob (2^n) m + -- ^ Initial content of the RAM, also determines the size, 2^@n@, of the RAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom (Unsigned n) + -- ^ Read address @r@ + -> Signal dom (Maybe (Unsigned n, BitVector m)) + -- ^ (write address @w@, value to write) + -> Signal dom (BitVector m) + -- ^ Value of the blockRAM at address @r@ from the previous clock cycle +blockRamBlobPow2 = hideEnable (hideClock E.blockRamBlobPow2) +{-# INLINE blockRamBlobPow2 #-} diff --git a/clash-prelude/src/Clash/Prelude/BlockRam/File.hs b/clash-prelude/src/Clash/Prelude/BlockRam/File.hs index d575c5e59f..bb5ac32772 100644 --- a/clash-prelude/src/Clash/Prelude/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Prelude/BlockRam/File.hs @@ -125,7 +125,7 @@ import Clash.Sized.Unsigned (Unsigned) -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. --- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' clk ('blockRamFilePow2' clk file) rd wrM@. +-- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' ('blockRamFilePow2' file) rd wrM@. -- * See "Clash.Prelude.BlockRam.File#usingramfiles" for more information on how -- to instantiate a Block RAM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your @@ -172,7 +172,7 @@ blockRamFilePow2 = \fp rd wrM -> withFrozenCallStack -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. --- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' clk ('blockRamFile' clk size file) rd wrM@. +-- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' ('blockRamFile' size file) rd wrM@. -- * See "Clash.Prelude.BlockRam.File#usingramfiles" for more information on how -- to instantiate a Block RAM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your diff --git a/clash-prelude/src/Clash/Prelude/ROM.hs b/clash-prelude/src/Clash/Prelude/ROM.hs index 234a1edea8..7831556661 100644 --- a/clash-prelude/src/Clash/Prelude/ROM.hs +++ b/clash-prelude/src/Clash/Prelude/ROM.hs @@ -2,7 +2,7 @@ Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -35,6 +35,7 @@ import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding (length) +import Clash.Annotations.Primitive (hasBlackBox) import qualified Clash.Explicit.ROM as E import Clash.Signal import Clash.Sized.Unsigned (Unsigned) @@ -48,6 +49,10 @@ import Clash.XException (NFDataX, errorX) -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Prelude.ROM.File.asyncRomFile' and +-- 'Clash.Prelude.ROM.Blob.asyncRomBlob' for different approaches that scale +-- well. asyncRom :: (KnownNat n, Enum addr) => Vec n a @@ -67,6 +72,10 @@ asyncRom = \content rd -> asyncRom# content (fromEnum rd) -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Prelude.ROM.File.asyncRomFilePow2' and +-- 'Clash.Prelude.ROM.Blob.asyncRomBlobPow2' for different approaches that scale +-- well. asyncRomPow2 :: KnownNat n => Vec (2^n) a @@ -105,16 +114,21 @@ asyncRom# content = safeAt (errorX ("asyncRom: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) {-# NOINLINE asyncRom# #-} +{-# ANN asyncRom# hasBlackBox #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle --- * __NB__: Initial output value is 'undefined' +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' -- -- Additional helpful information: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Prelude.ROM.File.romFile' and +-- 'Clash.Prelude.ROM.Blob.romBlob' for different approaches that scale well. rom :: forall dom n m a . ( NFDataX a @@ -143,6 +157,10 @@ rom = hideEnable (hideClock E.rom) -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs +-- * A large 'Vec' for the content might be too inefficient, depending on how it +-- is constructed. See 'Clash.Prelude.ROM.File.romFilePow2' and +-- 'Clash.Prelude.ROM.Blob.romBlobPow2' for different approaches that scale +-- well. romPow2 :: forall dom n a . ( KnownNat n diff --git a/clash-prelude/src/Clash/Prelude/ROM/Blob.hs b/clash-prelude/src/Clash/Prelude/ROM/Blob.hs new file mode 100644 index 0000000000..1920b5f7ad --- /dev/null +++ b/clash-prelude/src/Clash/Prelude/ROM/Blob.hs @@ -0,0 +1,175 @@ +{-| +Copyright : (C) 2022 , QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + += Efficient bundling of ROM content with the compiled code + +Leveraging Template Haskell, the content for the ROM components in this module +is stored alongside the compiled Haskell code. It covers use cases where passing +the initial content as a 'Clash.Sized.Vector.Vec' turns out to be +problematically slow. + +The data is stored efficiently, with very little overhead (worst-case 7%, often +no overhead at all). + +Unlike "Clash.Prelude.ROM.File", "Clash.Prelude.ROM.Blob" generates practically +the same HDL as "Clash.Prelude.ROM" and is compatible with all tools consuming +the generated HDL. +-} + +{-# LANGUAGE Trustworthy #-} + +{-# OPTIONS_HADDOCK show-extensions #-} + +module Clash.Prelude.ROM.Blob + ( -- * Asynchronous ROM defined by a 'MemBlob' + asyncRomBlob + , asyncRomBlobPow2 + -- * Synchronous 'MemBlob' ROM synchronized to an arbitrary clock + , romBlob + , romBlobPow2 + -- * Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob + -- * Internal + , asyncRomBlob# + ) +where + +import Data.Array (listArray) +import Data.Array.Base (unsafeAt) +import GHC.Stack (withFrozenCallStack) +import GHC.TypeLits (KnownNat, type (^)) + +import Clash.Annotations.Primitive (hasBlackBox) +import qualified Clash.Explicit.ROM.Blob as E +import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH) +import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob) +import Clash.Promoted.Nat (natToNum) +import Clash.Signal (hideClock, hideEnable, HiddenClock, HiddenEnable) +import Clash.Signal.Internal (Signal) +import Clash.Sized.Internal.BitVector (BitVector) +import Clash.Sized.Internal.Unsigned (Unsigned) +import Clash.XException (deepErrorX) + +-- | An asynchronous/combinational ROM with space for @n@ elements +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Prelude.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. +asyncRomBlob + :: Enum addr + => MemBlob n m + -- ^ ROM content, also determines the size, @n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> addr + -- ^ Read address @r@ + -> BitVector m + -- ^ The value of the ROM at address @r@ +asyncRomBlob = \content rd -> asyncRomBlob# content (fromEnum rd) +{-# INLINE asyncRomBlob #-} + +-- | An asynchronous/combinational ROM with space for 2^@n@ elements +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Prelude.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. +asyncRomBlobPow2 + :: KnownNat n + => MemBlob (2^n) m + -- ^ ROM content, also determines the size, 2^@n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Unsigned n + -- ^ Read address @r@ + -> BitVector m + -- ^ The value of the ROM at address @r@ +asyncRomBlobPow2 = asyncRomBlob +{-# INLINE asyncRomBlobPow2 #-} + +-- | asyncROM primitive +asyncRomBlob# + :: forall m n + . MemBlob n m + -- ^ ROM content, also determines the size, @n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Int + -- ^ Read address @r@ + -> BitVector m + -- ^ The value of the ROM at address @r@ +asyncRomBlob# content@MemBlob{} = safeAt + where + szI = natToNum @n @Int + arr = listArray (0,szI-1) $ unpackMemBlob content + + safeAt :: Int -> BitVector m + safeAt i = + if (0 <= i) && (i < szI) then + unsafeAt arr i + else + withFrozenCallStack + (deepErrorX ("asyncRom: address " ++ show i ++ + " not in range [0.." ++ show szI ++ ")")) +{-# ANN asyncRomBlob# hasBlackBox #-} +{-# NOINLINE asyncRomBlob# #-} + +-- | A ROM with a synchronous read port, with space for @n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. +romBlob + :: forall dom addr m n + . ( HiddenClock dom + , HiddenEnable dom + , Enum addr + ) + => MemBlob n m + -- ^ ROM content, also determines the size, @n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom addr + -- ^ Read address @r@ + -> Signal dom (BitVector m) + -- ^ The value of the ROM at address @r@ from the previous clock cycle +romBlob = hideEnable (hideClock E.romBlob) +{-# INLINE romBlob #-} + +-- | A ROM with a synchronous read port, with space for 2^@n@ elements +-- +-- * __NB__: Read value is delayed by 1 cycle +-- * __NB__: Initial output value is /undefined/, reading it will throw an +-- 'Clash.XException.XException' +-- +-- Additional helpful information: +-- +-- * See "Clash.Sized.Fixed#creatingdatafiles" and +-- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. +romBlobPow2 + :: forall dom m n + . ( HiddenClock dom + , HiddenEnable dom + , KnownNat n + ) + => MemBlob (2^n) m + -- ^ ROM content, also determines the size, 2^@n@, of the ROM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom (Unsigned n) + -- ^ Read address @r@ + -> Signal dom (BitVector m) + -- ^ The value of the ROM at address @r@ from the previous clock cycle +romBlobPow2 = hideEnable (hideClock E.romBlobPow2) +{-# INLINE romBlobPow2 #-} diff --git a/clash-prelude/src/Clash/Prelude/ROM/File.hs b/clash-prelude/src/Clash/Prelude/ROM/File.hs index d7a5b87060..ae06a2d975 100644 --- a/clash-prelude/src/Clash/Prelude/ROM/File.hs +++ b/clash-prelude/src/Clash/Prelude/ROM/File.hs @@ -2,7 +2,7 @@ Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2019 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -98,6 +98,7 @@ import Data.Array (listArray,(!)) import GHC.TypeLits (KnownNat) import System.IO.Unsafe (unsafePerformIO) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.File (initMem, memFile) import qualified Clash.Explicit.ROM.File as E import Clash.Promoted.Nat (SNat (..), pow2SNat, snatToNum) @@ -253,6 +254,7 @@ asyncRomFile# sz file = (content !) -- Leave "(content !)" eta-reduced, see content = listArray (0,szI-1) mem szI = snatToNum sz {-# NOINLINE asyncRomFile# #-} +{-# ANN asyncRomFile# hasBlackBox #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- diff --git a/clash-prelude/src/Clash/Prelude/Safe.hs b/clash-prelude/src/Clash/Prelude/Safe.hs index c3b324c41d..e318ebcdfa 100644 --- a/clash-prelude/src/Clash/Prelude/Safe.hs +++ b/clash-prelude/src/Clash/Prelude/Safe.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017 , Google Inc., - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -50,12 +50,25 @@ module Clash.Prelude.Safe , asyncRomPow2 , rom , romPow2 + -- ** ROMs defined by a 'MemBlob' + , asyncRomBlob + , asyncRomBlobPow2 + , romBlob + , romBlobPow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * BlockRAM primitives , blockRam , blockRamPow2 + -- ** BlockRAM primitives initialized with a 'MemBlob' + , blockRamBlob + , blockRamBlobPow2 + -- *** Creating and inspecting 'MemBlob' + , MemBlob + , createMemBlob + , memBlobTH + , unpackMemBlob -- ** BlockRAM read/write conflict resolution , readNew -- * Utility functions @@ -128,11 +141,13 @@ import Clash.Class.Resize import Clash.Hidden import Clash.NamedTypes import Clash.Prelude.BlockRam +import Clash.Prelude.BlockRam.Blob import qualified Clash.Explicit.Prelude.Safe as E import Clash.Prelude.Mealy (mealy, mealyB, (<^>)) import Clash.Prelude.Moore (moore, mooreB) import Clash.Prelude.RAM (asyncRam,asyncRamPow2) import Clash.Prelude.ROM (asyncRom,asyncRomPow2,rom,romPow2) +import Clash.Prelude.ROM.Blob import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals diff --git a/clash-prelude/src/Clash/Promoted/Nat.hs b/clash-prelude/src/Clash/Promoted/Nat.hs index d70bd40916..3a30f2014a 100644 --- a/clash-prelude/src/Clash/Promoted/Nat.hs +++ b/clash-prelude/src/Clash/Promoted/Nat.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016 , Myrtle Software Ltd + 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE AllowAmbiguousTypes #-} @@ -82,6 +83,8 @@ import Language.Haskell.TH.Compat #endif import Numeric.Natural (Natural) import Unsafe.Coerce (unsafeCoerce) + +import Clash.Annotations.Primitive (hasBlackBox) import Clash.XException (ShowX (..), showsPrecXWith) {- $setup @@ -265,6 +268,7 @@ infixl 7 `mulSNat` powSNat :: SNat a -> SNat b -> SNat (a^b) powSNat SNat SNat = SNat {-# NOINLINE powSNat #-} +{-# ANN powSNat hasBlackBox #-} infixr 8 `powSNat` -- | Division of two singleton natural numbers @@ -292,6 +296,7 @@ flogBaseSNat :: (2 <= base, 1 <= x) -> SNat (FLog base x) flogBaseSNat SNat SNat = SNat {-# NOINLINE flogBaseSNat #-} +{-# ANN flogBaseSNat hasBlackBox #-} -- | Ceiling of the logarithm of a natural number clogBaseSNat :: (2 <= base, 1 <= x) @@ -300,6 +305,7 @@ clogBaseSNat :: (2 <= base, 1 <= x) -> SNat (CLog base x) clogBaseSNat SNat SNat = SNat {-# NOINLINE clogBaseSNat #-} +{-# ANN clogBaseSNat hasBlackBox #-} -- | Exact integer logarithm of a natural number -- @@ -310,6 +316,7 @@ logBaseSNat :: (FLog base x ~ CLog base x) -> SNat (Log base x) logBaseSNat SNat SNat = SNat {-# NOINLINE logBaseSNat #-} +{-# ANN logBaseSNat hasBlackBox #-} -- | Power of two of a singleton natural number pow2SNat :: SNat a -> SNat (2^a) diff --git a/clash-prelude/src/Clash/Promoted/Nat/Unsafe.hs b/clash-prelude/src/Clash/Promoted/Nat/Unsafe.hs index cee2e2f5fc..db1e21146e 100644 --- a/clash-prelude/src/Clash/Promoted/Nat/Unsafe.hs +++ b/clash-prelude/src/Clash/Promoted/Nat/Unsafe.hs @@ -1,7 +1,8 @@ {-| Copyright : (C) 2015-2016, University of Twente + 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE Unsafe #-} @@ -13,9 +14,11 @@ where import Data.Reflection (reifyNat) import Unsafe.Coerce (unsafeCoerce) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Promoted.Nat (SNat, snatProxy) -- | I hope you know what you're doing unsafeSNat :: Integer -> SNat k unsafeSNat i = reifyNat i $ (\p -> unsafeCoerce (snatProxy p)) {-# NOINLINE unsafeSNat #-} +{-# ANN unsafeSNat hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Promoted/Symbol.hs b/clash-prelude/src/Clash/Promoted/Symbol.hs index 1bc5305f66..efcecacc50 100644 --- a/clash-prelude/src/Clash/Promoted/Symbol.hs +++ b/clash-prelude/src/Clash/Promoted/Symbol.hs @@ -1,14 +1,16 @@ {-| Copyright : (C) 2013-2016, University of Twente + 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskellQuotes #-} -{-# LANGUAGE Safe #-} +-- Annotations are not allowed in safe Haskell +-- {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} @@ -20,10 +22,14 @@ import Language.Haskell.TH.Syntax import GHC.Show (appPrec) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) +import Clash.Annotations.Primitive (hasBlackBox) + -- | Singleton value for a type-level string @s@ data SSymbol (s :: Symbol) where SSymbol :: KnownSymbol s => SSymbol s +{-# ANN SSymbol hasBlackBox #-} + instance KnownSymbol s => Lift (SSymbol (s :: Symbol)) where -- lift :: t -> Q Exp lift t = pure (AppTypeE (ConE 'SSymbol) tt) diff --git a/clash-prelude/src/Clash/Signal/BiSignal.hs b/clash-prelude/src/Clash/Signal/BiSignal.hs index fbb04511e7..c414e3f23f 100644 --- a/clash-prelude/src/Clash/Signal/BiSignal.hs +++ b/clash-prelude/src/Clash/Signal/BiSignal.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2017, Google Inc. 2019, Myrtle Software Ltd + 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. Wires are fundamentally bidirectional, and in traditional HDLs we can exploit this aspect by explicitly marking the endpoint, or port, of such a wire as @@ -119,6 +120,7 @@ import Data.Kind (Type) import Data.List (intercalate) import Data.Maybe (fromMaybe,isJust) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.HasDomain import Clash.Class.BitPack (BitPack (..)) import Clash.Sized.BitVector (BitVector) @@ -175,7 +177,7 @@ instance HasBiSignalDefault 'Floating where type role BiSignalIn nominal nominal nominal -- | The /in/ part of an __inout__ port. --- BiSignalIn has the +-- BiSignalIn has the -- -- >>> :i BiSignalIn -- type role BiSignalIn nominal nominal nominal @@ -193,7 +195,7 @@ type role BiSignalOut nominal nominal nominal -- Wraps (multiple) writing signals. The semantics are such that only one of -- the signals may write at a single time step. -- --- BiSignalOut has the +-- BiSignalOut has the -- -- >>> :i BiSignalOut -- type role BiSignalOut nominal nominal nominal @@ -244,6 +246,7 @@ readFromBiSignal# (BiSignalIn ds s) = SPullDown -> fromMaybe minBound <$> s SPullUp -> fromMaybe maxBound <$> s {-# NOINLINE readFromBiSignal# #-} +{-# ANN readFromBiSignal# hasBlackBox #-} -- | Read the value from an __inout__ port readFromBiSignal @@ -263,6 +266,7 @@ mergeBiSignalOuts -> BiSignalOut defaultState dom m mergeBiSignalOuts = mconcat . V.toList {-# NOINLINE mergeBiSignalOuts #-} +{-# ANN mergeBiSignalOuts hasBlackBox #-} writeToBiSignal# :: HasCallStack @@ -274,6 +278,7 @@ writeToBiSignal# -- writeToBiSignal# = writeToBiSignal# writeToBiSignal# _ maybeSignal _ _ = BiSignalOut [maybeSignal] {-# NOINLINE writeToBiSignal# #-} +{-# ANN writeToBiSignal# hasBlackBox #-} -- | Write to an __inout__ port writeToBiSignal @@ -320,3 +325,4 @@ veryUnsafeToBiSignalIn (BiSignalOut signals) = prepend# result biSignalOut' -- Recursive step biSignalOut' = veryUnsafeToBiSignalIn $ BiSignalOut $ map tail# signals {-# NOINLINE veryUnsafeToBiSignalIn #-} +{-# ANN veryUnsafeToBiSignalIn hasBlackBox #-} diff --git a/clash-prelude/src/Clash/Signal/Bundle.hs b/clash-prelude/src/Clash/Signal/Bundle.hs index d9376438e2..b8216322e1 100644 --- a/clash-prelude/src/Clash/Signal/Bundle.hs +++ b/clash-prelude/src/Clash/Signal/Bundle.hs @@ -1,9 +1,9 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd, Google Inc. - 2019, QBayLogic B.V. + 2019,2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. The Product/Signal isomorphism -} @@ -32,6 +32,7 @@ import GHC.Generics import GHC.TypeLits (KnownNat) import Prelude hiding (head, map, tail) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Bundle.Internal (deriveBundleTuples) import Clash.Signal.Internal (Signal (..), Domain) import Clash.Sized.BitVector (Bit, BitVector) @@ -155,6 +156,7 @@ instance KnownNat n => Bundle (Vec n a) where unbundle = sequenceA . fmap lazyV {-# NOINLINE vecBundle# #-} +{-# ANN vecBundle# hasBlackBox #-} vecBundle# :: Vec n (Signal t a) -> Signal t (Vec n a) vecBundle# = traverse# id diff --git a/clash-prelude/src/Clash/Signal/Delayed/Internal.hs b/clash-prelude/src/Clash/Signal/Delayed/Internal.hs index 0fc96aada8..b7bb1b0b7f 100644 --- a/clash-prelude/src/Clash/Signal/Delayed/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Delayed/Internal.hs @@ -91,7 +91,7 @@ let numbers -- | A synchronized signal with samples of type @a@, synchronized to clock -- @clk@, that has accumulated @delay@ amount of samples delay along its path. -- --- DSignal has the +-- DSignal has the -- -- >>> :i DSignal -- type role DSignal nominal nominal representational diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 899be45dab..7683e200a9 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -675,7 +675,7 @@ because some VHDL simulators don't support fractions of picoseconds. * __NB__: Whether 'System' has good defaults depends on your target platform. Check out 'IntelSystem' and 'XilinxSystem' too! -Signals have the +Signals have the >>> :i Signal type role Signal nominal representational diff --git a/clash-prelude/src/Clash/Signal/Trace.hs b/clash-prelude/src/Clash/Signal/Trace.hs index 3804a03419..7bd0dce74b 100644 --- a/clash-prelude/src/Clash/Signal/Trace.hs +++ b/clash-prelude/src/Clash/Signal/Trace.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2018, Google Inc. 2019, Myrtle Software Ltd + 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. Utilities for tracing signals and dumping them in various ways. Example usage: @@ -87,6 +88,7 @@ module Clash.Signal.Trace ) where -- Clash: +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Internal (fromList) import Clash.Signal (KnownDomain(..), SDomainConfiguration(..), Signal, bundle, unbundle) @@ -232,6 +234,7 @@ traceSignal traceName signal = unsafePerformIO $ traceSignal# traceMap# (snatToNum period) traceName signal {-# NOINLINE traceSignal #-} +{-# ANN traceSignal hasBlackBox #-} -- | Trace a single signal. Will emit an error if a signal with the same name -- was previously registered. @@ -252,6 +255,7 @@ traceSignal1 traceSignal1 traceName signal = unsafePerformIO (traceSignal# traceMap# 1 traceName signal) {-# NOINLINE traceSignal1 #-} +{-# ANN traceSignal1 hasBlackBox #-} -- | Trace a single vector signal: each element in the vector will show up as -- a different trace. If the trace name already exists, this function will emit @@ -278,6 +282,7 @@ traceVecSignal traceName signal = unsafePerformIO $ traceVecSignal# traceMap# (snatToNum period) traceName signal {-# NOINLINE traceVecSignal #-} +{-# ANN traceVecSignal hasBlackBox #-} -- | Trace a single vector signal: each element in the vector will show up as -- a different trace. If the trace name already exists, this function will emit @@ -300,6 +305,7 @@ traceVecSignal1 traceVecSignal1 traceName signal = unsafePerformIO $ traceVecSignal# traceMap# 1 traceName signal {-# NOINLINE traceVecSignal1 #-} +{-# ANN traceVecSignal1 hasBlackBox #-} iso8601Format :: UTCTime -> String iso8601Format = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" diff --git a/clash-prelude/src/Clash/Sized/Fixed.hs b/clash-prelude/src/Clash/Sized/Fixed.hs index e83e24daa2..b7c79ba8a3 100644 --- a/clash-prelude/src/Clash/Sized/Fixed.hs +++ b/clash-prelude/src/Clash/Sized/Fixed.hs @@ -171,7 +171,7 @@ import Clash.XException -- The 'Num' operators for this type saturate to 'maxBound' on overflow and -- 'minBound' on underflow, and use truncation as the rounding method. -- --- Fixed has the +-- Fixed has the -- -- >>> :i Fixed -- type role Fixed representational nominal nominal diff --git a/clash-prelude/src/Clash/Sized/Internal/BitVector.hs b/clash-prelude/src/Clash/Sized/Internal/BitVector.hs index 7c7ed5fbd0..8741858e75 100644 --- a/clash-prelude/src/Clash/Sized/Internal/BitVector.hs +++ b/clash-prelude/src/Clash/Sized/Internal/BitVector.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2019 , Gergő Érdi 2016-2019, Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -38,6 +38,8 @@ module Clash.Sized.Internal.BitVector , ge## , gt## , le## + -- *** Enum + , toEnum## -- *** Num , fromInteger## -- *** Bits @@ -80,6 +82,9 @@ module Clash.Sized.Internal.BitVector , ge# , gt# , le# + -- *** Enum + , toEnum# + , fromEnum# -- *** Enum (not synthesizable) , enumFrom# , enumFromThen# @@ -178,6 +183,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), arbitraryBoundedIntegral, coarbitraryIntegral, shrinkIntegral) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.Num (ExtendingNum (..), SaturatingNum (..), SaturationMode (..)) import Clash.Class.Resize (Resize (..)) @@ -211,7 +217,7 @@ type role BitVector nominal -- * Bit indices are descending -- * 'Num' instance performs /unsigned/ arithmetic. -- --- BitVector has the +-- BitVector has the -- -- >>> :i BitVector -- type role BitVector nominal @@ -227,6 +233,8 @@ data BitVector (n :: Nat) = } deriving (Data, Generic) +{-# ANN BV hasBlackBox #-} + -- * Bit -- | Bit @@ -238,14 +246,18 @@ data Bit = } deriving (Data, Generic) +{-# ANN Bit hasBlackBox #-} + -- * Constructions -- ** Initialisation {-# NOINLINE high #-} +{-# ANN high hasBlackBox #-} -- | logic '1' high :: Bit high = Bit 0 1 {-# NOINLINE low #-} +{-# ANN low hasBlackBox #-} -- | logic '0' low :: Bit low = Bit 0 0 @@ -284,10 +296,12 @@ instance Eq Bit where eq## :: Bit -> Bit -> Bool eq## b1 b2 = eq# (pack# b1) (pack# b2) {-# NOINLINE eq## #-} +{-# ANN eq## hasBlackBox #-} neq## :: Bit -> Bit -> Bool neq## b1 b2 = neq# (pack# b1) (pack# b2) {-# NOINLINE neq## #-} +{-# ANN neq## hasBlackBox #-} instance Ord Bit where (<) = lt## @@ -298,17 +312,26 @@ instance Ord Bit where lt##,ge##,gt##,le## :: Bit -> Bit -> Bool lt## b1 b2 = lt# (pack# b1) (pack# b2) {-# NOINLINE lt## #-} +{-# ANN lt## hasBlackBox #-} ge## b1 b2 = ge# (pack# b1) (pack# b2) {-# NOINLINE ge## #-} +{-# ANN ge## hasBlackBox #-} gt## b1 b2 = gt# (pack# b1) (pack# b2) {-# NOINLINE gt## #-} +{-# ANN gt## hasBlackBox #-} le## b1 b2 = le# (pack# b1) (pack# b2) {-# NOINLINE le## #-} +{-# ANN le## hasBlackBox #-} instance Enum Bit where - toEnum = fromInteger## 0## . toInteger + toEnum = toEnum## fromEnum b = if eq## b low then 0 else 1 +toEnum## :: Int -> Bit +toEnum## = fromInteger## 0## . toInteger +{-# NOINLINE toEnum## #-} +{-# ANN toEnum## hasBlackBox #-} + instance Bounded Bit where minBound = low maxBound = high @@ -328,6 +351,7 @@ instance Num Bit where fromInteger## :: Word# -> Integer -> Bit fromInteger## m# i = Bit ((W# m#) `mod` 2) (fromInteger i `mod` 2) {-# NOINLINE fromInteger## #-} +{-# ANN fromInteger## hasBlackBox #-} instance Real Bit where toRational b = if eq## b low then 0 else 1 @@ -372,19 +396,23 @@ and##, or##, xor## :: Bit -> Bit -> Bit and## (Bit m1 v1) (Bit m2 v2) = Bit mask (v1 .&. v2 .&. complement mask) where mask = (m1.&.v2 .|. m1.&.m2 .|. m2.&.v1) {-# NOINLINE and## #-} +{-# ANN and## hasBlackBox #-} or## (Bit m1 v1) (Bit m2 v2) = Bit mask ((v1 .|. v2) .&. complement mask) where mask = m1 .&. complement v2 .|. m1.&.m2 .|. m2 .&. complement v1 {-# NOINLINE or## #-} +{-# ANN or## hasBlackBox #-} xor## (Bit m1 v1) (Bit m2 v2) = Bit mask ((v1 `xor` v2) .&. complement mask) where mask = m1 .|. m2 {-# NOINLINE xor## #-} +{-# ANN xor## hasBlackBox #-} complement## :: Bit -> Bit complement## (Bit m v) = Bit m (complementB v .&. complementB m) where complementB (W# b#) = W# (int2Word# (eqWord# b# 0##)) {-# NOINLINE complement## #-} +{-# ANN complement## hasBlackBox #-} -- *** BitPack pack# :: Bit -> BitVector 1 @@ -394,6 +422,7 @@ pack# (Bit (W# m) (W# b)) = BV (NS m) (NS b) pack# (Bit (W# m) (W# b)) = BV (NatS# m) (NatS# b) #endif {-# NOINLINE pack# #-} +{-# ANN pack# hasBlackBox #-} unpack# :: BitVector 1 -> Bit unpack# (BV m b) = Bit (go m) (go b) @@ -406,6 +435,7 @@ unpack# (BV m b) = Bit (go m) (go b) go (NatJ# w) = W# (bigNatToWord w) #endif {-# NOINLINE unpack# #-} +{-# ANN unpack# hasBlackBox #-} -- * Instances instance NFData (BitVector n) where @@ -503,11 +533,13 @@ instance KnownNat n => Eq (BitVector n) where (/=) = neq# {-# NOINLINE eq# #-} +{-# ANN eq# hasBlackBox #-} eq# :: KnownNat n => BitVector n -> BitVector n -> Bool eq# (BV 0 v1) (BV 0 v2 ) = v1 == v2 eq# bv1 bv2 = undefErrorI "==" bv1 bv2 {-# NOINLINE neq# #-} +{-# ANN neq# hasBlackBox #-} neq# :: KnownNat n => BitVector n -> BitVector n -> Bool neq# (BV 0 v1) (BV 0 v2) = v1 /= v2 neq# bv1 bv2 = undefErrorI "/=" bv1 bv2 @@ -520,15 +552,19 @@ instance KnownNat n => Ord (BitVector n) where lt#,ge#,gt#,le# :: KnownNat n => BitVector n -> BitVector n -> Bool {-# NOINLINE lt# #-} +{-# ANN lt# hasBlackBox #-} lt# (BV 0 n) (BV 0 m) = n < m lt# bv1 bv2 = undefErrorI "<" bv1 bv2 {-# NOINLINE ge# #-} +{-# ANN ge# hasBlackBox #-} ge# (BV 0 n) (BV 0 m) = n >= m ge# bv1 bv2 = undefErrorI ">=" bv1 bv2 {-# NOINLINE gt# #-} +{-# ANN gt# hasBlackBox #-} gt# (BV 0 n) (BV 0 m) = n > m gt# bv1 bv2 = undefErrorI ">" bv1 bv2 {-# NOINLINE le# #-} +{-# ANN le# hasBlackBox #-} le# (BV 0 n) (BV 0 m) = n <= m le# bv1 bv2 = undefErrorI "<=" bv1 bv2 @@ -537,13 +573,23 @@ le# bv1 bv2 = undefErrorI "<=" bv1 bv2 instance KnownNat n => Enum (BitVector n) where succ = (+# fromInteger# 0 1) pred = (-# fromInteger# 0 1) - toEnum = fromInteger# 0 . toInteger - fromEnum = fromEnum . toInteger# + toEnum = toEnum# + fromEnum = fromEnum# enumFrom = enumFrom# enumFromThen = enumFromThen# enumFromTo = enumFromTo# enumFromThenTo = enumFromThenTo# +toEnum# :: forall n. KnownNat n => Int -> BitVector n +toEnum# = fromInteger# 0 . toInteger +{-# NOINLINE toEnum# #-} +{-# ANN toEnum# hasBlackBox #-} + +fromEnum# :: forall n. KnownNat n => BitVector n -> Int +fromEnum# = fromEnum . toInteger# +{-# NOINLINE fromEnum# #-} +{-# ANN fromEnum# hasBlackBox #-} + enumFrom# :: forall n. KnownNat n => BitVector n -> [BitVector n] enumFrom# (BV 0 x) = map (BV 0 . (`mod` m)) [x .. unsafeToNatural (maxBound :: BitVector n)] #if MIN_VERSION_base(4,15,0) @@ -612,10 +658,12 @@ instance KnownNat n => Bounded (BitVector n) where minBound# :: BitVector n minBound# = BV 0 0 {-# NOINLINE minBound# #-} +{-# ANN minBound# hasBlackBox #-} maxBound# :: forall n. KnownNat n => BitVector n maxBound# = let m = 1 `shiftL` natToNum @n in BV 0 (m-1) {-# NOINLINE maxBound# #-} +{-# ANN maxBound# hasBlackBox #-} instance KnownNat n => Num (BitVector n) where (+) = (+#) @@ -628,6 +676,7 @@ instance KnownNat n => Num (BitVector n) where (+#),(-#),(*#) :: forall n . KnownNat n => BitVector n -> BitVector n -> BitVector n {-# NOINLINE (+#) #-} +{-# ANN (+#) hasBlackBox #-} (+#) = go where go (BV 0 i) (BV 0 j) = BV 0 (addMod m i j) @@ -640,6 +689,7 @@ instance KnownNat n => Num (BitVector n) where #endif {-# NOINLINE (-#) #-} +{-# ANN (-#) hasBlackBox #-} (-#) = go where go (BV 0 i) (BV 0 j) = BV 0 (subMod m i j) @@ -652,6 +702,7 @@ instance KnownNat n => Num (BitVector n) where #endif {-# NOINLINE (*#) #-} +{-# ANN (*#) hasBlackBox #-} (*#) = go where go (BV 0 i) (BV 0 j) = BV 0 (mulMod2 m i j) @@ -664,6 +715,7 @@ instance KnownNat n => Num (BitVector n) where #endif {-# NOINLINE negate# #-} +{-# ANN negate# hasBlackBox #-} negate# :: forall n . KnownNat n => BitVector n -> BitVector n negate# = go where @@ -677,6 +729,7 @@ negate# = go #endif {-# NOINLINE fromInteger# #-} +{-# ANN fromInteger# hasBlackBox #-} fromInteger# :: KnownNat n => Natural -> Integer -> BitVector n fromInteger# m i = sz `seq` mx where @@ -698,11 +751,13 @@ instance (KnownNat m, KnownNat n) => ExtendingNum (BitVector m) (BitVector n) wh mul = times# {-# NOINLINE plus# #-} +{-# ANN plus# hasBlackBox #-} plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1) plus# (BV 0 a) (BV 0 b) = BV 0 (a + b) plus# bv1 bv2 = undefErrorP "add" bv1 bv2 {-# NOINLINE minus# #-} +{-# ANN minus# hasBlackBox #-} minus# :: forall m n . (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1) minus# = go @@ -717,6 +772,7 @@ minus# = go #endif {-# NOINLINE times# #-} +{-# ANN times# hasBlackBox #-} times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n) times# (BV 0 a) (BV 0 b) = BV 0 (a * b) times# bv1 bv2 = undefErrorP "mul" bv1 bv2 @@ -735,13 +791,16 @@ instance KnownNat n => Integral (BitVector n) where quot#,rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n {-# NOINLINE quot# #-} +{-# ANN quot# hasBlackBox #-} quot# (BV 0 i) (BV 0 j) = BV 0 (i `quot` j) quot# bv1 bv2 = undefErrorP "quot" bv1 bv2 {-# NOINLINE rem# #-} +{-# ANN rem# hasBlackBox #-} rem# (BV 0 i) (BV 0 j) = BV 0 (i `rem` j) rem# bv1 bv2 = undefErrorP "rem" bv1 bv2 {-# NOINLINE toInteger# #-} +{-# ANN toInteger# hasBlackBox #-} toInteger# :: KnownNat n => BitVector n -> Integer toInteger# (BV 0 i) = naturalToInteger i toInteger# bv = undefErrorU "toInteger" bv @@ -780,6 +839,7 @@ countTrailingZerosBV = V.foldl (\l r -> if eq## r low then 1 + l else 0) 0 . V.b {-# INLINE countTrailingZerosBV #-} {-# NOINLINE reduceAnd# #-} +{-# ANN reduceAnd# hasBlackBox #-} reduceAnd# :: KnownNat n => BitVector n -> Bit reduceAnd# bv@(BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check))) where @@ -790,6 +850,7 @@ reduceAnd# bv@(BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check))) reduceAnd# bv = V.foldl (.&.) 1 (V.bv2v bv) {-# NOINLINE reduceOr# #-} +{-# ANN reduceOr# hasBlackBox #-} reduceOr# :: KnownNat n => BitVector n -> Bit reduceOr# (BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check))) where @@ -797,6 +858,7 @@ reduceOr# (BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check))) reduceOr# bv = V.foldl (.|.) 0 (V.bv2v bv) {-# NOINLINE reduceXor# #-} +{-# ANN reduceXor# hasBlackBox #-} reduceXor# :: KnownNat n => BitVector n -> Bit reduceXor# (BV 0 i) = Bit 0 (fromIntegral (popCount i `mod` 2)) reduceXor# bv = undefErrorU "reduceXor" bv @@ -807,6 +869,7 @@ instance Default (BitVector n) where -- * Accessors -- ** Length information {-# NOINLINE size# #-} +{-# ANN size# hasBlackBox #-} size# :: KnownNat n => BitVector n -> Int #if MIN_VERSION_base(4,15,0) size# bv = fromIntegral (natVal bv) @@ -815,6 +878,7 @@ size# bv = fromInteger (natVal bv) #endif {-# NOINLINE maxIndex# #-} +{-# ANN maxIndex# hasBlackBox #-} maxIndex# :: KnownNat n => BitVector n -> Int #if MIN_VERSION_base(4,15,0) maxIndex# bv = fromIntegral (natVal bv) - 1 @@ -824,6 +888,7 @@ maxIndex# bv = fromInteger (natVal bv) - 1 -- ** Indexing {-# NOINLINE index# #-} +{-# ANN index# hasBlackBox #-} index# :: KnownNat n => BitVector n -> Int -> Bit index# bv@(BV m v) i | i >= 0 && i < sz = Bit (W# (int2Word# (dataToTag# (testBit m i)))) @@ -843,6 +908,7 @@ index# bv@(BV m v) i ] {-# NOINLINE msb# #-} +{-# ANN msb# hasBlackBox #-} -- | MSB msb# :: forall n . KnownNat n => BitVector n -> Bit msb# (BV m v) @@ -868,12 +934,14 @@ msb# (BV m v) #endif {-# NOINLINE lsb# #-} +{-# ANN lsb# hasBlackBox #-} -- | LSB lsb# :: BitVector n -> Bit lsb# (BV m v) = Bit (W# (int2Word# (dataToTag# (testBit m 0)))) (W# (int2Word# (dataToTag# (testBit v 0)))) {-# NOINLINE slice# #-} +{-# ANN slice# hasBlackBox #-} slice# :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n) slice# (BV msk i) m n = BV (shiftR (msk .&. mask) n') (shiftR (i .&. mask) n') @@ -887,6 +955,7 @@ slice# (BV msk i) m n = BV (shiftR (msk .&. mask) n') -- ** Concatenation {-# NOINLINE (++#) #-} +{-# ANN (++#) hasBlackBox #-} -- | Concatenate two 'BitVector's (++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m) (BV m1 v1) ++# bv2@(BV m2 v2) = BV (m1' .|. m2) (v1' .|. v2) @@ -903,6 +972,7 @@ slice# (BV msk i) m n = BV (shiftR (msk .&. mask) n') -- * Modifying BitVectors {-# NOINLINE replaceBit# #-} +{-# ANN replaceBit# hasBlackBox #-} replaceBit# :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n replaceBit# bv@(BV m v) i (Bit mb b) #if MIN_VERSION_base(4,15,0) @@ -926,6 +996,7 @@ replaceBit# bv@(BV m v) i (Bit mb b) ] {-# NOINLINE setSlice# #-} +{-# ANN setSlice# hasBlackBox #-} setSlice# :: forall m i n . SNat (m + 1 + i) @@ -947,6 +1018,7 @@ setSlice# SNat = complementN = complementMod (natVal (Proxy @(m + 1 + i))) {-# NOINLINE split# #-} +{-# ANN split# hasBlackBox #-} split# :: forall n m . KnownNat n @@ -972,6 +1044,7 @@ split# (BV m i) = and#, or#, xor# :: forall n . KnownNat n => BitVector n -> BitVector n -> BitVector n {-# NOINLINE and# #-} +{-# ANN and# hasBlackBox #-} and# = \(BV m1 v1) (BV m2 v2) -> let mask = (m1.&.v2 .|. m1.&.m2 .|. m2.&.v1) @@ -980,6 +1053,7 @@ and# = complementN = complementMod (natVal (Proxy @n)) {-# NOINLINE or# #-} +{-# ANN or# hasBlackBox #-} or# = \(BV m1 v1) (BV m2 v2) -> let mask = m1 .&. complementN v2 .|. m1.&.m2 .|. m2 .&. complementN v1 @@ -988,6 +1062,7 @@ or# = complementN = complementMod (natVal (Proxy @n)) {-# NOINLINE xor# #-} +{-# ANN xor# hasBlackBox #-} xor# = \(BV m1 v1) (BV m2 v2) -> let mask = m1 .|. m2 @@ -996,6 +1071,7 @@ xor# = complementN = complementMod (natVal (Proxy @n)) {-# NOINLINE complement# #-} +{-# ANN complement# hasBlackBox #-} complement# :: forall n . KnownNat n => BitVector n -> BitVector n complement# = \(BV m v) -> BV m (complementN v .&. complementN m) where complementN = complementMod (natVal (Proxy @n)) @@ -1004,6 +1080,7 @@ shiftL#, shiftR#, rotateL#, rotateR# :: forall n . KnownNat n => BitVector n -> Int -> BitVector n {-# NOINLINE shiftL# #-} +{-# ANN shiftL# hasBlackBox #-} shiftL# = \(BV msk v) i -> if | i < 0 -> error $ "'shiftL' undefined for negative number: " ++ show i @@ -1021,12 +1098,14 @@ shiftL# = \(BV msk v) i -> #endif {-# NOINLINE shiftR# #-} +{-# ANN shiftR# hasBlackBox #-} shiftR# (BV m v) i | i < 0 = error $ "'shiftR' undefined for negative number: " ++ show i | otherwise = BV (shiftR m i) (shiftR v i) {-# NOINLINE rotateL# #-} +{-# ANN rotateL# hasBlackBox #-} rotateL# = \(BV msk v) b -> if b >= 0 then @@ -1061,6 +1140,7 @@ rotateL# = #endif {-# NOINLINE rotateR# #-} +{-# ANN rotateR# hasBlackBox #-} rotateR# = \(BV msk v) b -> if b >= 0 then @@ -1116,6 +1196,7 @@ truncateB# = \(BV msk i) -> BV (msk `mod` m) (i `mod` m) where m = 1 `shiftL` fromInteger (natVal (Proxy @a)) #endif {-# NOINLINE truncateB# #-} +{-# ANN truncateB# hasBlackBox #-} instance KnownNat n => Lift (BitVector n) where lift bv@(BV m i) = sigE [| fromInteger# m $(litE (IntegerL (toInteger i))) |] (decBitVector (natVal bv)) @@ -1253,6 +1334,7 @@ checkUnpackUndef _ bv = res ty = typeOf res res = undefError (show ty ++ ".unpack") [bv] {-# NOINLINE checkUnpackUndef #-} +{-# ANN checkUnpackUndef hasBlackBox #-} -- | Create a BitVector with all its bits undefined undefined# :: forall n . KnownNat n => BitVector n @@ -1264,6 +1346,7 @@ undefined# = #endif in BV (m-1) 0 {-# NOINLINE undefined# #-} +{-# ANN undefined# hasBlackBox #-} -- | Check if one BitVector is similar to another, interpreting undefined bits -- in the second argument as being "don't care" bits. This is a more lenient diff --git a/clash-prelude/src/Clash/Sized/Internal/Index.hs b/clash-prelude/src/Clash/Sized/Internal/Index.hs index 34e9d2e3fa..e0c588da46 100644 --- a/clash-prelude/src/Clash/Sized/Internal/Index.hs +++ b/clash-prelude/src/Clash/Sized/Internal/Index.hs @@ -1,7 +1,7 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016-2019, Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -42,6 +42,9 @@ module Clash.Sized.Internal.Index , ge# , gt# , le# + -- ** Enum + , toEnum# + , fromEnum# -- ** Enum (not synthesizable) , enumFrom# , enumFromThen# @@ -98,6 +101,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), arbitraryBoundedIntegral, coarbitraryIntegral, shrinkIntegral) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack.Internal (BitPack (..), packXWith) import Clash.Class.Num (ExtendingNum (..), SaturatingNum (..), SaturationMode (..)) @@ -140,7 +144,7 @@ type role Index nominal -- *** Exception: X: Clash.Sized.Index: result 8 is out of bounds: [0..7] -- ... -- --- Index has the +-- Index has the -- -- >>> :i Index -- type role Index nominal @@ -161,6 +165,8 @@ newtype Index (n :: Nat) = #endif deriving (Data, Generic) +{-# ANN I hasBlackBox #-} + {-# NOINLINE size# #-} size# :: (KnownNat n, 1 <= n) => Index n -> Int size# = BV.size# . pack# @@ -181,10 +187,12 @@ fromSNat :: (KnownNat m, n + 1 <= m) => SNat n -> Index m fromSNat = snatToNum {-# NOINLINE pack# #-} +{-# ANN pack# hasBlackBox #-} pack# :: Index n -> BitVector (CLog 2 n) pack# (I i) = BV 0 (naturalFromInteger i) {-# NOINLINE unpack# #-} +{-# ANN unpack# hasBlackBox #-} unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n unpack# (BV 0 i) = fromInteger_INLINE (naturalToInteger i) unpack# bv = undefError "Index.unpack" [bv] @@ -194,10 +202,12 @@ instance Eq (Index n) where (/=) = neq# {-# NOINLINE eq# #-} +{-# ANN eq# hasBlackBox #-} eq# :: (Index n) -> (Index n) -> Bool (I n) `eq#` (I m) = n == m {-# NOINLINE neq# #-} +{-# ANN neq# hasBlackBox #-} neq# :: (Index n) -> (Index n) -> Bool (I n) `neq#` (I m) = n /= m @@ -209,12 +219,16 @@ instance Ord (Index n) where lt#,ge#,gt#,le# :: Index n -> Index n -> Bool {-# NOINLINE lt# #-} +{-# ANN lt# hasBlackBox #-} lt# (I n) (I m) = n < m {-# NOINLINE ge# #-} +{-# ANN ge# hasBlackBox #-} ge# (I n) (I m) = n >= m {-# NOINLINE gt# #-} +{-# ANN gt# hasBlackBox #-} gt# (I n) (I m) = n > m {-# NOINLINE le# #-} +{-# ANN le# hasBlackBox #-} le# (I n) (I m) = n <= m -- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and @@ -222,13 +236,23 @@ le# (I n) (I m) = n <= m instance KnownNat n => Enum (Index n) where succ = (+# fromInteger# 1) pred = (-# fromInteger# 1) - toEnum = fromInteger# . toInteger - fromEnum = fromEnum . toInteger# + toEnum = toEnum# + fromEnum = fromEnum# enumFrom = enumFrom# enumFromThen = enumFromThen# enumFromTo = enumFromTo# enumFromThenTo = enumFromThenTo# +toEnum# :: forall n. KnownNat n => Int -> Index n +toEnum# = fromInteger# . toInteger +{-# NOINLINE toEnum# #-} +{-# ANN toEnum# hasBlackBox #-} + +fromEnum# :: forall n. KnownNat n => Index n -> Int +fromEnum# = fromEnum . toInteger# +{-# NOINLINE fromEnum# #-} +{-# ANN fromEnum# hasBlackBox #-} + enumFrom# :: forall n. KnownNat n => Index n -> [Index n] enumFrom# x = [x .. maxBound] {-# NOINLINE enumFrom# #-} @@ -255,6 +279,7 @@ maxBound# = 0 -> errorX "maxBound of 'Index 0' is undefined" n -> fromInteger_INLINE (n - 1) {-# NOINLINE maxBound# #-} +{-# ANN maxBound# hasBlackBox #-} -- | Operators report an error on overflow and underflow instance KnownNat n => Num (Index n) where @@ -268,12 +293,15 @@ instance KnownNat n => Num (Index n) where (+#),(-#),(*#) :: KnownNat n => Index n -> Index n -> Index n {-# NOINLINE (+#) #-} +{-# ANN (+#) hasBlackBox #-} (+#) (I a) (I b) = fromInteger_INLINE $ a + b {-# NOINLINE (-#) #-} +{-# ANN (-#) hasBlackBox #-} (-#) (I a) (I b) = fromInteger_INLINE $ a - b {-# NOINLINE (*#) #-} +{-# ANN (*#) hasBlackBox #-} (*#) (I a) (I b) = fromInteger_INLINE $ a * b negate# :: KnownNat n => Index n -> Index n @@ -282,6 +310,7 @@ negate# i = maxBound -# i +# 1 fromInteger# :: KnownNat n => Integer -> Index n {-# NOINLINE fromInteger# #-} +{-# ANN fromInteger# hasBlackBox #-} fromInteger# = fromInteger_INLINE {-# INLINE fromInteger_INLINE #-} fromInteger_INLINE :: forall n . (HasCallStack, KnownNat n) => Integer -> Index n @@ -300,9 +329,11 @@ instance ExtendingNum (Index m) (Index n) where plus#, minus# :: Index m -> Index n -> Index (m + n - 1) {-# NOINLINE plus# #-} +{-# ANN plus# hasBlackBox #-} plus# (I a) (I b) = I (a + b) {-# NOINLINE minus# #-} +{-# ANN minus# hasBlackBox #-} minus# (I a) (I b) = let z = a - b err = error ("Clash.Sized.Index.minus: result " ++ show z ++ @@ -311,6 +342,7 @@ minus# (I a) (I b) = in res {-# NOINLINE times# #-} +{-# ANN times# hasBlackBox #-} times# :: Index m -> Index n -> Index (((m - 1) * (n - 1)) + 1) times# (I a) (I b) = I (a * b) @@ -416,11 +448,14 @@ instance KnownNat n => Integral (Index n) where quot#,rem# :: Index n -> Index n -> Index n {-# NOINLINE quot# #-} +{-# ANN quot# hasBlackBox #-} (I a) `quot#` (I b) = I (a `div` b) {-# NOINLINE rem# #-} +{-# ANN rem# hasBlackBox #-} (I a) `rem#` (I b) = I (a `rem` b) {-# NOINLINE toInteger# #-} +{-# ANN toInteger# hasBlackBox #-} toInteger# :: Index n -> Integer toInteger# (I n) = n @@ -464,6 +499,7 @@ instance Resize Index where resize# :: KnownNat m => Index n -> Index m resize# (I i) = fromInteger_INLINE i {-# NOINLINE resize# #-} +{-# ANN resize# hasBlackBox #-} instance KnownNat n => Lift (Index n) where lift u@(I i) = sigE [| fromInteger# i |] (decIndex (natVal u)) diff --git a/clash-prelude/src/Clash/Sized/Internal/Signed.hs b/clash-prelude/src/Clash/Sized/Internal/Signed.hs index 0b42d09e16..ac33aeb8db 100644 --- a/clash-prelude/src/Clash/Sized/Internal/Signed.hs +++ b/clash-prelude/src/Clash/Sized/Internal/Signed.hs @@ -1,7 +1,7 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -39,6 +39,9 @@ module Clash.Sized.Internal.Signed , ge# , gt# , le# + -- ** Enum + , toEnum# + , fromEnum# -- ** Enum (not synthesizable) , enumFrom# , enumFromThen# @@ -111,6 +114,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), arbitraryBoundedIntegral, coarbitraryIntegral, shrinkIntegral) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack (..), packXWith) import Clash.Class.Num (ExtendingNum (..), SaturatingNum (..), SaturationMode (..)) @@ -168,7 +172,7 @@ type role Signed nominal -- >>> satAdd SatSymmetric (-2) (-3) :: Signed 3 -- -3 -- --- Signed has the +-- Signed has the -- -- >>> :i Signed -- type role Signed nominal @@ -189,11 +193,14 @@ newtype Signed (n :: Nat) = #endif deriving (Data, Generic) +{-# ANN S hasBlackBox #-} + instance NFDataX (Signed n) where deepErrorX = errorX rnfX = rwhnfX {-# NOINLINE size# #-} +{-# ANN size# hasBlackBox #-} size# :: KnownNat n => Signed n -> Int size# bv = fromInteger (natVal bv) @@ -220,11 +227,13 @@ instance KnownNat n => BitPack (Signed n) where unpack = unpack# {-# NOINLINE pack# #-} +{-# ANN pack# hasBlackBox #-} pack# :: forall n . KnownNat n => Signed n -> BitVector n pack# (S i) = let m = 1 `shiftL0` fromInteger (natVal (Proxy @n)) in if i < 0 then BV 0 (naturalFromInteger (m + i)) else BV 0 (naturalFromInteger i) {-# NOINLINE unpack# #-} +{-# ANN unpack# hasBlackBox #-} unpack# :: forall n . KnownNat n => BitVector n -> Signed n unpack# (BV 0 i) = let m = 1 `shiftL0` fromInteger (natVal (Proxy @n) - 1) @@ -237,10 +246,12 @@ instance Eq (Signed n) where (/=) = neq# {-# NOINLINE eq# #-} +{-# ANN eq# hasBlackBox #-} eq# :: Signed n -> Signed n -> Bool eq# (S v1) (S v2) = v1 == v2 {-# NOINLINE neq# #-} +{-# ANN neq# hasBlackBox #-} neq# :: Signed n -> Signed n -> Bool neq# (S v1) (S v2) = v1 /= v2 @@ -252,12 +263,16 @@ instance Ord (Signed n) where lt#,ge#,gt#,le# :: Signed n -> Signed n -> Bool {-# NOINLINE lt# #-} +{-# ANN lt# hasBlackBox #-} lt# (S n) (S m) = n < m {-# NOINLINE ge# #-} +{-# ANN ge# hasBlackBox #-} ge# (S n) (S m) = n >= m {-# NOINLINE gt# #-} +{-# ANN gt# hasBlackBox #-} gt# (S n) (S m) = n > m {-# NOINLINE le# #-} +{-# ANN le# hasBlackBox #-} le# (S n) (S m) = n <= m -- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and @@ -279,13 +294,22 @@ instance KnownNat n => Enum (Signed n) where <> "need other behavior." | otherwise = n -# fromInteger# 1 - toEnum = fromInteger# . toInteger - fromEnum = fromEnum . toInteger# + toEnum = toEnum# + fromEnum = fromEnum# enumFrom = enumFrom# enumFromThen = enumFromThen# enumFromTo = enumFromTo# enumFromThenTo = enumFromThenTo# +toEnum# :: forall n. KnownNat n => Int -> Signed n +toEnum# = fromInteger# . toInteger +{-# NOINLINE toEnum# #-} +{-# ANN toEnum# hasBlackBox #-} + +fromEnum# :: forall n. KnownNat n => Signed n -> Int +fromEnum# = fromEnum . toInteger# +{-# NOINLINE fromEnum# #-} +{-# ANN fromEnum# hasBlackBox #-} enumFrom# :: forall n. KnownNat n => Signed n -> [Signed n] enumFrom# x = map (fromInteger_INLINE sz mB mask) [unsafeToInteger x .. unsafeToInteger (maxBound :: Signed n)] @@ -330,6 +354,7 @@ minBound# = 0 -> 0 n -> S (negate $ 2 ^ (n - 1)) {-# NOINLINE minBound# #-} +{-# ANN minBound# hasBlackBox #-} maxBound# :: forall n. KnownNat n => Signed n maxBound# = @@ -337,6 +362,7 @@ maxBound# = 0 -> 0 n -> S (2 ^ (n - 1) - 1) {-# NOINLINE maxBound# #-} +{-# ANN maxBound# hasBlackBox #-} -- | Operators do @wrap-around@ on overflow instance KnownNat n => Num (Signed n) where @@ -351,6 +377,7 @@ instance KnownNat n => Num (Signed n) where (+#), (-#), (*#) :: forall n . KnownNat n => Signed n -> Signed n -> Signed n {-# NOINLINE (+#) #-} +{-# ANN (+#) hasBlackBox #-} (+#) = \(S a) (S b) -> let z = a + b @@ -364,6 +391,7 @@ instance KnownNat n => Num (Signed n) where m = 1 `shiftL0` fromInteger (natVal (Proxy @n) -1) {-# NOINLINE (-#) #-} +{-# ANN (-#) hasBlackBox #-} (-#) = \(S a) (S b) -> let z = a - b @@ -377,6 +405,7 @@ instance KnownNat n => Num (Signed n) where m = 1 `shiftL0` fromInteger (natVal (Proxy @n) -1) {-# NOINLINE (*#) #-} +{-# ANN (*#) hasBlackBox #-} (*#) = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a * b) where sz = fromInteger (natVal (Proxy @n)) - 1 mB = 1 `shiftL` sz @@ -384,6 +413,7 @@ instance KnownNat n => Num (Signed n) where negate#,abs# :: forall n . KnownNat n => Signed n -> Signed n {-# NOINLINE negate# #-} +{-# ANN negate# hasBlackBox #-} negate# = \(S n) -> let z = negate n @@ -392,6 +422,7 @@ negate# = m = 1 `shiftL0` fromInteger (natVal (Proxy @n) -1) {-# NOINLINE abs# #-} +{-# ANN abs# hasBlackBox #-} abs# = \(S n) -> let z = abs n @@ -400,6 +431,7 @@ abs# = m = 1 `shiftL0` fromInteger (natVal (Proxy @n) -1) {-# NOINLINE fromInteger# #-} +{-# ANN fromInteger# hasBlackBox #-} fromInteger# :: forall n . KnownNat n => Integer -> Signed (n :: Nat) fromInteger# = fromInteger_INLINE sz mB mask where sz = fromInteger (natVal (Proxy @n)) - 1 @@ -424,12 +456,15 @@ instance ExtendingNum (Signed m) (Signed n) where plus#, minus# :: Signed m -> Signed n -> Signed (Max m n + 1) {-# NOINLINE plus# #-} +{-# ANN plus# hasBlackBox #-} plus# (S a) (S b) = S (a + b) {-# NOINLINE minus# #-} +{-# ANN minus# hasBlackBox #-} minus# (S a) (S b) = S (a - b) {-# NOINLINE times# #-} +{-# ANN times# hasBlackBox #-} times# :: Signed m -> Signed n -> Signed (m + n) times# (S a) (S b) = S (a * b) @@ -446,6 +481,7 @@ instance KnownNat n => Integral (Signed n) where toInteger = toInteger# {-# NOINLINE quot# #-} +{-# ANN quot# hasBlackBox #-} quot# :: forall n. KnownNat n => Signed n -> Signed n -> Signed n quot# (S a) (S b) | a == minB && b == (-1) = S minB @@ -454,10 +490,12 @@ quot# (S a) (S b) S minB = minBound @(Signed n) {-# NOINLINE rem# #-} +{-# ANN rem# hasBlackBox #-} rem# :: Signed n -> Signed n -> Signed n rem# (S a) (S b) = S (a `rem` b) {-# NOINLINE div# #-} +{-# ANN div# hasBlackBox #-} div# :: forall n. KnownNat n => Signed n -> Signed n -> Signed n div# (S a) (S b) | a == minB && b == (-1) = S minB @@ -466,10 +504,12 @@ div# (S a) (S b) S minB = minBound @(Signed n) {-# NOINLINE mod# #-} +{-# ANN mod# hasBlackBox #-} mod# :: Signed n -> Signed n -> Signed n mod# (S a) (S b) = S (a `mod` b) {-# NOINLINE toInteger# #-} +{-# ANN toInteger# hasBlackBox #-} toInteger# :: Signed n -> Integer toInteger# (S n) = n @@ -502,24 +542,28 @@ instance KnownNat n => Bits (Signed n) where and#,or#,xor# :: forall n . KnownNat n => Signed n -> Signed n -> Signed n {-# NOINLINE and# #-} +{-# ANN and# hasBlackBox #-} and# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a .&. b) where sz = fromInteger (natVal (Proxy @n)) - 1 mB = 1 `shiftL` sz mask = mB - 1 {-# NOINLINE or# #-} +{-# ANN or# hasBlackBox #-} or# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a .|. b) where sz = fromInteger (natVal (Proxy @n)) - 1 mB = 1 `shiftL` sz mask = mB - 1 {-# NOINLINE xor# #-} +{-# ANN xor# hasBlackBox #-} xor# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (xor a b) where sz = fromInteger (natVal (Proxy @n)) - 1 mB = 1 `shiftL` sz mask = mB - 1 {-# NOINLINE complement# #-} +{-# ANN complement# hasBlackBox #-} complement# :: forall n . KnownNat n => Signed n -> Signed n complement# = \(S a) -> fromInteger_INLINE sz mB mask (complement a) where sz = fromInteger (natVal (Proxy @n)) - 1 @@ -528,6 +572,7 @@ complement# = \(S a) -> fromInteger_INLINE sz mB mask (complement a) shiftL#,shiftR#,rotateL#,rotateR# :: forall n . KnownNat n => Signed n -> Int -> Signed n {-# NOINLINE shiftL# #-} +{-# ANN shiftL# hasBlackBox #-} shiftL# = \(S n) b -> if | b < 0 -> error $ "'shiftL' undefined for negative number: " ++ show b | b > sz -> S 0 @@ -538,6 +583,7 @@ shiftL# = \(S n) b -> mask = mB - 1 {-# NOINLINE shiftR# #-} +{-# ANN shiftR# hasBlackBox #-} shiftR# = \(S n) b -> if b >= 0 then @@ -550,6 +596,7 @@ shiftR# = mask = mB - 1 {-# NOINLINE rotateL# #-} +{-# ANN rotateL# hasBlackBox #-} rotateL# = \(S n) b -> if b >= 0 then @@ -569,6 +616,7 @@ rotateL# = maskM = mB - 1 {-# NOINLINE rotateR# #-} +{-# ANN rotateR# hasBlackBox #-} rotateR# = \(S n) b -> if b >= 0 then @@ -598,6 +646,7 @@ instance Resize Signed where truncateB = truncateB# {-# NOINLINE resize# #-} +{-# ANN resize# hasBlackBox #-} resize# :: forall m n . (KnownNat n, KnownNat m) => Signed n -> Signed m resize# s@(S i) | natToNatural @m == 0 = S 0 @@ -616,6 +665,7 @@ resize# s@(S i) else S i' {-# NOINLINE truncateB# #-} +{-# ANN truncateB# hasBlackBox #-} truncateB# :: forall m n . KnownNat m => Signed (m + n) -> Signed m truncateB# = \(S n) -> fromInteger_INLINE sz mB mask n where sz = fromInteger (natVal (Proxy @m)) - 1 diff --git a/clash-prelude/src/Clash/Sized/Internal/Unsigned.hs b/clash-prelude/src/Clash/Sized/Internal/Unsigned.hs index 7d379d8444..a916707a8a 100644 --- a/clash-prelude/src/Clash/Sized/Internal/Unsigned.hs +++ b/clash-prelude/src/Clash/Sized/Internal/Unsigned.hs @@ -1,7 +1,7 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016 , Myrtle Software Ltd, - 2021 , QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -38,6 +38,9 @@ module Clash.Sized.Internal.Unsigned , ge# , gt# , le# + -- ** Enum + , toEnum# + , fromEnum# -- ** Enum (not synthesizable) , enumFrom# , enumFromThen# @@ -125,6 +128,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), arbitraryBoundedIntegral, coarbitraryIntegral) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack (..), packXWith, bitCoerce) import Clash.Class.Num (ExtendingNum (..), SaturatingNum (..), SaturationMode (..)) @@ -180,7 +184,7 @@ type role Unsigned nominal -- >>> satSub SatSymmetric 2 3 :: Unsigned 3 -- 0 -- --- Unsigned has the +-- Unsigned has the -- -- >>> :i Unsigned -- type role Unsigned nominal @@ -201,7 +205,10 @@ newtype Unsigned (n :: Nat) = #endif deriving (Data, Generic) +{-# ANN U hasBlackBox #-} + {-# NOINLINE size# #-} +{-# ANN size# hasBlackBox #-} size# :: KnownNat n => Unsigned n -> Int #if MIN_VERSION_base(4,15,0) size# u = fromIntegral (natVal u) @@ -236,10 +243,12 @@ instance KnownNat n => BitPack (Unsigned n) where unpack = unpack# {-# NOINLINE pack# #-} +{-# ANN pack# hasBlackBox #-} pack# :: Unsigned n -> BitVector n pack# (U i) = BV 0 i {-# NOINLINE unpack# #-} +{-# ANN unpack# hasBlackBox #-} unpack# :: KnownNat n => BitVector n -> Unsigned n unpack# (BV 0 i) = U i unpack# bv = undefError "Unsigned.unpack" [bv] @@ -249,10 +258,12 @@ instance Eq (Unsigned n) where (/=) = neq# {-# NOINLINE eq# #-} +{-# ANN eq# hasBlackBox #-} eq# :: Unsigned n -> Unsigned n -> Bool eq# (U v1) (U v2) = v1 == v2 {-# NOINLINE neq# #-} +{-# ANN neq# hasBlackBox #-} neq# :: Unsigned n -> Unsigned n -> Bool neq# (U v1) (U v2) = v1 /= v2 @@ -264,12 +275,16 @@ instance Ord (Unsigned n) where lt#,ge#,gt#,le# :: Unsigned n -> Unsigned n -> Bool {-# NOINLINE lt# #-} +{-# ANN lt# hasBlackBox #-} lt# (U n) (U m) = n < m {-# NOINLINE ge# #-} +{-# ANN ge# hasBlackBox #-} ge# (U n) (U m) = n >= m {-# NOINLINE gt# #-} +{-# ANN gt# hasBlackBox #-} gt# (U n) (U m) = n > m {-# NOINLINE le# #-} +{-# ANN le# hasBlackBox #-} le# (U n) (U m) = n <= m -- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and @@ -291,13 +306,23 @@ instance KnownNat n => Enum (Unsigned n) where <> "need other behavior." | otherwise = n -# fromInteger# 1 - toEnum = fromInteger# . toInteger - fromEnum = fromEnum . toInteger# + toEnum = toEnum# + fromEnum = fromEnum# enumFrom = enumFrom# enumFromThen = enumFromThen# enumFromTo = enumFromTo# enumFromThenTo = enumFromThenTo# +toEnum# :: forall n. KnownNat n => Int -> Unsigned n +toEnum# = fromInteger# . toInteger +{-# NOINLINE toEnum# #-} +{-# ANN toEnum# hasBlackBox #-} + +fromEnum# :: forall n. KnownNat n => Unsigned n -> Int +fromEnum# = fromEnum . toInteger# +{-# NOINLINE fromEnum# #-} +{-# ANN fromEnum# hasBlackBox #-} + enumFrom# :: forall n. KnownNat n => Unsigned n -> [Unsigned n] enumFrom# = \x -> map (U . (`mod` m)) [unsafeToNatural x .. unsafeToNatural (maxBound :: Unsigned n)] #if MIN_VERSION_base(4,15,0) @@ -344,10 +369,12 @@ instance KnownNat n => Bounded (Unsigned n) where minBound# :: Unsigned n minBound# = U 0 {-# NOINLINE minBound# #-} +{-# ANN minBound# hasBlackBox #-} maxBound# :: forall n. KnownNat n => Unsigned n maxBound# = let m = 1 `shiftL` (natToNum @n) in U (m - 1) {-# NOINLINE maxBound# #-} +{-# ANN maxBound# hasBlackBox #-} instance KnownNat n => Num (Unsigned n) where (+) = (+#) @@ -360,6 +387,7 @@ instance KnownNat n => Num (Unsigned n) where (+#),(-#),(*#) :: forall n . KnownNat n => Unsigned n -> Unsigned n -> Unsigned n {-# NOINLINE (+#) #-} +{-# ANN (+#) hasBlackBox #-} (+#) = \(U i) (U j) -> U (addMod m i j) #if MIN_VERSION_base(4,15,0) where m = 1 `naturalShiftL` naturalToWord (natVal (Proxy @n)) @@ -368,6 +396,7 @@ instance KnownNat n => Num (Unsigned n) where #endif {-# NOINLINE (-#) #-} +{-# ANN (-#) hasBlackBox #-} (-#) = \(U i) (U j) -> U (subMod m i j) #if MIN_VERSION_base(4,15,0) where m = 1 `naturalShiftL` naturalToWord (natVal (Proxy @n)) @@ -376,6 +405,7 @@ instance KnownNat n => Num (Unsigned n) where #endif {-# NOINLINE (*#) #-} +{-# ANN (*#) hasBlackBox #-} (*#) = \(U i) (U j) -> U (mulMod2 m i j) #if MIN_VERSION_base(4,15,0) where m = (1 `naturalShiftL` naturalToWord (natVal (Proxy @n))) - 1 @@ -384,6 +414,7 @@ instance KnownNat n => Num (Unsigned n) where #endif {-# NOINLINE negate# #-} +{-# ANN negate# hasBlackBox #-} negate# :: forall n . KnownNat n => Unsigned n -> Unsigned n negate# = \(U i) -> U (negateMod m i) #if MIN_VERSION_base(4,15,0) @@ -393,6 +424,7 @@ negate# = \(U i) -> U (negateMod m i) #endif {-# NOINLINE fromInteger# #-} +{-# ANN fromInteger# hasBlackBox #-} fromInteger# :: forall n . KnownNat n => Integer -> Unsigned n #if MIN_VERSION_base(4,15,0) fromInteger# = \x -> U (integerToNatural (x `mod` m)) @@ -412,10 +444,12 @@ instance (KnownNat m, KnownNat n) => ExtendingNum (Unsigned m) (Unsigned n) wher mul = times# {-# NOINLINE plus# #-} +{-# ANN plus# hasBlackBox #-} plus# :: Unsigned m -> Unsigned n -> Unsigned (Max m n + 1) plus# (U a) (U b) = U (a + b) {-# NOINLINE minus# #-} +{-# ANN minus# hasBlackBox #-} minus# :: forall m n . (KnownNat m, KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (Max m n + 1) minus# = \(U a) (U b) -> U (subMod mask a b) @@ -429,6 +463,7 @@ minus# = \(U a) (U b) -> U (subMod mask a b) #endif {-# NOINLINE times# #-} +{-# ANN times# hasBlackBox #-} times# :: Unsigned m -> Unsigned n -> Unsigned (m + n) times# (U a) (U b) = U (a * b) @@ -446,11 +481,14 @@ instance KnownNat n => Integral (Unsigned n) where quot#,rem# :: Unsigned n -> Unsigned n -> Unsigned n {-# NOINLINE quot# #-} +{-# ANN quot# hasBlackBox #-} quot# (U i) (U j) = U (i `quot` j) {-# NOINLINE rem# #-} +{-# ANN rem# hasBlackBox #-} rem# (U i) (U j) = U (i `rem` j) {-# NOINLINE toInteger# #-} +{-# ANN toInteger# hasBlackBox #-} toInteger# :: Unsigned n -> Integer toInteger# (U i) = naturalToInteger i @@ -482,24 +520,29 @@ instance KnownNat n => Bits (Unsigned n) where popCount u = popCount (pack# u) {-# NOINLINE and# #-} +{-# ANN and# hasBlackBox #-} and# :: Unsigned n -> Unsigned n -> Unsigned n and# (U v1) (U v2) = U (v1 .&. v2) {-# NOINLINE or# #-} +{-# ANN or# hasBlackBox #-} or# :: Unsigned n -> Unsigned n -> Unsigned n or# (U v1) (U v2) = U (v1 .|. v2) {-# NOINLINE xor# #-} +{-# ANN xor# hasBlackBox #-} xor# :: Unsigned n -> Unsigned n -> Unsigned n xor# (U v1) (U v2) = U (v1 `xor` v2) {-# NOINLINE complement# #-} +{-# ANN complement# hasBlackBox #-} complement# :: forall n . KnownNat n => Unsigned n -> Unsigned n complement# = \(U i) -> U (complementN i) where complementN = complementMod (natVal (Proxy @n)) shiftL#, shiftR#, rotateL#, rotateR# :: forall n .KnownNat n => Unsigned n -> Int -> Unsigned n {-# NOINLINE shiftL# #-} +{-# ANN shiftL# hasBlackBox #-} shiftL# = \(U v) i -> #if MIN_VERSION_base(4,15,0) let i' = fromIntegral i in @@ -519,6 +562,7 @@ shiftL# = \(U v) i -> #endif {-# NOINLINE shiftR# #-} +{-# ANN shiftR# hasBlackBox #-} -- shiftR# doesn't need the KnownNat constraint -- But having the same type signature for all shift and rotate functions -- makes implementing the Evaluator easier. @@ -528,6 +572,7 @@ shiftR# (U v) i | otherwise = U (shiftR v i) {-# NOINLINE rotateL# #-} +{-# ANN rotateL# hasBlackBox #-} rotateL# = \(U n) b -> if b >= 0 then @@ -554,6 +599,7 @@ rotateL# = #endif {-# NOINLINE rotateR# #-} +{-# ANN rotateR# hasBlackBox #-} rotateR# = \(U n) b -> if b >= 0 then @@ -591,6 +637,7 @@ instance Resize Unsigned where truncateB = resize# {-# NOINLINE resize# #-} +{-# ANN resize# hasBlackBox #-} resize# :: forall n m . KnownNat m => Unsigned n -> Unsigned m resize# = \(U i) -> if i >= m then U (i `mod` m) else U i #if MIN_VERSION_base(4,15,0) @@ -709,6 +756,7 @@ unsignedToWord (U (NatS# u#)) = W# u# unsignedToWord (U (NatJ# u#)) = W# (bigNatToWord u#) #endif {-# NOINLINE unsignedToWord #-} +{-# ANN unsignedToWord hasBlackBox #-} unsigned8toWord8 :: Unsigned 8 -> Word8 #if MIN_VERSION_base(4,15,0) @@ -719,6 +767,7 @@ unsigned8toWord8 (U (NatS# u#)) = W8# (narrow8Word# u#) unsigned8toWord8 (U (NatJ# u#)) = W8# (narrow8Word# (bigNatToWord u#)) #endif {-# NOINLINE unsigned8toWord8 #-} +{-# ANN unsigned8toWord8 hasBlackBox #-} unsigned16toWord16 :: Unsigned 16 -> Word16 #if MIN_VERSION_base(4,15,0) @@ -729,6 +778,7 @@ unsigned16toWord16 (U (NatS# u#)) = W16# (narrow16Word# u#) unsigned16toWord16 (U (NatJ# u#)) = W16# (narrow16Word# (bigNatToWord u#)) #endif {-# NOINLINE unsigned16toWord16 #-} +{-# ANN unsigned16toWord16 hasBlackBox #-} unsigned32toWord32 :: Unsigned 32 -> Word32 #if MIN_VERSION_base(4,15,0) @@ -739,6 +789,7 @@ unsigned32toWord32 (U (NatS# u#)) = W32# (narrow32Word# u#) unsigned32toWord32 (U (NatJ# u#)) = W32# (narrow32Word# (bigNatToWord u#)) #endif {-# NOINLINE unsigned32toWord32 #-} +{-# ANN unsigned32toWord32 hasBlackBox #-} {-# RULES "bitCoerce/Unsigned WORD_SIZE_IN_BITS -> Word" bitCoerce = unsignedToWord diff --git a/clash-prelude/src/Clash/Sized/RTree.hs b/clash-prelude/src/Clash/Sized/RTree.hs index 433ea01b41..3326093e98 100644 --- a/clash-prelude/src/Clash/Sized/RTree.hs +++ b/clash-prelude/src/Clash/Sized/RTree.hs @@ -1,7 +1,8 @@ {-| Copyright : (C) 2016, University of Twente + 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} @@ -65,6 +66,7 @@ import Language.Haskell.TH.Compat import Prelude hiding ((++), (!!)) import Test.QuickCheck (Arbitrary (..), CoArbitrary (..)) +import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack (..), packXWith) import Clash.Promoted.Nat (SNat (..), UNat (..), pow2SNat, snatToNum, subSNat, toUNat) @@ -114,11 +116,13 @@ textract :: RTree 0 a -> a textract (LR_ x) = x textract (BR_ _ _) = error $ "textract: nodes hold no values" {-# NOINLINE textract #-} +{-# ANN textract hasBlackBox #-} tsplit :: RTree (d+1) a -> (RTree d a,RTree d a) tsplit (BR_ l r) = (l,r) tsplit (LR_ _) = error $ "tsplit: leaf is atomic" {-# NOINLINE tsplit #-} +{-# ANN tsplit hasBlackBox #-} -- | Leaf of a perfect depth tree -- @@ -370,6 +374,7 @@ tdfold _ f g = go SNat go sn (BR_ l r) = let sn' = sn `subSNat` d1 in g sn' (go sn' l) (go sn' r) {-# NOINLINE tdfold #-} +{-# ANN tdfold hasBlackBox #-} data TfoldTree (a :: Type) (f :: TyFun Nat Type) :: Type type instance Apply (TfoldTree a) d = a @@ -398,6 +403,7 @@ treplicate sn a = go (toUNat sn) go UZero = LR a go (USucc un) = BR (go un) (go un) {-# NOINLINE treplicate #-} +{-# ANN treplicate hasBlackBox #-} -- | \"'trepeat' @a@\" creates a tree with as many copies of /a/ as demanded by -- the context. diff --git a/clash-prelude/src/Clash/Sized/Vector.hs b/clash-prelude/src/Clash/Sized/Vector.hs index d1b8ba0136..af8bbb11f1 100644 --- a/clash-prelude/src/Clash/Sized/Vector.hs +++ b/clash-prelude/src/Clash/Sized/Vector.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2017 , Myrtle Software Ltd + 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} @@ -135,7 +136,7 @@ import Test.QuickCheck import Unsafe.Coerce (unsafeCoerce) import Clash.Annotations.Primitive - (Primitive(InlinePrimitive), HDL(..), dontTranslate) + (Primitive(InlinePrimitive), HDL(..), dontTranslate, hasBlackBox) import Clash.Promoted.Nat (SNat (..), SNatLE (..), UNat (..), compareSNat, leToPlus, pow2SNat, snatProxy, snatToInteger, subSNat, withSNat, toUNat, natToInteger) @@ -334,6 +335,7 @@ instance (KnownNat n, 1 <= n) => Traversable (Vec n) where traverse = traverse# {-# NOINLINE traverse# #-} +{-# ANN traverse# hasBlackBox #-} traverse# :: forall a f b n . Applicative f => (a -> f b) -> Vec n a -> f (Vec n b) traverse# _ Nil = pure Nil traverse# f (x `Cons` xs) = Cons <$> f x <*> traverse# f xs @@ -368,6 +370,7 @@ singleton :: a -> Vec 1 a singleton = (`Cons` Nil) {-# NOINLINE head #-} +{-# ANN head hasBlackBox #-} {- | Extract the first element of a vector >>> head (1:>2:>3:>Nil) @@ -401,6 +404,7 @@ head :: Vec (n + 1) a -> a head (x `Cons` _) = x {-# NOINLINE tail #-} +{-# ANN tail hasBlackBox #-} {- | Extract the elements after the head of a vector >>> tail (1:>2:>3:>Nil) @@ -434,6 +438,7 @@ tail :: Vec (n + 1) a -> Vec n a tail (_ `Cons` xs) = xs {-# NOINLINE last #-} +{-# ANN last hasBlackBox #-} {- | Extract the last element of a vector >>> last (1:>2:>3:>Nil) @@ -468,6 +473,7 @@ last (x `Cons` Nil) = x last (_ `Cons` y `Cons` ys) = last (y `Cons` ys) {-# NOINLINE init #-} +{-# ANN init hasBlackBox #-} {- | Extract all the elements of a vector except the last element >>> init (1:>2:>3:>Nil) @@ -635,6 +641,7 @@ infixr 5 ++ Nil ++ ys = ys (x `Cons` xs) ++ ys = x `Cons` xs ++ ys {-# NOINLINE (++) #-} +{-# ANN (++) hasBlackBox #-} -- | Split a vector into two vectors at the given point. -- @@ -645,6 +652,7 @@ Nil ++ ys = ys splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a) splitAt n xs = splitAtU (toUNat n) xs {-# NOINLINE splitAt #-} +{-# ANN splitAt hasBlackBox #-} splitAtU :: UNat m -> Vec (m + n) a -> (Vec m a, Vec n a) splitAtU UZero ys = (Nil,ys) @@ -668,6 +676,7 @@ concat :: Vec n (Vec m a) -> Vec (n * m) a concat Nil = Nil concat (x `Cons` xs) = x ++ concat xs {-# NOINLINE concat #-} +{-# ANN concat hasBlackBox #-} -- | Map a function over all the elements of a vector and concatentate the resulting vectors. -- @@ -685,6 +694,7 @@ concatMap f xs = concat (map f xs) unconcat :: KnownNat n => SNat m -> Vec (n * m) a -> Vec n (Vec m a) unconcat n xs = unconcatU (withSNat toUNat) (toUNat n) xs {-# NOINLINE unconcat #-} +{-# ANN unconcat hasBlackBox #-} unconcatU :: UNat n -> UNat m -> Vec (n * m) a -> Vec n (Vec m a) unconcatU UZero _ _ = Nil @@ -716,6 +726,7 @@ reverse :: Vec n a -> Vec n a reverse Nil = Nil reverse (x `Cons` xs) = reverse xs :< x {-# NOINLINE reverse #-} +{-# ANN reverse hasBlackBox #-} -- | \"'map' @f xs@\" is the vector obtained by applying /f/ to each element -- of /xs/, i.e., @@ -729,6 +740,7 @@ map :: (a -> b) -> Vec n a -> Vec n b map _ Nil = Nil map f (x `Cons` xs) = f x `Cons` map f xs {-# NOINLINE map #-} +{-# ANN map hasBlackBox #-} -- | Apply a function of every element of a vector and its index. -- @@ -746,10 +758,12 @@ map f (x `Cons` xs) = f x `Cons` map f xs imap :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b imap f = go 0 where + -- NOTE This has a black box called imap_go go :: Index n -> Vec m a -> Vec m b go _ Nil = Nil go n (x `Cons` xs) = f n x `Cons` go (n+1) xs {-# NOINLINE imap #-} +{-# ANN imap hasBlackBox #-} {- | Zip two vectors with a functions that also takes the elements' indices. @@ -870,6 +884,7 @@ zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c zipWith _ Nil _ = Nil zipWith f (x `Cons` xs) ys = f x (head ys) `Cons` zipWith f xs (tail ys) {-# NOINLINE zipWith #-} +{-# ANN zipWith hasBlackBox #-} -- | 'zipWith3' generalizes 'zip3' by zipping with the function given -- as the first argument, instead of a tupling function. @@ -979,6 +994,7 @@ foldr :: (a -> b -> b) -> b -> Vec n a -> b foldr _ z Nil = z foldr f z (x `Cons` xs) = f x (foldr f z xs) {-# NOINLINE foldr #-} +{-# ANN foldr hasBlackBox #-} -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a vector, reduces the vector @@ -1328,6 +1344,7 @@ index_int xs i@(I# n0) then y else sub ys (n -# 1#) {-# NOINLINE index_int #-} +{-# ANN index_int hasBlackBox #-} -- | \"@xs@ '!!' @n@\" returns the /n/'th element of /xs/. -- @@ -1354,6 +1371,7 @@ xs !! i = index_int xs (fromEnum i) length :: KnownNat n => Vec n a -> Int length = fromInteger . natVal . asNatProxy {-# NOINLINE length #-} +{-# ANN length hasBlackBox #-} replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a replace_int xs i@(I# n0) a @@ -1370,6 +1388,7 @@ replace_int xs i@(I# n0) a then b `Cons` ys else y `Cons` sub ys (n -# 1#) b {-# NOINLINE replace_int #-} +{-# ANN replace_int hasBlackBox #-} -- | \"'replace' @n a xs@\" returns the vector /xs/ where the /n/'th element is -- replaced by /a/. @@ -1495,6 +1514,7 @@ select f s n xs = select' (toUNat n) $ drop f xs select' (USucc n') vs@(x `Cons` _) = x `Cons` select' n' (drop s (unsafeCoerce vs)) {-# NOINLINE select #-} +{-# ANN select hasBlackBox #-} -- | \"'selectI' @f s xs@\" selects as many elements as demanded by the context -- with step-size /s/ and offset /f/ from /xs/. @@ -1518,6 +1538,7 @@ selectI f s xs = withSNat (\n -> select f s n xs) replicate :: SNat n -> a -> Vec n a replicate n a = replicateU (toUNat n) a {-# NOINLINE replicate #-} +{-# ANN replicate hasBlackBox #-} replicateU :: UNat n -> a -> Vec n a replicateU UZero _ = Nil @@ -1642,6 +1663,7 @@ generateI f a = iterateI f (f a) transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a) transpose = traverse# id {-# NOINLINE transpose #-} +{-# ANN transpose hasBlackBox #-} -- | 1-dimensional stencil computations -- @@ -1882,6 +1904,7 @@ rotateLeftS xs d = go (snatToInteger d `mod` natVal (asNatProxy xs)) xs go 0 ys = ys go n (y `Cons` ys) = go (n-1) (ys :< y) {-# NOINLINE rotateLeftS #-} +{-# ANN rotateLeftS hasBlackBox #-} -- | /Statically/ rotate a 'Vec'tor to the right: -- @@ -1900,11 +1923,14 @@ rotateRightS xs d = go (snatToInteger d `mod` natVal (asNatProxy xs)) xs go 0 ys = ys go n ys@(Cons _ _) = go (n-1) (last ys :> init ys) {-# NOINLINE rotateRightS #-} +{-# ANN rotateRightS hasBlackBox #-} -- | Convert a vector to a list. -- -- >>> toList (1:>2:>3:>Nil) -- [1,2,3] +-- +-- __NB:__ this function is not synthesizable toList :: Vec n a -> [a] toList = foldr (:) [] {-# INLINE toList #-} @@ -1921,8 +1947,8 @@ toList = foldr (:) [] -- >>> Vec.fromList [1,2,3,4,5] :: Maybe (Vec 10 Int) -- Nothing -- --- __NB:__ use `listToVecTH` if you want to make a /statically known/ vector --- __NB:__ this function is not synthesizable +-- * __NB:__ use `listToVecTH` if you want to make a /statically known/ vector +-- * __NB:__ this function is not synthesizable -- fromList :: forall n a. (KnownNat n) => [a] -> Maybe (Vec n a) fromList xs @@ -1949,8 +1975,8 @@ fromList xs -- 1 :> 2 :> 3 :> 4 :> 5 :> *** Exception: Clash.Sized.Vector.unsafeFromList: vector larger than list -- ... -- --- __NB:__ use `listToVecTH` if you want to make a /statically known/ vector --- __NB:__ this function is not synthesizable +-- * __NB:__ use `listToVecTH` if you want to make a /statically known/ vector +-- * __NB:__ this function is not synthesizable -- unsafeFromList :: forall n a. (KnownNat n) => [a] -> Vec n a unsafeFromList = unfoldr SNat go @@ -2062,6 +2088,7 @@ lazyV = lazyV' (repeat ()) lazyV' Nil _ = Nil lazyV' (_ `Cons` xs) ys = head ys `Cons` lazyV' xs (tail ys) {-# NOINLINE lazyV #-} +{-# ANN lazyV hasBlackBox #-} -- | A /dependently/ typed fold. -- @@ -2165,6 +2192,7 @@ dfold _ f z xs = go (snatProxy (asNatProxy xs)) xs let s' = s `subSNat` d1 in f s' y (go s' ys) {-# NOINLINE dfold #-} +{-# ANN dfold hasBlackBox #-} {- | A combination of 'dfold' and 'fold': a /dependently/ typed fold that reduces a vector in a tree-like structure. @@ -2327,6 +2355,7 @@ dtfold _ f g = go (SNat :: SNat k) (xsL,xsR) = splitAt (pow2SNat sn') xs in g sn' (go sn' xsL) (go sn' xsR) {-# NOINLINE dtfold #-} +{-# ANN dtfold hasBlackBox #-} -- | To be used as the motive /p/ for 'dfold', when the /f/ in \"'dfold' @p f@\" -- is a variation on (':>'), e.g.: @@ -2403,6 +2432,7 @@ concatBitVector# = go 0 let sh = fromInteger (natVal (Proxy @m)) :: Int in go (BV (shiftL accMsk sh .|. xMsk) (shiftL accVal sh .|. xVal)) xs {-# NOINLINE concatBitVector# #-} +{-# ANN concatBitVector# hasBlackBox #-} unconcatBitVector# :: forall n m @@ -2418,6 +2448,7 @@ unconcatBitVector# orig = snd (go (toUNat (SNat @n))) (l,x) = (GHC.Magic.noinline split#) bv in (l,x :> xs) {-# NOINLINE unconcatBitVector# #-} +{-# ANN unconcatBitVector# hasBlackBox #-} -- | Convert a 'BitVector' to a 'Vec' of 'Bit's. -- @@ -2449,6 +2480,7 @@ seqV v b = let s () e = seq e () in foldl s () v `seq` b {-# NOINLINE seqV #-} +{-# ANN seqV hasBlackBox #-} infixr 0 `seqV` -- | Evaluate all elements of a vector to WHNF @@ -2471,6 +2503,7 @@ seqVX v b = let s () e = seqX e () in foldl s () v `seqX` b {-# NOINLINE seqVX #-} +{-# ANN seqVX hasBlackBox #-} infixr 0 `seqVX` -- | Evaluate all elements of a vector to WHNF. Does not propagate diff --git a/clash-prelude/src/Clash/XException.hs b/clash-prelude/src/Clash/XException.hs index 983c1f9835..f1166721ff 100644 --- a/clash-prelude/src/Clash/XException.hs +++ b/clash-prelude/src/Clash/XException.hs @@ -2,7 +2,7 @@ Copyright : (C) 2016, University of Twente, 2017, QBayLogic, Google Inc. 2017-2019, Myrtle Software Ltd, - 2021, QBayLogic B.V. + 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -214,6 +214,7 @@ seqX :: a -> b -> b seqX a b = unsafeDupablePerformIO (catch (evaluate a >> return b) (\(XException _) -> return b)) {-# NOINLINE seqX #-} +{-# ANN seqX hasBlackBox #-} infixr 0 `seqX` -- | Like 'seqX', but will also catch ErrorCall exceptions which are thrown. @@ -450,6 +451,7 @@ forceX x = x `deepseqX` x deepseqX :: NFDataX a => a -> b -> b deepseqX a b = rnfX a `seq` b {-# NOINLINE deepseqX #-} +{-# ANN deepseqX hasBlackBox #-} infixr 0 `deepseqX` -- | Reduce to weak head normal form diff --git a/clash-prelude/tests/Clash/Tests/BlockRam/Blob.hs b/clash-prelude/tests/Clash/Tests/BlockRam/Blob.hs new file mode 100644 index 0000000000..13d83fd916 --- /dev/null +++ b/clash-prelude/tests/Clash/Tests/BlockRam/Blob.hs @@ -0,0 +1,36 @@ +module Clash.Tests.BlockRam.Blob where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.Functor.Identity +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Numeric.Natural +import Test.Tasty +import Test.Tasty.Hedgehog + +import Clash.Explicit.BlockRam.Internal (packAsNats, unpackNats) + +roundTripProperty :: Property +roundTripProperty = property $ do + len <- forAll $ Gen.integral $ Range.linear 0 256 + width <- forAll $ Gen.integral $ Range.linear 1 128 + es <- forAll $ Gen.list (Range.singleton len) $ + Gen.integral_ $ Range.constant 0 (2 ^ width - 1) + tripping (len, width, es) encode decode + where + encode :: (Int, Int, [Natural]) -> (Int, Int, B.ByteString, B.ByteString) + encode (len, width, es) = let (runs, ends) = packAsNats width id es + in (len, width, L.toStrict runs, L.toStrict ends) + decode :: (Int, Int, B.ByteString, B.ByteString) + -> Identity (Int, Int, [Natural]) + decode (len, width, runs, ends) = + let es = take 300 $ unpackNats len width runs ends + in Identity (len, width, es) + +tests :: TestTree +tests = testGroup "BlockRam" + [ testGroup "Blob" + [ testProperty "Round trip" roundTripProperty ] + ] diff --git a/clash-prelude/tests/unittests.hs b/clash-prelude/tests/unittests.hs index a046556dda..0d46c46320 100644 --- a/clash-prelude/tests/unittests.hs +++ b/clash-prelude/tests/unittests.hs @@ -6,6 +6,7 @@ import qualified Clash.Tests.AutoReg import qualified Clash.Tests.BitPack import qualified Clash.Tests.BitVector import qualified Clash.Tests.BlockRam +import qualified Clash.Tests.BlockRam.Blob import qualified Clash.Tests.Counter import qualified Clash.Tests.DerivingDataRepr import qualified Clash.Tests.Fixed @@ -30,6 +31,7 @@ tests = testGroup "Unittests" , Clash.Tests.BitPack.tests , Clash.Tests.BitVector.tests , Clash.Tests.BlockRam.tests + , Clash.Tests.BlockRam.Blob.tests , Clash.Tests.Counter.tests , Clash.Tests.DerivingDataRepr.tests , Clash.Tests.Fixed.tests diff --git a/tests/Main.hs b/tests/Main.hs index eda41851c9..f7f138e270 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -551,6 +551,15 @@ runClashTest = defaultMain $ clashTestRoot } , outputTest "T1996" def{hdlTargets=[VHDL]} , runTest "T2040" def{hdlTargets=[VHDL],clashFlags=["-fclash-compile-ultra"]} + -- TODO I wanted to call this T2046A since there are multiple tests + -- for T2046. However, doing so completely breaks HDL loading because + -- it completely ignores the BuildSpecific... + , runTest "T2046" def + { hdlSim=False + , clashFlags=["-Werror"] + , buildTargets=BuildSpecific["top_bit", "top_bitvector", "top_index", "top_signed", "top_unsigned"] + } + , runTest "T2046B" def{clashFlags=["-Werror"]} ] <> if compiledWith == Cabal then -- This tests fails without environment files present, which are only @@ -650,6 +659,9 @@ runClashTest = defaultMain $ clashTestRoot , runTest "BlockRamFile" def , runTest "BlockRam0" def , runTest "BlockRam1" def + , clashTestGroup "BlockRam" + [ runTest "Blob" def + ] , runTest "AndEnable" def #ifdef CLASH_MULTIPLE_HIDDEN , runTest "AndSpecificEnable" def @@ -682,10 +694,18 @@ runClashTest = defaultMain $ clashTestRoot , runTest "ResetLow" def , runTest "Rom" def , runTest "RomNegative" def + , clashTestGroup "ROM" + [ runTest "Async" def + , runTest "AsyncBlob" def + , runTest "Blob" def + -- TODO: When issue #2039 is fixed, it should be possible to drop + -- compile-ultra. + , runTest "BlobVec" def{clashFlags=["-fclash-compile-ultra"]} + ] , runTest "SigP" def{hdlSim=False} , outputTest "T1102A" def{hdlTargets=[VHDL]} , outputTest "T1102B" def{hdlTargets=[VHDL]} - + , runTest "T2069" def , clashTestGroup "BiSignal" [ runTest "Counter" def , runTest "CounterHalfTuple" def diff --git a/tests/shouldwork/Issues/T2046.hs b/tests/shouldwork/Issues/T2046.hs new file mode 100644 index 0000000000..cc58f6ba46 --- /dev/null +++ b/tests/shouldwork/Issues/T2046.hs @@ -0,0 +1,55 @@ +module T2046 where + +import Clash.Prelude +import Data.Proxy + +topGeneric + :: forall ix n + . Enum ix + => KnownNat n + => Proxy ix + -> Vec n Int + -> Int + -> Int +topGeneric Proxy x i = + x !! toEnum @ix i + +topBit + :: Vec 2 Int + -> Int + -> Int +topBit = topGeneric (Proxy @Bit) +{-# NOINLINE topBit #-} +{-# ANN topBit (defSyn "top_bit") #-} + +topBitVector + :: Vec 5 Int + -> Int + -> Int +topBitVector = topGeneric (Proxy @(BitVector 3)) +{-# NOINLINE topBitVector #-} +{-# ANN topBitVector (defSyn "top_bitvector") #-} + +topIndex + :: Vec 5 Int + -> Int + -> Int +topIndex = topGeneric (Proxy @(Index 5)) +{-# NOINLINE topIndex #-} +{-# ANN topIndex (defSyn "top_index") #-} + +topSigned + :: Vec 5 Int + -> Int + -> Int +topSigned = topGeneric (Proxy @(Signed 4)) +{-# NOINLINE topSigned #-} +{-# ANN topSigned (defSyn "top_signed") #-} + +topUnsigned + :: Vec 5 Int + -> Int + -> Int +topUnsigned = topGeneric (Proxy @(Unsigned 3)) +{-# NOINLINE topUnsigned #-} +{-# ANN topUnsigned (defSyn "top_unsigned") #-} diff --git a/tests/shouldwork/Issues/T2046B.hs b/tests/shouldwork/Issues/T2046B.hs new file mode 100644 index 0000000000..66f3bf1ace --- /dev/null +++ b/tests/shouldwork/Issues/T2046B.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE ViewPatterns #-} + +module T2046B where + +import Clash.Prelude +import Clash.Explicit.Testbench + +import T2046BType (T2046B) + +topEntity :: T2046B -> T2046B +topEntity ((a, b), (c, d), (e, f), (g, h), i) = + ( (toEnum (fromEnum a), toEnum (fromEnum b)) + , (toEnum (fromEnum c), toEnum (fromEnum d)) + , (toEnum (fromEnum e), toEnum (fromEnum f)) + , (toEnum (fromEnum g), toEnum (fromEnum h)) + , toEnum (fromEnum i) + ) +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = stimuliGenerator clk rst + $(listToVecTH [( (0, 0), (0, 0), (0, 0), (0, 0), 0) + , ((0, 1), (0, 1), (0, 1), (0, 1), 1) :: T2046B]) + + expectedOutput = outputVerifier' clk rst + $(listToVecTH [( (0, 0), (0, 0), (0, 0), (0, 0), 0) + , ((0, 1), (0, 1), (0, 1), (0, 1), 1) :: T2046B]) + + done = expectedOutput (topEntity <$> testInput) + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen diff --git a/tests/shouldwork/Issues/T2046BType.hs b/tests/shouldwork/Issues/T2046BType.hs new file mode 100644 index 0000000000..eb13eebb9c --- /dev/null +++ b/tests/shouldwork/Issues/T2046BType.hs @@ -0,0 +1,11 @@ +module T2046BType where + +import Clash.Prelude + +type T2046B = + ( (Index 1, Index 2) + , (Unsigned 1, Unsigned 2) + , (Signed 1, Signed 2) + , (BitVector 1, BitVector 2) + , Bit + ) diff --git a/tests/shouldwork/Signal/BlockRam/Blob.hs b/tests/shouldwork/Signal/BlockRam/Blob.hs new file mode 100644 index 0000000000..7bf5311dbf --- /dev/null +++ b/tests/shouldwork/Signal/BlockRam/Blob.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module Blob where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +createMemBlob @4 "content" Nothing [4 .. 7] + +topEntity + :: Clock System + -> Enable System + -> Signal System (Unsigned 2) + -> Signal System (Maybe (Unsigned 2, Unsigned 4)) + -> Signal System (Unsigned 4, Unsigned 4) +topEntity clk en rd wrM = + let ram en0 = unpack <$> blockRamBlob clk en0 content rd wrM0 + wrM0 = fmap (fmap (\(wr, din) -> (wr, pack din))) wrM + in bundle (ram enableGen, ram en) +{-# NOINLINE topEntity #-} + +samples :: Vec _ (Unsigned 2, Maybe (Unsigned 2, Unsigned 4), Unsigned 4) +samples = + -- rd wrM out + + -- Read initial contents + (0, Nothing , 15) + :> (1, Nothing , 4) + :> (2, Nothing , 5) + -- Write and read back + :> (3, Just (0, 8), 6) + :> (0, Just (1, 9), 7) + :> (1, Just (2, 10), 8) + :> (2, Just (3, 11), 9) + :> (3, Nothing , 10) + :> (3, Nothing , 11) + :> Nil + +testBench :: Signal System Bool +testBench = done + where + (rd, wrM, expect) = unzip3 samples + rdInput = stimuliGenerator clk rst rd + wrMInput = stimuliGenerator clk rst wrM + expectedOutput = + outputVerifier' clk rst $ zip expect expect + done = expectedOutput $ ignoreFor clk rst en d1 (15, 15) $ + topEntity clk en rdInput wrMInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/shouldwork/Signal/ROM/Async.hs b/tests/shouldwork/Signal/ROM/Async.hs new file mode 100644 index 0000000000..7e69f69930 --- /dev/null +++ b/tests/shouldwork/Signal/ROM/Async.hs @@ -0,0 +1,23 @@ +module Async where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +topEntity + :: Signal System (Unsigned 4) + -> Signal System (Unsigned 8) +topEntity = fmap (asyncRomPow2 content) + where content = $(listToVecTH [1 :: Unsigned 8 .. 16]) +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = register clk rst en 0 (testInput + 1) + expectedOutput = + outputVerifier' clk rst $ $(listToVecTH $ [1 :: Unsigned 8 .. 8]) + done = expectedOutput $ topEntity testInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/shouldwork/Signal/ROM/AsyncBlob.hs b/tests/shouldwork/Signal/ROM/AsyncBlob.hs new file mode 100644 index 0000000000..92df0673ee --- /dev/null +++ b/tests/shouldwork/Signal/ROM/AsyncBlob.hs @@ -0,0 +1,24 @@ +module AsyncBlob where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +createMemBlob @8 "content" Nothing [1 .. 16] + +topEntity + :: Signal System (Unsigned 4) + -> Signal System (Unsigned 8) +topEntity = fmap (unpack . asyncRomBlobPow2 content) +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = register clk rst en 0 (testInput + 1) + expectedOutput = + outputVerifier' clk rst $ $(listToVecTH $ [1 :: Unsigned 8 .. 8]) + done = expectedOutput $ topEntity testInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/shouldwork/Signal/ROM/Blob.hs b/tests/shouldwork/Signal/ROM/Blob.hs new file mode 100644 index 0000000000..f812e649a5 --- /dev/null +++ b/tests/shouldwork/Signal/ROM/Blob.hs @@ -0,0 +1,29 @@ +module Blob where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +createMemBlob @8 "content" Nothing [1 .. 16] + +topEntity + :: Clock System + -> Enable System + -> Signal System (Unsigned 4) + -> Signal System (Unsigned 8, Unsigned 8) +topEntity clk en rd = + let rom0 en0 = unpack <$> romBlob clk en0 content rd + in bundle (rom0 enableGen, rom0 en) +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = register clk rst en 0 (testInput + 1) + expectedOutput = outputVerifier' clk rst $ map (\n -> (n, n)) $ + $(listToVecTH $ [0 :: Unsigned 8 .. 8]) + done = expectedOutput $ ignoreFor clk rst en d1 (0, 0) $ + topEntity clk en testInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/shouldwork/Signal/ROM/BlobVec.hs b/tests/shouldwork/Signal/ROM/BlobVec.hs new file mode 100644 index 0000000000..bba6094b9c --- /dev/null +++ b/tests/shouldwork/Signal/ROM/BlobVec.hs @@ -0,0 +1,36 @@ +module BlobVec where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +topEntity + :: Clock System + -> Signal System (Unsigned 4) + -> Signal System (Vec 3 (BitVector 8)) + +topEntity clk addr = bundle $ romBlob clk enableGen <$> blobs <*> pure addr + where + blobs = $(memBlobTH @8 Nothing [ 1 .. 15]) + :> $(memBlobTH @8 Nothing [17 .. 31]) + :> $(memBlobTH @8 Nothing [33 .. 47]) + :> Nil +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = register clk rst en 0 (testInput + 1) + expectedOutput = + outputVerifier' clk rst $ transpose + ( $(listToVecTH $ [ 0 :: BitVector 8 .. 8]) + :> $(listToVecTH $ [16 :: BitVector 8 .. 24]) + :> $(listToVecTH $ [32 :: BitVector 8 .. 40]) + :> Nil + ) + done = + expectedOutput $ ignoreFor clk rst en d1 (0 :> 16 :> 32 :> Nil) $ + topEntity clk testInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/shouldwork/Signal/T2069.hs b/tests/shouldwork/Signal/T2069.hs new file mode 100644 index 0000000000..4c29a6cbbb --- /dev/null +++ b/tests/shouldwork/Signal/T2069.hs @@ -0,0 +1,27 @@ +module T2069 where + +import Clash.Explicit.BlockRam +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +topEntity + :: Clock System + -> Clock System + -> Signal System (RamOp 1 (Unsigned 8)) + -> Signal System (RamOp 1 (Unsigned 8)) + -> (Signal System (Unsigned 8), Signal System (Unsigned 8)) +topEntity = trueDualPortBlockRam +{-# NOINLINE topEntity #-} + +testBench :: Signal System Bool +testBench = done + where + testInput = register clk rst en + (RamWrite 0 42, RamRead 0) $ pure (RamRead 0, RamRead 0) + expectedOutput = outputVerifier' clk rst $ (0,0) :> (0, 0) :> (42, 42) :> Nil + done = expectedOutput $ ignoreFor clk rst en d2 (0, 0) $ bundle $ + uncurry (topEntity clk clk) $ unbundle testInput + clk = tbSystemClockGen (not <$> done) + rst = systemResetGen + en = enableGen +{-# NOINLINE testBench #-} diff --git a/tests/src/Test/Tasty/Clash/NetlistTest.hs b/tests/src/Test/Tasty/Clash/NetlistTest.hs index e7e81e3d19..9cc0a81a35 100644 --- a/tests/src/Test/Tasty/Clash/NetlistTest.hs +++ b/tests/src/Test/Tasty/Clash/NetlistTest.hs @@ -79,11 +79,12 @@ runToNetlistStage target f src = do supplyN <- Supply.newSupply - let transformedBindings = normalizeEntity env (designBindings design) - (ghcTypeToHWType (opt_intWidth opts)) - ghcEvaluator - evaluator - teNames supplyN te + transformedBindings <- + normalizeEntity env (designBindings design) + (ghcTypeToHWType (opt_intWidth opts)) + ghcEvaluator + evaluator + teNames supplyN te fmap (\(_,x,_) -> force (P.map snd (OMap.assocs x))) $ netlistFrom