diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,90 @@ # Changelog for the Clash project +## 1.4.0 *March 12th 2020* +Highlighted changes (repeated in other categories): + * Clash no longer disables the monomorphism restriction. See [#1270](https://github.com/clash-lang/clash-compiler/issues/1270), and mentioned issues, as to why. This can cause, among other things, certain eta-reduced descriptions of sequential circuits to no longer type-check. See [#1349](https://github.com/clash-lang/clash-compiler/pull/1349) for code hints on what kind of changes to make to your own code in case it no longer type-checks due to this change. + * Type arguments of `Clash.Sized.Vector.fold` swapped: before `forall a n . (a -> a -> a) -> Vec (n+1) a -> a`, after `forall n a . (a -> a -> a) -> Vec (n+1) a`. This makes it easier to use `fold` in a `1 <= n` context so you can "simply" do `fold @(n-1)` + * `Fixed` now obeys the laws for `Enum` as set out in the Haskell Report, and it is now consistent with the documentation for the `Enum` class on Hackage. As `Fixed` is also `Bounded`, the rule in the Report that `succ maxBound` and `pred minBound` should result in a runtime error is interpreted as meaning that `succ` and `pred` result in a runtime error whenever the result cannot be represented, not merely for `minBound` and `maxBound` alone. + * Primitives should now be stored in `*.primitives` files instead of `*.json`. While primitive files very much look like JSON files, they're not actually spec complaint as they use newlines in strings. This has recently been brought to our attention by Aeson fixing an oversight in their parser implementation. We've therefore decided to rename the extension to prevent confusion. + +Fixed: + * Result of `Clash.Class.Exp.(^)` has enough bits in order to deal with `x^0`. + * Resizes to `Signed 0` (e.g., `resize @(Signed n) @(Signed 0)`) don't throw an error anymore + * `satMul` now correctly handles arguments of type `Index 2` + * `Clash.Explicit.Reset.resetSynchronizer` now synchronizes on synchronous domains too [#1567](https://github.com/clash-lang/clash-compiler/pull/1567). + * `Clash.Explicit.Reset.convertReset`: now converts synchronous domains too, if necessary [#1567](https://github.com/clash-lang/clash-compiler/pull/1567). + * `inlineWorkFree` now never inlines a topentity. It previously only respected this invariant in one of the two cases [#1587](https://github.com/clash-lang/clash-compiler/pull/1587). + * Clash now reduces recursive type families [#1591](https://github.com/clash-lang/clash-compiler/issues/1591) + * Primitive template warning is now retained when a `PrimitiveGuard` annotation is present [#1625](https://github.com/clash-lang/clash-compiler/issues/1625) + * `signum` and `RealFrac` for `Fixed` now give the correct results. + * Fixed a memory leak in register when used on asynchronous domains. Although the memory leak has always been there, it was only triggered on asserted resets. These periods are typically short, hence typically unnoticable. + * `createDomain` will not override user definitions of types, helping users who strive for complete documentation coverage [#1674] https://github.com/clash-lang/clash-compiler/issues/1674 + * `fromSNat` is now properly constrained [#1692](https://github.com/clash-lang/clash-compiler/issues/1692) + * As part of an internal overhaul on netlist identifier generation [#1265](https://github.com/clash-lang/clash-compiler/pull/1265): + * Clash no longer produces "name conflicts" between basic and extended identifiers. I.e., `\x\` and `x` are now considered the same variable in VHDL (likewise for other HDLs). Although the VHDL spec considers them distinct variables, some HDL tools - like Quartus - don't. + * Capitalization of Haskell names are now preserved in VHDL. Note that VHDL is a case insensitive languages, so there are measures in place to prevent Clash from generating both `Foo` and `fOO`. This used to be handled by promoting every capitalized identifier to an extended one and wasn't handled for basic ones. + * Names generated for testbenches can no longer cause collisions with previously generated entities. + * Names generated for components can no longer cause collisions with user specified top entity names. + * For (System)Verilog, variables can no longer cause collisions with (to be) generated entity names. + * HO blackboxes can no longer cause collisions with identifiers declared in their surrounding architecture block. + + +Changed: + * Treat enable lines specially in generated HDL [#1171](https://github.com/clash-lang/clash-compiler/issues/1171) + * `Signed`, `Unsigned`, `SFixed`, and `UFixed` now correctly implement the `Enum` law specifying that the predecessor of `minBound` and the successor of `maxBound` should result in an error [#1495](https://github.com/clash-lang/clash-compiler/pull/1495). + * `Fixed` now obeys the laws for `Enum` as set out in the Haskell Report, and it is now consistent with the documentation for the `Enum` class on Hackage. As `Fixed` is also `Bounded`, the rule in the Report that `succ maxBound` and `pred minBound` should result in a runtime error is interpreted as meaning that `succ` and `pred` result in a runtime error whenever the result cannot be represented, not merely for `minBound` and `maxBound` alone. + * Type arguments of `Clash.Sized.Vector.fold` swapped: before `forall a n . (a -> a -> a) -> Vec (n+1) a -> a`, after `forall n a . (a -> a -> a) -> Vec (n+1) a`. This makes it easier to use `fold` in a `1 <= n` context so you can "simply" do `fold @(n-1)` + * Moved `Clash.Core.Evaluator` into `Clash.GHC` and provided generic interface in `Clash.Core.Evalautor.Types`. This removes all GHC specific code from the evaluator in clash-lib. + * Clash no longer disables the monomorphism restriction. See [#1270](https://github.com/clash-lang/clash-compiler/issues/1270), and mentioned issues, as to why. This can cause, among other things, certain eta-reduced descriptions of sequential circuits to no longer type-check. See [#1349](https://github.com/clash-lang/clash-compiler/pull/1349) for code hints on what kind of changes to make to your own code in case it no longer type-checks due to this change. + * Clash now generates SDC files for each topentity with clock inputs + * `deepErrorX` is now equal to `undefined#`, which means that instead of the whole BitVector being undefined, its individual bits are. This makes sure bit operations are possible on it. [#1532](https://github.com/clash-lang/clash-compiler/pull/1532) + * From GHC 9.0.1 onwards the following types: `BiSignalOut`, `Index`, `Signed`, `Unsigned`, `File`, `Ref`, and `SimIO` are all encoded as `data` instead of `newtype` to work around an [issue](https://github.com/clash-lang/clash-compiler/pull/1624#discussion_r558333461) where the Clash compiler can no longer recognize primitives over these types. This means you can no longer use `Data.Coerce.coerce` to coerce between these types and their underlying representation. + * Signals on different domains used to be coercable because the domain had a type role "phantom". This has been changed to "nominal" to prevent accidental, unsafe coercions. [#1640](https://github.com/clash-lang/clash-compiler/pull/1640) + * Size parameters on types in Clash.Sized.Internal.* are now nominal to prevent unsafe coercions. [#1640](https://github.com/clash-lang/clash-compiler/pull/1640) + * `hzToPeriod` now takes a `Ratio Natural` rather than a `Double`. It rounds slightly differently, leading to more intuitive results and satisfying the requested change in [#1253](https://github.com/clash-lang/clash-compiler/issues/1253). Clash expresses clock rate as the clock period in picoseconds. If picosecond precision is required for your design, please use the exact method of specifying a clock period rather than a clock frequency. + * `periodToHz` now results in a `Ratio Natural` + * `createDomain` doesn't override existing definitions anymore, fixing [#1674](https://github.com/clash-lang/clash-compiler/issues/1674) + * Manifest files are now stored as `clash-manifest.json` + * Manifest files now store hashes of the files Clash generated. This allows Clash to detect user changes on a next run, preventing accidental data loss. + * Primitives should now be stored in `*.primitives` files. While primitive files very much look like JSON files, they're not actually spec complaint as they use newlines in strings. This has recently been brought to our attention by Aeson fixing an oversight in their parser implementation. We've therefore decided to rename the extension to prevent confusion. + * Each binder marked with a `Synthesize` or `TestBench` pragma will be put in its own directory under their fully qualified Haskell name. For example, two binders `foo` and `bar` in module `A` will be synthesized in `A.foo` and `A.bar`. + * Clash will no longer generate vhdl, verilog, or systemverilog subdirectories when using `-fclash-hdldir`. + * `Data.Kind.Type` is now exported from `Clash.Prelude` [#1700](https://github.com/clash-lang/clash-compiler/issues/1700) + + +Added: + * Support for GHC 9.0.1 + * `Clash.Signal.sameDomain`: Allows user obtain evidence whether two domains are equal. + * `xToErrorCtx`: makes it easier to track the origin of `XException` where `pack` would hide them [#1461](https://github.com/clash-lang/clash-compiler/pull/1461) + * Additional field with synthesis attributes added to `InstDecl` in `Clash.Netlist.Types` [#1482](https://github.com/clash-lang/clash-compiler/pull/1482) + * `Data.Ix.Ix` instances for `Signed`, `Unsigned`, and `Index` [#1481](https://github.com/clash-lang/clash-compiler/pull/1481) [#1631](https://github.com/clash-lang/clash-compiler/pull/1631) + * Added `nameHint` to allow explicitly naming terms, e.g. `Signal`s. + * Checked versions of `resize`, `truncateB`, and `fromIntegral`. Depending on the type `resize`, `truncateB`, and `fromIntegral` either yield an `XException` or silently perform wrap-around if its argument does not fit in the resulting type's bounds. The added functions check the bound condition and fail with an error call if the condition is violated. They do not affect HDL generation. [#1491](https://github.com/clash-lang/clash-compiler/pull/1491) + * `HasBiSignalDefault`: constraint to Clash.Signal.BiSignal, `pullUpMode` gives access to the pull-up mode. [#1498](https://github.com/clash-lang/clash-compiler/pull/1498) + * Match patterns to bitPattern [#1545](https://github.com/clash-lang/clash-compiler/pull/1545) + * Non TH `fromList` and `unsafeFromList` for Vec. These functions allow Vectors to be created from a list without needing to use template haskell, which is not always desirable. The unsafe version of the function does not compare the length of the list to the desired length of the vector, either truncating or padding with undefined if the lengths differ. + * `Clash.Explicit.Reset.resetGlitchFilter`: filters glitchy reset signals. Useful when your reset signal is connected to sensitive actuators. + * Clash can now generate EDAM for using Edalize. This generates edam.py files in all top entities with the configuration for building that entity. Users still need to edit this file to specify the EDA tool to use, and if necessary the device to target (for Quartus, Vivado etc.). [#1386](https://github.com/clash-lang/clash-compiler/issues/1386) + * `-fclash-aggressive-x-optimization-blackboxes`: when enabled primitives can detect undefined values and change their behavior accordingly. For example, if `register` is used in combination with an undefined reset value, it will leave out the reset logic entirely. Related issue: [#1506](https://github.com/clash-lang/clash-compiler/issues/1506). + * Automaton-based interface to simulation, to allow interleaving of cyle-by-cycle simulation and external effects [#1261](https://github.com/clash-lang/clash-compiler/pull/1261) + + +New internal features: + * `constructProduct` and `deconstructProduct` in `Clash.Primitives.DSL`. Like `tuple` and `untuple`, but on arbitrary product types. + * Support for multi result primitives. Primitives can now assign their results to multiple variables. This can help to work around synthesis tools limits in some cases. See [#1560](https://github.com/clash-lang/clash-compiler/pull/1560). + * Added a rule for missing `Int` comparisons in `GHC.Classes` in the compile time evaluator. [#1648](https://github.com/clash-lang/clash-compiler/issues/1648) + * Clash now creates a mapping from domain names to configurations in `LoadModules`. [#1405](https://github.com/clash-lang/clash-compiler/pull/1405) + * The convenience functions in `Clash.Primitives.DSL` now take a list of HDLs, instead of just one. + * `Clash.Netlist.Id` overhauls the way identifiers are generated in the Netlist part of Clash. + * Added `defaultWithAction` to Clash-as-a-library API to work around/fix issues such as [#1686](https://github.com/clash-lang/clash-compiler/issues/1686) + * Manifest files now list files and components in an reverse topological order. This means it can be used when calling EDA tooling without causing compilation issues. + +Deprecated: + * `Clash.Prelude.DataFlow`: see [#1490](https://github.com/clash-lang/clash-compiler/pull/1490). In time, its functionality will be replaced by [clash-protocols](https://github.com/clash-lang/clash-protocols). + +Removed: + * The deprecated function `freqCalc` has been removed. + ## 1.2.5 *November 9th 2020* Fixed: * The normalizeType function now fully normalizes types which require calls to @@ -13,6 +98,9 @@ * Clash now uses correct function names in manifest and sdc files [#1533](https://github.com/clash-lang/clash-compiler/issues/1533) * Clash no longer produces erroneous HDL in very specific cases [#1536](https://github.com/clash-lang/clash-compiler/issues/1536) * Usage of `fold` inside other HO primitives (e.g., `map`) no longer fails [#1524](https://github.com/clash-lang/clash-compiler/issues/1524) + +Changed: + * Due to difficulties using `resetSynchronizer` we've decided to make this function always insert a synchronizer. See: [#1528](https://github.com/clash-lang/clash-compiler/issues/1528). ## 1.2.4 *July 28th 2020* * Changed: diff --git a/clash-lib.cabal b/clash-lib.cabal --- a/clash-lib.cabal +++ b/clash-lib.cabal @@ -1,7 +1,7 @@ Cabal-version: 2.2 Name: clash-lib -Version: 1.2.5 -Synopsis: CAES Language for Synchronous Hardware - As a Library +Version: 1.4.0 +Synopsis: Clash: a functional hardware description language - As a library Description: Clash is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The @@ -61,11 +61,11 @@ src/ClashDebug.h Data-files: - prims/common/*.json, - prims/commonverilog/*.json, - prims/verilog/*.json, - prims/systemverilog/*.json, - prims/vhdl/*.json + prims/common/*.primitives, + prims/commonverilog/*.primitives, + prims/verilog/*.primitives, + prims/systemverilog/*.primitives, + prims/vhdl/*.primitives source-repository head type: git @@ -78,18 +78,18 @@ default: False manual: True -flag history - description: - Emit rewrite history to disk - default: False - manual: True - flag unittests description: You can disable testing with unittests using `-f-unittests`. default: True manual: True +flag experimental-evaluator + description: + Use the new partial evaluator (experimental; may break) + default: False + manual: True + common common-options default-language: Haskell2010 default-extensions: BangPatterns @@ -136,14 +136,18 @@ TemplateHaskell Build-depends: aeson >= 0.6.2.0 && < 1.6, + aeson-pretty >= 0.8 && < 0.9, ansi-terminal >= 0.8.0.0 && < 0.12, + array, attoparsec >= 0.10.4.0 && < 0.14, base >= 4.11 && < 5, + base16-bytestring >= 0.1.1 && < 1.1, binary >= 0.8.5 && < 0.11, bytestring >= 0.10.0.2 && < 0.12, - clash-prelude == 1.2.5, + clash-prelude == 1.4.0, concurrent-supply >= 0.1.7 && < 0.2, containers >= 0.5.0.0 && < 0.7, + cryptohash-sha256 >= 0.11 && < 0.12, data-binary-ieee754 >= 0.4.4 && < 0.6, data-default >= 0.7 && < 0.8, deepseq >= 1.3.0.2 && < 1.5, @@ -151,24 +155,24 @@ directory >= 1.2.0.1 && < 1.4, errors >= 1.4.2 && < 2.4, exceptions >= 0.8.3 && < 0.11.0, - extra >= 1.6.18 && < 1.8, + extra >= 1.6.17 && < 1.8, filepath >= 1.3.0.1 && < 1.5, - ghc >= 8.4.0 && < 8.11, + ghc >= 8.4.0 && < 9.1, ghc-boot-th, hashable >= 1.2.1.0 && < 1.4, haskell-src-meta >= 0.8 && < 0.9, hint >= 0.7 && < 0.10, - integer-gmp >= 1.0 && < 1.1, interpolate >= 0.2.0 && < 1.0, - lens >= 4.10 && < 4.20, + lens >= 4.10 && < 5.1.0, mtl >= 2.1.2 && < 2.3, ordered-containers >= 0.2 && < 0.3, parsers >= 0.12.8 && < 1.0, prettyprinter >= 1.2.0.1 && < 2.0, + pretty-show >= 1.9 && < 2.0, primitive >= 0.5.0.1 && < 1.0, process >= 1.1.0.2 && < 1.7, reducers >= 3.12.2 && < 4.0, - template-haskell >= 2.8.0.0 && < 2.17, + template-haskell >= 2.8.0.0 && < 2.18, temporary >= 1.2.1 && < 1.4, terminal-size >= 0.3 && < 0.4, text >= 1.2.2 && < 1.3, @@ -181,6 +185,11 @@ vector-binary-instances >= 0.2.3.5 && < 0.3, unordered-containers >= 0.2.3.3 && < 0.3 + if impl(ghc >= 9.0.0) + build-depends: ghc-bignum >=1.0 && <1.1 + else + build-depends: integer-gmp >=1.0 && <1.1 + Autogen-Modules: Paths_clash_lib Exposed-modules: Clash.Annotations.BitRepresentation.ClashLib @@ -192,17 +201,21 @@ Clash.Core.DataCon Clash.Core.EqSolver - Clash.Core.Evaluator Clash.Core.Evaluator.Types Clash.Core.FreeVars Clash.Core.Literal Clash.Core.Name + Clash.Core.PartialEval + Clash.Core.PartialEval.AsTerm + Clash.Core.PartialEval.Monad + Clash.Core.PartialEval.NormalForm Clash.Core.Pretty Clash.Core.Subst Clash.Core.Term Clash.Core.TermInfo Clash.Core.TermLiteral Clash.Core.TermLiteral.TH + Clash.Core.Termination Clash.Core.TyCon Clash.Core.Type Clash.Core.TysPrim @@ -213,14 +226,22 @@ Clash.Debug Clash.Driver + Clash.Driver.Manifest Clash.Driver.Types + Clash.Edalize.Edam + Clash.Netlist Clash.Netlist.BlackBox Clash.Netlist.BlackBox.Parser Clash.Netlist.BlackBox.Types Clash.Netlist.BlackBox.Util Clash.Netlist.Id + Clash.Netlist.Id.Common + Clash.Netlist.Id.Internal + Clash.Netlist.Id.SystemVerilog + Clash.Netlist.Id.Verilog + Clash.Netlist.Id.VHDL Clash.Netlist.Types Clash.Netlist.Util @@ -242,10 +263,12 @@ Clash.Primitives.Intel.ClockGen Clash.Primitives.Sized.ToInteger Clash.Primitives.Sized.Vector + Clash.Primitives.Verification Clash.Rewrite.Combinators Clash.Rewrite.Types Clash.Rewrite.Util + Clash.Rewrite.WorkFree Clash.Unique Clash.Util @@ -256,11 +279,13 @@ Data.Text.Prettyprint.Doc.Extra Other-Modules: Clash.Annotations.TopEntity.Extra + Control.Applicative.Extra Data.Aeson.Extra Data.List.Extra + Data.Map.Ordered.Extra + Data.Primitive.ByteArray.Extra Data.Semigroup.Monad.Extra Data.Set.Ordered.Extra - Data.Vector.Primitive.Extra GHC.BasicTypes.Extra GHC.SrcLoc.Extra Paths_clash_lib @@ -268,15 +293,15 @@ if flag(debug) cpp-options: -DDEBUG - if flag(history) - cpp-options: -DHISTORY + if flag(experimental-evaluator) + cpp-options: -DEXPERIMENTAL_EVALUATOR test-suite unittests import: common-options type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: unittests.hs - ghc-options: -Wall -Wcompat + ghc-options: -Wall -Wcompat -threaded -with-rtsopts=-N hs-source-dirs: tests if !flag(unittests) @@ -288,7 +313,11 @@ ghc-typelits-knownnat, + aeson, + aeson-pretty, base, + base16-bytestring, + bytestring, containers, concurrent-supply, data-default, @@ -296,8 +325,11 @@ haskell-src-exts, ghc, lens, + pretty-show, + quickcheck-text, tasty >= 1.2 && < 1.5, tasty-hunit, + tasty-quickcheck, template-haskell, text, transformers, @@ -305,7 +337,12 @@ Other-Modules: Clash.Tests.Core.FreeVars Clash.Tests.Core.Subst + Clash.Tests.Driver.Manifest + Clash.Tests.Netlist.Id Clash.Tests.Util.Interpolate Clash.Tests.Normalize.Transformations Test.Clash.Rewrite + + if flag(experimental-evaluator) + cpp-options: -DEXPERIMENTAL_EVALUATOR diff --git a/prims/common/Clash_Annotations_BitRepresentation_Deriving.json b/prims/common/Clash_Annotations_BitRepresentation_Deriving.json deleted file mode 100644 --- a/prims/common/Clash_Annotations_BitRepresentation_Deriving.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "dontApplyInHDL :: (a -> b) -> a -> b" - , "template" : "~ARG[1]" - } - } -] diff --git a/prims/common/Clash_Annotations_BitRepresentation_Deriving.primitives b/prims/common/Clash_Annotations_BitRepresentation_Deriving.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Annotations_BitRepresentation_Deriving.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "dontApplyInHDL :: (a -> b) -> a -> b" + , "template" : "~ARG[1]" + } + } +] diff --git a/prims/common/Clash_Class_BitPack.json b/prims/common/Clash_Class_BitPack.json deleted file mode 100644 --- a/prims/common/Clash_Class_BitPack.json +++ /dev/null @@ -1,37 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Class.BitPack.packFloat#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"packFloat# :: Float -> BitVector 32" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Class.BitPack.unpackFloat#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"packFloat# :: BitVector 32 -> Float" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Class.BitPack.packDouble#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"packFloat# :: Double -> BitVector 64" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Class.BitPack.unpackDouble#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"packFloat# :: BitVector 64 -> Double" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/Clash_Class_BitPack.primitives b/prims/common/Clash_Class_BitPack.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Class_BitPack.primitives @@ -0,0 +1,37 @@ +[ { "BlackBox" : + { "name" : "Clash.Class.BitPack.packFloat#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"packFloat# :: Float -> BitVector 32" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Class.BitPack.unpackFloat#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"packFloat# :: BitVector 32 -> Float" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Class.BitPack.packDouble#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"packFloat# :: Double -> BitVector 64" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Class.BitPack.unpackDouble#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"packFloat# :: BitVector 64 -> Double" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/common/Clash_Explicit_Signal.json b/prims/common/Clash_Explicit_Signal.json deleted file mode 100644 --- a/prims/common/Clash_Explicit_Signal.json +++ /dev/null @@ -1,14 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.Signal.veryUnsafeSynchronizer" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"veryUnsafeSynchronizer - :: Int -- ARG[0] - -> Int -- ARG[1] - -> Signal dom1 a -- ARG[2] - -> Signal dom2 a" - , "template" : "~ARG[2]" - } - } -] diff --git a/prims/common/Clash_Explicit_Signal.primitives b/prims/common/Clash_Explicit_Signal.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Explicit_Signal.primitives @@ -0,0 +1,14 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.Signal.veryUnsafeSynchronizer" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"veryUnsafeSynchronizer + :: Int -- ARG[0] + -> Int -- ARG[1] + -> Signal dom1 a -- ARG[2] + -> Signal dom2 a" + , "template" : "~ARG[2]" + } + } +] diff --git a/prims/common/Clash_GHC_GHC2Core.json b/prims/common/Clash_GHC_GHC2Core.json deleted file mode 100644 --- a/prims/common/Clash_GHC_GHC2Core.json +++ /dev/null @@ -1,20 +0,0 @@ -[ { "BlackBox" : - { "name" : "EmptyCase" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "template" : "~ERRORO" - } - } -, { "Primitive" : - { "name" : "_CO_" - , "workInfo" : "Constant" - , "primType" : "Constructor" - } - } -, { "Primitive" : - { "name" : "_TY_" - , "workInfo" : "Constant" - , "primType" : "Constructor" - } - } -] diff --git a/prims/common/Clash_GHC_GHC2Core.primitives b/prims/common/Clash_GHC_GHC2Core.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_GHC_GHC2Core.primitives @@ -0,0 +1,20 @@ +[ { "BlackBox" : + { "name" : "EmptyCase" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "template" : "~ERRORO" + } + } +, { "Primitive" : + { "name" : "_CO_" + , "workInfo" : "Constant" + , "primType" : "Constructor" + } + } +, { "Primitive" : + { "name" : "_TY_" + , "workInfo" : "Constant" + , "primType" : "Constructor" + } + } +] diff --git a/prims/common/Clash_Intel_ClockGen.json b/prims/common/Clash_Intel_ClockGen.json deleted file mode 100644 --- a/prims/common/Clash_Intel_ClockGen.json +++ /dev/null @@ -1,29 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Intel.ClockGen.altpll" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "includes" : [ {"extension": "qsys" - ,"name": "altpll" - ,"format": "Haskell" - ,"templateFunction": "Clash.Primitives.Intel.ClockGen.altpllQsysTF" - } - ] - , "format" : "Haskell" - , "templateFunction" : "Clash.Primitives.Intel.ClockGen.altpllTF" - } - } -, { "BlackBox" : - { "name" : "Clash.Intel.ClockGen.alteraPll" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "includes" : [ {"extension": "qsys" - ,"name": "altera_pll" - ,"format": "Haskell" - ,"templateFunction": "Clash.Primitives.Intel.ClockGen.alteraPllQsysTF" - } - ] - , "format" : "Haskell" - , "templateFunction" : "Clash.Primitives.Intel.ClockGen.alteraPllTF" - } - } -] diff --git a/prims/common/Clash_Intel_ClockGen.primitives b/prims/common/Clash_Intel_ClockGen.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Intel_ClockGen.primitives @@ -0,0 +1,29 @@ +[ { "BlackBox" : + { "name" : "Clash.Intel.ClockGen.altpll" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "includes" : [ {"extension": "qsys" + ,"name": "altpll" + ,"format": "Haskell" + ,"templateFunction": "Clash.Primitives.Intel.ClockGen.altpllQsysTF" + } + ] + , "format" : "Haskell" + , "templateFunction" : "Clash.Primitives.Intel.ClockGen.altpllTF" + } + } +, { "BlackBox" : + { "name" : "Clash.Intel.ClockGen.alteraPll" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "includes" : [ {"extension": "qsys" + ,"name": "altera_pll" + ,"format": "Haskell" + ,"templateFunction": "Clash.Primitives.Intel.ClockGen.alteraPllQsysTF" + } + ] + , "format" : "Haskell" + , "templateFunction" : "Clash.Primitives.Intel.ClockGen.alteraPllTF" + } + } +] diff --git a/prims/common/Clash_Magic.json b/prims/common/Clash_Magic.json deleted file mode 100644 --- a/prims/common/Clash_Magic.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Magic.prefixName" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Magic.suffixName" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Magic.suffixNameFromNat" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Magic.suffixNameP" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Magic.suffixNameFromNatP" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Magic.setName" - , "primType" : "Function" - } - } -] diff --git a/prims/common/Clash_Magic.primitives b/prims/common/Clash_Magic.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Magic.primitives @@ -0,0 +1,31 @@ +[ { "Primitive" : + { "name" : "Clash.Magic.prefixName" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Magic.suffixName" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Magic.suffixNameFromNat" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Magic.suffixNameP" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Magic.suffixNameFromNatP" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Magic.setName" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Clash_Promoted_Nat.json b/prims/common/Clash_Promoted_Nat.json deleted file mode 100644 --- a/prims/common/Clash_Promoted_Nat.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Promoted.Nat.powSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.powSNat :: SNat a -> SNat b -> SNat (a^b)" - , "template" : "~LIT[0] ** ~LIT[1]" - } - } -] diff --git a/prims/common/Clash_Promoted_Nat.primitives b/prims/common/Clash_Promoted_Nat.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Promoted_Nat.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "Clash.Promoted.Nat.powSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.powSNat :: SNat a -> SNat b -> SNat (a^b)" + , "template" : "~LIT[0] ** ~LIT[1]" + } + } +] diff --git a/prims/common/Clash_Promoted_Nat_Unsafe.json b/prims/common/Clash_Promoted_Nat_Unsafe.json deleted file mode 100644 --- a/prims/common/Clash_Promoted_Nat_Unsafe.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Promoted.Nat.Unsafe.unsafeSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.Unsafe.unsafeSNat :: Integer -> SNat k" - , "template" : "~LIT[0]" - } - } -] diff --git a/prims/common/Clash_Promoted_Nat_Unsafe.primitives b/prims/common/Clash_Promoted_Nat_Unsafe.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Promoted_Nat_Unsafe.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "Clash.Promoted.Nat.Unsafe.unsafeSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.Unsafe.unsafeSNat :: Integer -> SNat k" + , "template" : "~LIT[0]" + } + } +] diff --git a/prims/common/Clash_Promoted_Symbol.json b/prims/common/Clash_Promoted_Symbol.json deleted file mode 100644 --- a/prims/common/Clash_Promoted_Symbol.json +++ /dev/null @@ -1,17 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Promoted.Symbol.SSymbol" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "SSymbol :: KnownNat n => Proxy n -> SSymbol n" - , "template" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Promoted.Symbol.symbolToString" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "symbolToString :: SSymbol n -> String" - , "template" : "~LIT[0]" - } - } -] diff --git a/prims/common/Clash_Promoted_Symbol.primitives b/prims/common/Clash_Promoted_Symbol.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Promoted_Symbol.primitives @@ -0,0 +1,17 @@ +[ { "BlackBox" : + { "name" : "Clash.Promoted.Symbol.SSymbol" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "SSymbol :: KnownNat n => Proxy n -> SSymbol n" + , "template" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Promoted.Symbol.symbolToString" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "symbolToString :: SSymbol n -> String" + , "template" : "~LIT[0]" + } + } +] diff --git a/prims/common/Clash_Signal_BiSignal.json b/prims/common/Clash_Signal_BiSignal.json deleted file mode 100644 --- a/prims/common/Clash_Signal_BiSignal.json +++ /dev/null @@ -1,30 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.veryUnsafeToBiSignalIn" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"veryUnsafeToBiSignalIn - :: ( HasCallStack -- ARG[0] - , KnownNat n -- ARG[1] - , Given (SBiSignalDefault ds) -- ARG[2] - ) - => BiSignalOut ds d n -- ARG[3] - -> BiSignalIn ds d n" - , "template" : "~DEVNULL[~ARG[3]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.mergeBiSignalOuts" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"mergeBiSignalOuts - :: ( HasCallStack -- ARG[0] - , KnownNat n -- ARG[1] - ) - => Vec n (BiSignalOut defaultState dom m) -- ARG[2] - -> BiSignalOut defaultState dom m" - , "template" : "~DEVNULL[~ARG[2]]" - } - } -] diff --git a/prims/common/Clash_Signal_BiSignal.primitives b/prims/common/Clash_Signal_BiSignal.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Signal_BiSignal.primitives @@ -0,0 +1,30 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.veryUnsafeToBiSignalIn" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"veryUnsafeToBiSignalIn + :: ( HasCallStack -- ARG[0] + , KnownNat n -- ARG[1] + , Given (SBiSignalDefault ds) -- ARG[2] + ) + => BiSignalOut ds d n -- ARG[3] + -> BiSignalIn ds d n" + , "template" : "~DEVNULL[~ARG[3]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.mergeBiSignalOuts" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"mergeBiSignalOuts + :: ( HasCallStack -- ARG[0] + , KnownNat n -- ARG[1] + ) + => Vec n (BiSignalOut defaultState dom m) -- ARG[2] + -> BiSignalOut defaultState dom m" + , "template" : "~DEVNULL[~ARG[2]]" + } + } +] diff --git a/prims/common/Clash_Signal_Bundle.json b/prims/common/Clash_Signal_Bundle.json deleted file mode 100644 --- a/prims/common/Clash_Signal_Bundle.json +++ /dev/null @@ -1,7 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Signal.Bundle.vecBundle#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/Clash_Signal_Bundle.primitives b/prims/common/Clash_Signal_Bundle.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Signal_Bundle.primitives @@ -0,0 +1,7 @@ +[ { "Primitive" : + { "name" : "Clash.Signal.Bundle.vecBundle#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Clash_Signal_Internal.json b/prims/common/Clash_Signal_Internal.json deleted file mode 100644 --- a/prims/common/Clash_Signal_Internal.json +++ /dev/null @@ -1,37 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Signal.Internal.signal#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Signal.Internal.mapSignal#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Signal.Internal.appSignal#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Signal.Internal.foldr#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Signal.Internal.traverse#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Signal.Internal.joinSignal#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/Clash_Signal_Internal.primitives b/prims/common/Clash_Signal_Internal.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Signal_Internal.primitives @@ -0,0 +1,37 @@ +[ { "Primitive" : + { "name" : "Clash.Signal.Internal.signal#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Signal.Internal.mapSignal#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Signal.Internal.appSignal#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Signal.Internal.foldr#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Signal.Internal.traverse#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Signal.Internal.joinSignal#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Clash_Signal_Trace.json b/prims/common/Clash_Signal_Trace.json deleted file mode 100644 --- a/prims/common/Clash_Signal_Trace.json +++ /dev/null @@ -1,67 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.Trace.traceSignal1" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"traceSignal1 - :: ( BitPack a -- ARG[0] - , NFDataX a -- ARG[1] - , Typeable a ) -- ARG[2] - => String -- ARG[3] - -> Signal dom a -- ARG[4] - -> Signal dom a" - , "template" : "~ARG[4]" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Trace.traceVecSignal1" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"traceVecSignal1 - :: ( KnownNat n -- ARG[0] - , BitPack a -- ARG[1] - , NFDataX a -- ARG[2] - , Typeable a ) -- ARG[3] - => String -- ARG[4] - -> Signal dom (Vec (n+1) a) -- ARG[5] - -> Signal dom (Vec (n+1) a)" - , "template" : "~ARG[5]" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Trace.traceSignal" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"traceSignal - :: forall dom a - . ( KnownDomain dom -- ARG[0] - , BitPack a -- ARG[1] - , NFDataX a -- ARG[2] - , Typeable a ) -- ARG[3] - => String -- ARG[4] - -> Signal dom a -- ARG[5] - -> Signal dom a" - , "template" : "~ARG[5]" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Trace.traceVecSignal" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"traceVecSignal - :: forall dom a n - . ( KnownDomain dom -- ARG[0] - , KnownNat n -- ARG[1] - , BitPack a -- ARG[2] - , NFDataX a -- ARG[3] - , Typeable a ) -- ARG[4] - => String -- ARG[5] - -> Signal dom (Vec (n+1) a) -- ARG[6] - -> Signal dom (Vec (n+1) a)" - , "template" : "~ARG[6]" - } - } -] diff --git a/prims/common/Clash_Signal_Trace.primitives b/prims/common/Clash_Signal_Trace.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Signal_Trace.primitives @@ -0,0 +1,67 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.Trace.traceSignal1" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"traceSignal1 + :: ( BitPack a -- ARG[0] + , NFDataX a -- ARG[1] + , Typeable a ) -- ARG[2] + => String -- ARG[3] + -> Signal dom a -- ARG[4] + -> Signal dom a" + , "template" : "~ARG[4]" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Trace.traceVecSignal1" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"traceVecSignal1 + :: ( KnownNat n -- ARG[0] + , BitPack a -- ARG[1] + , NFDataX a -- ARG[2] + , Typeable a ) -- ARG[3] + => String -- ARG[4] + -> Signal dom (Vec (n+1) a) -- ARG[5] + -> Signal dom (Vec (n+1) a)" + , "template" : "~ARG[5]" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Trace.traceSignal" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"traceSignal + :: forall dom a + . ( KnownDomain dom -- ARG[0] + , BitPack a -- ARG[1] + , NFDataX a -- ARG[2] + , Typeable a ) -- ARG[3] + => String -- ARG[4] + -> Signal dom a -- ARG[5] + -> Signal dom a" + , "template" : "~ARG[5]" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Trace.traceVecSignal" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"traceVecSignal + :: forall dom a n + . ( KnownDomain dom -- ARG[0] + , KnownNat n -- ARG[1] + , BitPack a -- ARG[2] + , NFDataX a -- ARG[3] + , Typeable a ) -- ARG[4] + => String -- ARG[5] + -> Signal dom (Vec (n+1) a) -- ARG[6] + -> Signal dom (Vec (n+1) a)" + , "template" : "~ARG[6]" + } + } +] diff --git a/prims/common/Clash_Sized_Internal_BitVector.json b/prims/common/Clash_Sized_Internal_BitVector.json deleted file mode 100644 --- a/prims/common/Clash_Sized_Internal_BitVector.json +++ /dev/null @@ -1,43 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.undefined#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "undefined# :: forall n . KnownNat n => BitVector n" - , "template" : "~ERRORO" - } - } -, { "Primitive" : - { "name" : "Clash.Sized.Internal.BitVector.checkUnpackUndef" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.lt##" - , "kind" : "Expression" - , "type" : "lt## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.ge##" - , "kind" : "Expression" - , "type" : "ge## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.gt##" - , "kind" : "Expression" - , "type" : "gt## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.le##" - , "kind" : "Expression" - , "type" : "le## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] <= ~ARG[1]" - } - } -] diff --git a/prims/common/Clash_Sized_Internal_BitVector.primitives b/prims/common/Clash_Sized_Internal_BitVector.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_Internal_BitVector.primitives @@ -0,0 +1,43 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.undefined#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "undefined# :: forall n . KnownNat n => BitVector n" + , "template" : "~ERRORO" + } + } +, { "Primitive" : + { "name" : "Clash.Sized.Internal.BitVector.checkUnpackUndef" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.lt##" + , "kind" : "Expression" + , "type" : "lt## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.ge##" + , "kind" : "Expression" + , "type" : "ge## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.gt##" + , "kind" : "Expression" + , "type" : "gt## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.le##" + , "kind" : "Expression" + , "type" : "le## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] <= ~ARG[1]" + } + } +] diff --git a/prims/common/Clash_Sized_Internal_Index.json b/prims/common/Clash_Sized_Internal_Index.json deleted file mode 100644 --- a/prims/common/Clash_Sized_Internal_Index.json +++ /dev/null @@ -1,8 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.quot#" - , "kind" : "Expression" - , "type" : "quot# :: Index n -> Index n -> Index n" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -] diff --git a/prims/common/Clash_Sized_Internal_Index.primitives b/prims/common/Clash_Sized_Internal_Index.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_Internal_Index.primitives @@ -0,0 +1,8 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.quot#" + , "kind" : "Expression" + , "type" : "quot# :: Index n -> Index n -> Index n" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +] diff --git a/prims/common/Clash_Sized_Internal_Signed.json b/prims/common/Clash_Sized_Internal_Signed.json deleted file mode 100644 --- a/prims/common/Clash_Sized_Internal_Signed.json +++ /dev/null @@ -1,22 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.quot#" - , "kind" : "Expression" - , "type" : "quot# :: Signed n -> Signed n -> Signed n" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -] diff --git a/prims/common/Clash_Sized_Internal_Signed.primitives b/prims/common/Clash_Sized_Internal_Signed.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_Internal_Signed.primitives @@ -0,0 +1,22 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.quot#" + , "kind" : "Expression" + , "type" : "quot# :: Signed n -> Signed n -> Signed n" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +] diff --git a/prims/common/Clash_Sized_Internal_Unsigned.json b/prims/common/Clash_Sized_Internal_Unsigned.json deleted file mode 100644 --- a/prims/common/Clash_Sized_Internal_Unsigned.json +++ /dev/null @@ -1,46 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.quot#" - , "kind" : "Expression" - , "type" : "quot# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unsignedToWord" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unsigned8toWord8" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unsigned16toWord16" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unsigned32toWord32" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/Clash_Sized_Internal_Unsigned.primitives b/prims/common/Clash_Sized_Internal_Unsigned.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_Internal_Unsigned.primitives @@ -0,0 +1,46 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.quot#" + , "kind" : "Expression" + , "type" : "quot# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unsignedToWord" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unsigned8toWord8" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unsigned16toWord16" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unsigned32toWord32" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/common/Clash_Sized_RTree.json b/prims/common/Clash_Sized_RTree.json deleted file mode 100644 --- a/prims/common/Clash_Sized_RTree.json +++ /dev/null @@ -1,7 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Sized.RTree.tdfold" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/Clash_Sized_RTree.primitives b/prims/common/Clash_Sized_RTree.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_RTree.primitives @@ -0,0 +1,7 @@ +[ { "Primitive" : + { "name" : "Clash.Sized.RTree.tdfold" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Clash_Sized_Vector.json b/prims/common/Clash_Sized_Vector.json deleted file mode 100644 --- a/prims/common/Clash_Sized_Vector.json +++ /dev/null @@ -1,47 +0,0 @@ -[ - { - "BlackBox": { - "name": "Clash.Sized.Vector.lazyV", - "workInfo" : "Never", - "kind": "Expression", - "type": "lazyV :: KnownNat n => Vec n a -> Vec n a", - "template": "~ARG[1]" - } - }, - { - "BlackBox": { - "name": "Clash.Sized.Vector.seqV", - "workInfo" : "Never", - "kind": "Expression", - "type": "seqV :: KnownNat n => Vec n a -> b -> b", - "template": "~ARG[2]" - } - }, - { - "BlackBox": { - "name": "Clash.Sized.Vector.seqVX", - "workInfo" : "Never", - "kind": "Expression", - "type": "seqVX :: KnownNat n => Vec n a -> b -> b", - "template": "~ARG[2]" - } - } -, { "Primitive" : - { "name" : "Clash.Sized.Vector.dfold" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Sized.Vector.dtfold" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Sized.Vector.traverse#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/Clash_Sized_Vector.primitives b/prims/common/Clash_Sized_Vector.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Sized_Vector.primitives @@ -0,0 +1,47 @@ +[ + { + "BlackBox": { + "name": "Clash.Sized.Vector.lazyV", + "workInfo" : "Never", + "kind": "Expression", + "type": "lazyV :: KnownNat n => Vec n a -> Vec n a", + "template": "~ARG[1]" + } + }, + { + "BlackBox": { + "name": "Clash.Sized.Vector.seqV", + "workInfo" : "Never", + "kind": "Expression", + "type": "seqV :: KnownNat n => Vec n a -> b -> b", + "template": "~ARG[2]" + } + }, + { + "BlackBox": { + "name": "Clash.Sized.Vector.seqVX", + "workInfo" : "Never", + "kind": "Expression", + "type": "seqVX :: KnownNat n => Vec n a -> b -> b", + "template": "~ARG[2]" + } + } +, { "Primitive" : + { "name" : "Clash.Sized.Vector.dfold" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Sized.Vector.dtfold" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Sized.Vector.traverse#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Clash_Transformations.json b/prims/common/Clash_Transformations.json deleted file mode 100644 --- a/prims/common/Clash_Transformations.json +++ /dev/null @@ -1,17 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Transformations.removedArg" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "removedArg :: a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Clash.Transformations.undefined" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "undefined :: forall a . a" - , "template" : "~ERRORO" - } - } -] diff --git a/prims/common/Clash_Transformations.primitives b/prims/common/Clash_Transformations.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_Transformations.primitives @@ -0,0 +1,24 @@ +[ { "BlackBox" : + { "name" : "Clash.Transformations.removedArg" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "removedArg :: a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Clash.Transformations.undefined" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "undefined :: forall a . a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "c$multiPrimSelect" + , "workInfo" : "Always" + , "kind" : "Expression" + , "template" : "!__SHOULD NOT BE RENDERED__! ~ARG[0]~ARG[1]" + } + } +] diff --git a/prims/common/Clash_XException.json b/prims/common/Clash_XException.json deleted file mode 100644 --- a/prims/common/Clash_XException.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.XException.seqX" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "seqX :: a -> b -> b" - , "template" : "~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.XException.errorX" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "errorX :: HasCallStack => String -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Clash.XException.deepseqX" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "deepseqX :: Undefined a => a -> b -> b" - , "template" : "~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.XException.hwSeqX" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "hwSeqX :: a -> b -> b" - , "template" : "~DEVNULL[~VAR[x][0]]~ARG[1]" - } - } -] diff --git a/prims/common/Clash_XException.primitives b/prims/common/Clash_XException.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Clash_XException.primitives @@ -0,0 +1,38 @@ +[ { "BlackBox" : + { "name" : "Clash.XException.seqX" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "seqX :: a -> b -> b" + , "template" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.XException.errorX" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "errorX :: HasCallStack => String -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Clash.XException.deepseqX" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "deepseqX :: Undefined a => a -> b -> b" + , "template" : "~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.XException.hwSeqX" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "hwSeqX :: a -> b -> b" + , "template" : "~DEVNULL[~VAR[x][0]]~ARG[1]" + } + } +, { "Primitive" : + { "name" : "Clash.XException.xToErrorCtx" + , "primType" : "Function" + } + } +] diff --git a/prims/common/Control_Exception_Base.json b/prims/common/Control_Exception_Base.json deleted file mode 100644 --- a/prims/common/Control_Exception_Base.json +++ /dev/null @@ -1,73 +0,0 @@ -[ { "BlackBox" : - { "name" : "Control.Exception.Base.recSelError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "recSelError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.recConError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "recConError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.irrefutPatError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "irrefutPatError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.runtimeError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "runtimeError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.nonExhaustiveGuardsError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "nonExhaustiveGuardsError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.patError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "patError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.noMethodBindingError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "noMethodBindingError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.absentError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "absentError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "Control.Exception.Base.typeError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "typeError :: Addr# -> a" - , "template" : "~ERRORO" - } - } -] diff --git a/prims/common/Control_Exception_Base.primitives b/prims/common/Control_Exception_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Control_Exception_Base.primitives @@ -0,0 +1,73 @@ +[ { "BlackBox" : + { "name" : "Control.Exception.Base.recSelError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "recSelError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.recConError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "recConError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.irrefutPatError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "irrefutPatError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.runtimeError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "runtimeError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.nonExhaustiveGuardsError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "nonExhaustiveGuardsError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.patError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "patError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.noMethodBindingError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "noMethodBindingError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.absentError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "absentError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "Control.Exception.Base.typeError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "typeError :: Addr# -> a" + , "template" : "~ERRORO" + } + } +] diff --git a/prims/common/Debug_Trace.json b/prims/common/Debug_Trace.json deleted file mode 100644 --- a/prims/common/Debug_Trace.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "Debug.Trace.trace" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "trace :: String -> a -> a" - , "template" : "~ARG[1]" - } - } -] diff --git a/prims/common/Debug_Trace.primitives b/prims/common/Debug_Trace.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Debug_Trace.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "Debug.Trace.trace" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "trace :: String -> a -> a" + , "template" : "~ARG[1]" + } + } +] diff --git a/prims/common/GHC_Base.json b/prims/common/GHC_Base.json deleted file mode 100644 --- a/prims/common/GHC_Base.json +++ /dev/null @@ -1,14 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.Base.$" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.quotInt" - , "kind" : "Expression" - , "type" : "quotInt :: Int -> Int -> Int" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -] diff --git a/prims/common/GHC_Base.primitives b/prims/common/GHC_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Base.primitives @@ -0,0 +1,14 @@ +[ { "Primitive" : + { "name" : "GHC.Base.$" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.quotInt" + , "kind" : "Expression" + , "type" : "quotInt :: Int -> Int -> Int" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +] diff --git a/prims/common/GHC_CString.json b/prims/common/GHC_CString.json deleted file mode 100644 --- a/prims/common/GHC_CString.json +++ /dev/null @@ -1,21 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.CString.unpackCString#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "template" : "~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.CString.unpackFoldrCString#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "template" : "~LIT[0]" - } - } -, { "Primitive" : - { "name" : "GHC.CString.unpackCStringUtf8#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/GHC_CString.primitives b/prims/common/GHC_CString.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_CString.primitives @@ -0,0 +1,21 @@ +[ { "BlackBox" : + { "name" : "GHC.CString.unpackCString#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "template" : "~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.CString.unpackFoldrCString#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "template" : "~LIT[0]" + } + } +, { "Primitive" : + { "name" : "GHC.CString.unpackCStringUtf8#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/GHC_Classes.json b/prims/common/GHC_Classes.json deleted file mode 100644 --- a/prims/common/GHC_Classes.json +++ /dev/null @@ -1,29 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.gtInt" - , "kind" : "Expression" - , "type" : "gtInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.geInt" - , "kind" : "Expression" - , "type" : "geInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] >= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.ltInt" - , "kind" : "Expression" - , "type" : "ltInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.leInt" - , "kind" : "Expression" - , "type" : "leInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] <= ~ARG[1]" - } - } -] diff --git a/prims/common/GHC_Classes.primitives b/prims/common/GHC_Classes.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Classes.primitives @@ -0,0 +1,29 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.gtInt" + , "kind" : "Expression" + , "type" : "gtInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.geInt" + , "kind" : "Expression" + , "type" : "geInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] >= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.ltInt" + , "kind" : "Expression" + , "type" : "ltInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.leInt" + , "kind" : "Expression" + , "type" : "leInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] <= ~ARG[1]" + } + } +] diff --git a/prims/common/GHC_Err.json b/prims/common/GHC_Err.json deleted file mode 100644 --- a/prims/common/GHC_Err.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Err.error" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "error :: [Char] -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Err.errorWithoutStackTrace" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "errorWithoutStackTrace :: [Char] -> a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Err.undefined" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "undefined :: a" - , "template" : "~ERRORO" - } - } -] diff --git a/prims/common/GHC_Err.primitives b/prims/common/GHC_Err.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Err.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "GHC.Err.error" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "error :: [Char] -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Err.errorWithoutStackTrace" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "errorWithoutStackTrace :: [Char] -> a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Err.undefined" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "undefined :: a" + , "template" : "~ERRORO" + } + } +] diff --git a/prims/common/GHC_IO_Exception.json b/prims/common/GHC_IO_Exception.json deleted file mode 100644 --- a/prims/common/GHC_IO_Exception.json +++ /dev/null @@ -1,14 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.IO.Exception.assertError" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "assertError :: HasCallStack => Bool -> a -> a" - , "comment" : "It would be nice if we could use a HDL assertion, however, - because in HDL, case alternatives are evaluated - concurrently, we would end up with the assertion being - triggered, even when the result of that branch is not - chosen in the multiplexer" - , "template" : "~ARG[2]" - } - } -] diff --git a/prims/common/GHC_IO_Exception.primitives b/prims/common/GHC_IO_Exception.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_IO_Exception.primitives @@ -0,0 +1,14 @@ +[ { "BlackBox" : + { "name" : "GHC.IO.Exception.assertError" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "assertError :: HasCallStack => Bool -> a -> a" + , "comment" : "It would be nice if we could use a HDL assertion, however, + because in HDL, case alternatives are evaluated + concurrently, we would end up with the assertion being + triggered, even when the result of that branch is not + chosen in the multiplexer" + , "template" : "~ARG[2]" + } + } +] diff --git a/prims/common/GHC_Integer_Type.json b/prims/common/GHC_Integer_Type.json deleted file mode 100644 --- a/prims/common/GHC_Integer_Type.json +++ /dev/null @@ -1,50 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.plusInteger" - , "kind" : "Expression" - , "type" : "plusInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] + ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.minusInteger" - , "kind" : "Expression" - , "type" : "minusInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] - ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.quotInteger" - , "kind" : "Expression" - , "type" : "quotInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.leInteger" - , "kind" : "Expression" - , "type" : "leInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] <= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.gtInteger" - , "kind" : "Expression" - , "type" : "gtInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] > ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.ltInteger" - , "kind" : "Expression" - , "type" : "ltInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] < ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.geInteger" - , "kind" : "Expression" - , "type" : "geInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] >= ~ARG[1]" - } - } -] diff --git a/prims/common/GHC_Integer_Type.primitives b/prims/common/GHC_Integer_Type.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Integer_Type.primitives @@ -0,0 +1,50 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.plusInteger" + , "kind" : "Expression" + , "type" : "plusInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.minusInteger" + , "kind" : "Expression" + , "type" : "minusInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotInteger" + , "kind" : "Expression" + , "type" : "quotInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger" + , "kind" : "Expression" + , "type" : "leInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] <= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger" + , "kind" : "Expression" + , "type" : "gtInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] > ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger" + , "kind" : "Expression" + , "type" : "ltInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] < ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger" + , "kind" : "Expression" + , "type" : "geInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] >= ~ARG[1]" + } + } +] diff --git a/prims/common/GHC_Magic.json b/prims/common/GHC_Magic.json deleted file mode 100644 --- a/prims/common/GHC_Magic.json +++ /dev/null @@ -1,20 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.Magic.lazy" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "GHC.Magic.noinline" - , "workInfo" : "Never" - , "type" : "forall a. a -> a" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "GHC.Magic.runRW#" - , "workInfo" : "Never" - , "primType" : "Function" - } - } -] diff --git a/prims/common/GHC_Magic.primitives b/prims/common/GHC_Magic.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Magic.primitives @@ -0,0 +1,20 @@ +[ { "Primitive" : + { "name" : "GHC.Magic.lazy" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "GHC.Magic.noinline" + , "workInfo" : "Never" + , "type" : "forall a. a -> a" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "GHC.Magic.runRW#" + , "workInfo" : "Never" + , "primType" : "Function" + } + } +] diff --git a/prims/common/GHC_Natural.json b/prims/common/GHC_Natural.json deleted file mode 100644 --- a/prims/common/GHC_Natural.json +++ /dev/null @@ -1,51 +0,0 @@ -[ - { - "Primitive": { - "name": "GHC.Natural.NatS#", - "workInfo" : "Never", - "primType": "Constructor" - } - }, - { - "Primitive": { - "name": "GHC.Natural.naturalToInteger", - "workInfo": "Never", - "primType": "Function", - "warning": "GHC.Natural.naturalToInteger: No blackbox available without size inference for Natural and Integer" - } - }, - { - "BlackBox": { - "name": "GHC.Natural.underflowError", - "workInfo" : "Constant", - "kind": "Expression", - "type": "underflowError :: a", - "template": "~ERRORO" - } - }, - { - "BlackBox": { - "name": "GHC.Natural.plusNatural", - "kind": "Expression", - "type": "plusNatural :: Natural -> Natural -> Natural", - "template": "~ARG[0] + ~ARG[1]", - "warning": "GHC.Natural.plusNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "BlackBox": { - "name": "GHC.Natural.minusNatural", - "kind": "Expression", - "type": "minusNatural :: Natural -> Natural -> Natural", - "template": "~ARG[0] - ~ARG[1]", - "warning": "GHC.Natural.minusNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "Primitive": { - "name": "GHC.Natural.gcdNatural", - "workInfo" : "Never", - "primType": "Function" - } - } -] diff --git a/prims/common/GHC_Natural.primitives b/prims/common/GHC_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Natural.primitives @@ -0,0 +1,52 @@ +[ + { + "Primitive": { + "name": "GHC.Natural.NatS#", + "workInfo" : "Never", + "primType": "Constructor", + "comment": "Needed to make the evaluator handle this constructor strictly" + } + }, + { + "Primitive": { + "name": "GHC.Natural.naturalToInteger", + "workInfo": "Never", + "primType": "Function", + "warning": "GHC.Natural.naturalToInteger: No blackbox available without size inference for Natural and Integer" + } + }, + { + "BlackBox": { + "name": "GHC.Natural.underflowError", + "workInfo" : "Constant", + "kind": "Expression", + "type": "underflowError :: a", + "template": "~ERRORO" + } + }, + { + "BlackBox": { + "name": "GHC.Natural.plusNatural", + "kind": "Expression", + "type": "plusNatural :: Natural -> Natural -> Natural", + "template": "~ARG[0] + ~ARG[1]", + "warning": "GHC.Natural.plusNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Natural.minusNatural", + "kind": "Expression", + "type": "minusNatural :: Natural -> Natural -> Natural", + "template": "~ARG[0] - ~ARG[1]", + "warning": "GHC.Natural.minusNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "Primitive": { + "name": "GHC.Natural.gcdNatural", + "workInfo" : "Never", + "primType": "Function" + } + } +] diff --git a/prims/common/GHC_Num_Integer.primitives b/prims/common/GHC_Num_Integer.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Num_Integer.primitives @@ -0,0 +1,78 @@ +[ { "Primitive": + { "name": "GHC.Num.Integer.IS" + , "workInfo": "Never" + , "primType": "Constructor" + , "comment": "Needed to make the evaluator handle this constructor strictly" + } +} +, { "Primitive": + { "name": "GHC.Num.Integer.IP" + , "workInfo": "Never" + , "primType": "Constructor" + , "comment": "Needed to make the evaluator handle this constructor strictly" + } +} +, { "Primitive": + { "name": "GHC.Num.Integer.IN" + , "workInfo": "Never" + , "primType": "Constructor" + , "comment": "Needed to make the evaluator handle this constructor strictly" + } +} +, { "Primitive": + { "name": "GHC.Num.Integer.integerFromNatural" + , "workInfo": "Never" + , "primType": "Function" + , "warning": "GHC.Num.Integer.integerFromNatural: No blackbox available without size inference for Natural and Integer" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerAdd" + , "kind" : "Expression" + , "type" : "integerAdd :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] + ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerSub" + , "kind" : "Expression" + , "type" : "integerSub :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] - ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerQuot" + , "kind" : "Expression" + , "type" : "integerQuot :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] / ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLe" + , "kind" : "Expression" + , "type" : "integerLe :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] <= ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGt" + , "kind" : "Expression" + , "type" : "integerGt :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] > ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLt" + , "kind" : "Expression" + , "type" : "integerLt :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] < ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGe" + , "kind" : "Expression" + , "type" : "integerGe :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] >= ~ARG[1]" + } +} +] diff --git a/prims/common/GHC_Num_Natural.primitives b/prims/common/GHC_Num_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Num_Natural.primitives @@ -0,0 +1,84 @@ +[ + { + "Primitive": { + "name": "GHC.Num.Natural.NS", + "workInfo" : "Never", + "primType": "Constructor", + "comment": "Needed to make the evaluator handle this constructor strictly" + } + }, + { + "Primitive": { + "name": "GHC.Num.Natural.NB", + "workInfo" : "Never", + "primType": "Constructor", + "comment": "Needed to make the evaluator handle this constructor strictly" + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalAdd", + "kind": "Expression", + "type": "naturalSub :: Natural -> Natural -> Natural", + "template": "~ARG[0] + ~ARG[1]", + "warning": "GHC.Num.Natural.naturalAdd: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "Primitive": { + "name": "GHC.Num.Natural.naturalSub", + "workInfo" : "Never", + "primType": "Function" + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalSubUnsafe", + "kind": "Expression", + "type": "naturalSubUnsafe :: Natural -> Natural -> Natural", + "template": "~ARG[0] - ~ARG[1]", + "warning": "GHC.Num.Natural.naturalSubUnsafe: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalSubThrow", + "kind": "Expression", + "type": "naturalSubThrow :: Natural -> Natural -> Natural", + "template": "~ARG[0] - ~ARG[1]", + "warning": "GHC.Num.Natural.naturalSubThrow: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalMul", + "kind": "Expression", + "type": "naturalMul :: Natural -> Natural -> Natural", + "template": "~ARG[0] * ~ARG[1]", + "warning": "GHC.Num.Natural.naturalMul: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalQuot", + "kind": "Expression", + "type": "naturalQuot :: Natural -> Natural -> Natural", + "template": "~ARG[0] / ~ARG[1]", + "warning": "GHC.Num.Natural.naturalQuot: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "Primitive": { + "name": "GHC.Num.Natural.naturalGcd", + "workInfo" : "Never", + "primType": "Function" + } + }, + { + "Primitive": { + "name": "GHC.Num.Natural.naturalLcm", + "workInfo" : "Never", + "primType": "Function" + } + } +] diff --git a/prims/common/GHC_Prim.json b/prims/common/GHC_Prim.json deleted file mode 100644 --- a/prims/common/GHC_Prim.json +++ /dev/null @@ -1,61 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.Prim.dataToTag#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "GHC.Prim.tagToEnum#" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.unsafeCoerce#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unsafeCoerce# :: a -> b" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.+#" - , "kind" : "Expression" - , "type" : "(+#) :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] + ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.-#" - , "kind" : "Expression" - , "type" : "(-#) :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] - ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotInt#" - , "kind" : "Expression" - , "type" : "quotInt# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.plusWord#" - , "kind" : "Expression" - , "type" : "plusWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] + ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.minusWord#" - , "kind" : "Expression" - , "type" : "minusWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] - ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotWord#" - , "kind" : "Expression" - , "type" : "quotWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] / ~ARG[1]" - } - } -] diff --git a/prims/common/GHC_Prim.primitives b/prims/common/GHC_Prim.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Prim.primitives @@ -0,0 +1,61 @@ +[ { "Primitive" : + { "name" : "GHC.Prim.dataToTag#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "GHC.Prim.tagToEnum#" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.unsafeCoerce#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unsafeCoerce# :: a -> b" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.+#" + , "kind" : "Expression" + , "type" : "(+#) :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.-#" + , "kind" : "Expression" + , "type" : "(-#) :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotInt#" + , "kind" : "Expression" + , "type" : "quotInt# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.plusWord#" + , "kind" : "Expression" + , "type" : "plusWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] + ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.minusWord#" + , "kind" : "Expression" + , "type" : "minusWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] - ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotWord#" + , "kind" : "Expression" + , "type" : "quotWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] / ~ARG[1]" + } + } +] diff --git a/prims/common/GHC_Real.json b/prims/common/GHC_Real.json deleted file mode 100644 --- a/prims/common/GHC_Real.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Real.divZeroError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "divZeroError :: a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Real.ratioZeroDenominatorError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "ratioZeroDenominatorError :: a" - , "template" : "~ERRORO" - } - } -, { "BlackBox" : - { "name" : "GHC.Real.overflowError" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "overflowError :: a" - , "template" : "~ERRORO" - } - } -] diff --git a/prims/common/GHC_Real.primitives b/prims/common/GHC_Real.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Real.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "GHC.Real.divZeroError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "divZeroError :: a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.ratioZeroDenominatorError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "ratioZeroDenominatorError :: a" + , "template" : "~ERRORO" + } + } +, { "BlackBox" : + { "name" : "GHC.Real.overflowError" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "overflowError :: a" + , "template" : "~ERRORO" + } + } +] diff --git a/prims/common/GHC_TypeNats.json b/prims/common/GHC_TypeNats.json deleted file mode 100644 --- a/prims/common/GHC_TypeNats.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.TypeNats.natVal" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "natVal :: forall n proxy. KnownNat n => proxy n -> Natural" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/GHC_TypeNats.primitives b/prims/common/GHC_TypeNats.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_TypeNats.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "GHC.TypeNats.natVal" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "natVal :: forall n proxy. KnownNat n => proxy n -> Natural" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/common/GHC_Typelits.json b/prims/common/GHC_Typelits.json deleted file mode 100644 --- a/prims/common/GHC_Typelits.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.TypeLits.natVal" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "natVal :: forall n proxy. KnownNat n => proxy n -> Integer" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/GHC_Typelits.primitives b/prims/common/GHC_Typelits.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Typelits.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "GHC.TypeLits.natVal" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "natVal :: forall n proxy. KnownNat n => proxy n -> Integer" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/common/GHC_Types.json b/prims/common/GHC_Types.json deleted file mode 100644 --- a/prims/common/GHC_Types.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "Primitive" : - { "name" : "GHC.Types.MkCoercible" - , "workInfo" : "Never" - , "primType" : "Constructor" - } - } -, { "BlackBox" : - { "name" : "GHC.Types.C#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I# :: Char# -> Char" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Types.I#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I# :: Int# -> Int" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Types.W#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "W# :: Word# -> Word" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/GHC_Types.primitives b/prims/common/GHC_Types.primitives new file mode 100644 --- /dev/null +++ b/prims/common/GHC_Types.primitives @@ -0,0 +1,31 @@ +[ { "Primitive" : + { "name" : "GHC.Types.MkCoercible" + , "workInfo" : "Never" + , "primType" : "Constructor" + } + } +, { "BlackBox" : + { "name" : "GHC.Types.C#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I# :: Char# -> Char" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Types.I#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I# :: Int# -> Int" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Types.W#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "W# :: Word# -> Word" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/common/Unsafe_Coerce.json b/prims/common/Unsafe_Coerce.json deleted file mode 100644 --- a/prims/common/Unsafe_Coerce.json +++ /dev/null @@ -1,9 +0,0 @@ -[ { "BlackBox" : - { "name" : "Unsafe.Coerce.unsafeCoerce" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unsafeCoerce :: a -> b" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/common/Unsafe_Coerce.primitives b/prims/common/Unsafe_Coerce.primitives new file mode 100644 --- /dev/null +++ b/prims/common/Unsafe_Coerce.primitives @@ -0,0 +1,9 @@ +[ { "BlackBox" : + { "name" : "Unsafe.Coerce.unsafeCoerce" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unsafeCoerce :: a -> b" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/commonverilog/Clash_Class_Exp.json b/prims/commonverilog/Clash_Class_Exp.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Class_Exp.json +++ /dev/null @@ -1,29 +0,0 @@ -[ - { - "BlackBox": { - "name": "Clash.Class.Exp.expIndex#", - "kind": "Declaration", - "type": "expIndex# :: KnownNat m => Index m -> SNat n -> Index (m^n)", - "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$signed(~ARG[1] ** ~LIT[2]);", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - }, - { - "BlackBox": { - "name": "Clash.Class.Exp.expSigned#", - "kind": "Declaration", - "type": "expSigned# :: KnownNat m => Signed m -> SNat n -> Signed (m*n)", - "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$signed(~ARG[1] ** ~LIT[2]);", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - }, - { - "BlackBox": { - "name": "Clash.Class.Exp.expUnsigned#", - "kind": "Declaration", - "type": "expUnsigned# :: KnownNat m => Unsigned m -> SNat n -> Unsigned (m*n)", - "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$unsigned(~ARG[1] ** ~LIT[2]);", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - } -] diff --git a/prims/commonverilog/Clash_Class_Exp.primitives b/prims/commonverilog/Clash_Class_Exp.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Class_Exp.primitives @@ -0,0 +1,29 @@ +[ + { + "BlackBox": { + "name": "Clash.Class.Exp.expIndex#", + "kind": "Declaration", + "type": "expIndex# :: KnownNat m => Index m -> SNat n -> Index (m^n)", + "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$signed(~ARG[1] ** ~LIT[2]);", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + }, + { + "BlackBox": { + "name": "Clash.Class.Exp.expSigned#", + "kind": "Declaration", + "type": "expSigned# :: KnownNat m => Signed m -> SNat n -> Signed (m*n)", + "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$signed(~ARG[1] ** ~LIT[2]);", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + }, + { + "BlackBox": { + "name": "Clash.Class.Exp.expUnsigned#", + "kind": "Declaration", + "type": "expUnsigned# :: KnownNat m => Unsigned m -> SNat n -> Unsigned (m*n)", + "template": "assign ~RESULT = ~DEVNULL[~ARG[0]]$unsigned(~ARG[1] ** ~LIT[2]);", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + } +] diff --git a/prims/commonverilog/Clash_Explicit_SimIO.json b/prims/commonverilog/Clash_Explicit_SimIO.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Explicit_SimIO.json +++ /dev/null @@ -1,127 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Explicit.SimIO.mealyIO" - , "primType" : "Function" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.display" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "$display(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.finish" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "$finish_and_return(~LIT[0]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.reg" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.readReg" - , "kind" : "Expression" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.writeReg" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "~ARG[0] = ~ARG[1];" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.openFile" - , "kind" : "Expression" - , "template" : "$fopen(~FILE[~LIT[0]],~LIT[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.closeFile" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "$fclose(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.getChar" - , "kind" : "Expression" - , "template" : "$fgetc(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.putChar" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "$ungetc(~ARG[0],~ARG[1]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.getLine" - , "kind" : "Declaration" - , "template" : "~RESULT = $fgets(~ARG[2],~ARG[1]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.isEOF" - , "kind" : "Expression" - , "template" : "$feof(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.flush" - , "kind" : "Declaration" - , "renderVoid" : "RenderVoid" - , "template" : "$fflush(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.seek" - , "kind" : "Declaration" - , "template" : "~RESULT = $fseek(~ARG[0],~ARG[1],~ARG[2]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.rewind" - , "kind" : "Declaration" - , "template" : "~RESULT = $rewind(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.SimIO.tell" - , "kind" : "Expression" - , "template" : "$ftell(~ARG[0])" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.fmapSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.pureSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.apSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.bindSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.unSimIO#" - , "primType" : "Function" - } - } -] diff --git a/prims/commonverilog/Clash_Explicit_SimIO.primitives b/prims/commonverilog/Clash_Explicit_SimIO.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Explicit_SimIO.primitives @@ -0,0 +1,127 @@ +[ { "Primitive" : + { "name" : "Clash.Explicit.SimIO.mealyIO" + , "primType" : "Function" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.display" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "$display(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.finish" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "$finish_and_return(~LIT[0]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.reg" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.readReg" + , "kind" : "Expression" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.writeReg" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "~ARG[0] = ~ARG[1];" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.openFile" + , "kind" : "Expression" + , "template" : "$fopen(~FILE[~LIT[0]],~LIT[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.closeFile" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "$fclose(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.getChar" + , "kind" : "Expression" + , "template" : "$fgetc(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.putChar" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "$ungetc(~ARG[0],~ARG[1]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.getLine" + , "kind" : "Declaration" + , "template" : "~RESULT = $fgets(~ARG[2],~ARG[1]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.isEOF" + , "kind" : "Expression" + , "template" : "$feof(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.flush" + , "kind" : "Declaration" + , "renderVoid" : "RenderVoid" + , "template" : "$fflush(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.seek" + , "kind" : "Declaration" + , "template" : "~RESULT = $fseek(~ARG[0],~ARG[1],~ARG[2]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.rewind" + , "kind" : "Declaration" + , "template" : "~RESULT = $rewind(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.SimIO.tell" + , "kind" : "Expression" + , "template" : "$ftell(~ARG[0])" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.fmapSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.pureSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.apSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.bindSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.unSimIO#" + , "primType" : "Function" + } + } +] diff --git a/prims/commonverilog/Clash_Intel_DDR.json b/prims/commonverilog/Clash_Intel_DDR.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Intel_DDR.json +++ /dev/null @@ -1,49 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Intel.DDR.altddioOut#" - , "kind" : "Declaration" - , "type" : -"altddioOut# - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - => SSymbol deviceFamily -- ARG[4] - -> Clock slow -- ARG[5] - -> Reset slow -- ARG[6] - -> Enable slow -- ARG[7] - -> Signal slow (BitVector m) -- ARG[8] - -> Signal slow (BitVector m) -- ARG[9] - -> Signal fast (BitVector m)" - , "libraries" : ["altera_mf"] - , "template" : -"// altddioOut begin -altddio_out - #( - .extend_oe_disable (\"OFF\"), - .intended_device_family (~LIT[4]), - .invert_output (\"OFF\"), - .lpm_hint (\"UNUSED\"), - .lpm_type (\"altddio_out\"), - .oe_reg (\"UNREGISTERED\"), - .power_up_high (\"OFF\"), - .width (~SIZE[~TYPO]) - ) - ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), - .aclr (1'b0),~ELSE - .aclr (~ARG[6]), - .sclr (1'b0),~FI - .datain_h (~ARG[8]), - .datain_l (~ARG[9]), - .outclock (~ARG[5]), - .outclocken (~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] ~ELSE 1'b1 ~FI), - .dataout (~RESULT), - .aset (1'b0), - .sset (1'b0), - .oe (1'b1), - .oe_out () - ); -// altddioOut end" - } - } -] diff --git a/prims/commonverilog/Clash_Intel_DDR.primitives b/prims/commonverilog/Clash_Intel_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Intel_DDR.primitives @@ -0,0 +1,49 @@ +[ { "BlackBox" : + { "name" : "Clash.Intel.DDR.altddioOut#" + , "kind" : "Declaration" + , "type" : +"altddioOut# + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + => SSymbol deviceFamily -- ARG[4] + -> Clock slow -- ARG[5] + -> Reset slow -- ARG[6] + -> Enable slow -- ARG[7] + -> Signal slow (BitVector m) -- ARG[8] + -> Signal slow (BitVector m) -- ARG[9] + -> Signal fast (BitVector m)" + , "libraries" : ["altera_mf"] + , "template" : +"// altddioOut begin +altddio_out + #( + .extend_oe_disable (\"OFF\"), + .intended_device_family (~LIT[4]), + .invert_output (\"OFF\"), + .lpm_hint (\"UNUSED\"), + .lpm_type (\"altddio_out\"), + .oe_reg (\"UNREGISTERED\"), + .power_up_high (\"OFF\"), + .width (~SIZE[~TYPO]) + ) + ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] (~IF ~ISSYNC[2] ~THEN + .sclr (~ARG[6]), + .aclr (1'b0),~ELSE + .aclr (~ARG[6]), + .sclr (1'b0),~FI + .datain_h (~ARG[8]), + .datain_l (~ARG[9]), + .outclock (~ARG[5]), + .outclocken (~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] ~ELSE 1'b1 ~FI), + .dataout (~RESULT), + .aset (1'b0), + .sset (1'b0), + .oe (1'b1), + .oe_out () + ); +// altddioOut end" + } + } +] diff --git a/prims/commonverilog/Clash_Magic.primitives b/prims/commonverilog/Clash_Magic.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Magic.primitives @@ -0,0 +1,13 @@ +[ { "BlackBox" : + { "name" : "Clash.Magic.nameHint" + , "kind" : "Declaration" + , "type" : +"nameHint + :: SSymbol sym -- ARG[0] + -> a -- ARG[1] + -> a" + , "resultName" : { "template" : "~NAME[0]" } + , "template" : "assign ~RESULT = ~ARG[1];" + } + } +] diff --git a/prims/commonverilog/Clash_Promoted_Nat.json b/prims/commonverilog/Clash_Promoted_Nat.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Promoted_Nat.json +++ /dev/null @@ -1,78 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Promoted.Nat.flogBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.flogBaseSNat :: (2 <= base, 1 <= x) - => SNat base -- ARG[2] - -> SNat x -- ARG[3] - -> SNat (FLog base x" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "flogBase" - , "extension" : "inc" - , "template" : -"// floor of logBase -function integer ~INCLUDENAME[0]; - input integer base, value; - begin - for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) - value = value / base; - end -endfunction" - } - ] - , "template" : "~INCLUDENAME[0](~LIT[2],~LIT[3])" - } - } -, { "BlackBox" : - { "name" : "Clash.Promoted.Nat.clogBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.clogBaseSNat :: (2 <= base, 1 <= x) - => SNat base -- ARG[2] - -> SNat x -- ARG[3] - -> SNat (CLog base x" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "clogBase" - , "extension" : "inc" - , "template" : -"// ceiling of logBase -function integer ~INCLUDENAME[0]; - input integer base, value; - begin - for (~INCLUDENAME[0] = 0; base ** ~INCLUDENAME[0] < value; ~~INCLUDENAME[0]=~INCLUDENAME[0]+1); - end -endfunction" - } - ] - , "template" : "~INCLUDENAME[0](~LIT[2],~LIT[3])" - } - } -, { "BlackBox" : - { "name" : "Clash.Promoted.Nat.logBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.logBaseSNat :: (FLog base x ~ CLog base x) - => SNat base -- ARG[1] - -> SNat x -- ARG[2] - -> SNat (Log base x)" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "clogBase" - , "extension" : "inc" - , "template" : -"// logBaseSNat begin -function integer ~INCLUDENAME[0]; - input integer base, value; - begin - for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) - value = value / base; - end -endfunction" - } - ] - , "template" : "~INCLUDENAME[0](~LIT[1],~LIT[2])" - } - } -] diff --git a/prims/commonverilog/Clash_Promoted_Nat.primitives b/prims/commonverilog/Clash_Promoted_Nat.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Promoted_Nat.primitives @@ -0,0 +1,78 @@ +[ { "BlackBox" : + { "name" : "Clash.Promoted.Nat.flogBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.flogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (FLog base x" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "flogBase" + , "extension" : "inc" + , "template" : +"// floor of logBase +function integer ~INCLUDENAME[0]; + input integer base, value; + begin + for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) + value = value / base; + end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~LIT[2],~LIT[3])" + } + } +, { "BlackBox" : + { "name" : "Clash.Promoted.Nat.clogBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.clogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (CLog base x" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "clogBase" + , "extension" : "inc" + , "template" : +"// ceiling of logBase +function integer ~INCLUDENAME[0]; + input integer base, value; + begin + for (~INCLUDENAME[0] = 0; base ** ~INCLUDENAME[0] < value; ~~INCLUDENAME[0]=~INCLUDENAME[0]+1); + end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~LIT[2],~LIT[3])" + } + } +, { "BlackBox" : + { "name" : "Clash.Promoted.Nat.logBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.logBaseSNat :: (FLog base x ~ CLog base x) + => SNat base -- ARG[1] + -> SNat x -- ARG[2] + -> SNat (Log base x)" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "clogBase" + , "extension" : "inc" + , "template" : +"// logBaseSNat begin +function integer ~INCLUDENAME[0]; + input integer base, value; + begin + for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) + value = value / base; + end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~LIT[1],~LIT[2])" + } + } +] diff --git a/prims/commonverilog/Clash_Signal_Internal.json b/prims/commonverilog/Clash_Signal_Internal.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Signal_Internal.json +++ /dev/null @@ -1,27 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.Internal.unsafeFromReset" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"unsafeFromReset :: Reset dom -> Signal dom Bool" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.unsafeToReset" - , "kind" : "Expression" - , "workInfo" : "Never" - , "type" : -"unsafeToReset :: Signal dom Bool -> Reset dom" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.tbEnableGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : "tbEnableGen :: Enable dom" - , "template" : "assign ~RESULT = 1'b1;" - } - } -] diff --git a/prims/commonverilog/Clash_Signal_Internal.primitives b/prims/commonverilog/Clash_Signal_Internal.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Signal_Internal.primitives @@ -0,0 +1,27 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.Internal.unsafeFromReset" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"unsafeFromReset :: Reset dom -> Signal dom Bool" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.unsafeToReset" + , "kind" : "Expression" + , "workInfo" : "Never" + , "type" : +"unsafeToReset :: Signal dom Bool -> Reset dom" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.tbEnableGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : "tbEnableGen :: Enable dom" + , "template" : "assign ~RESULT = 1'b1;" + } + } +] diff --git a/prims/commonverilog/Clash_Sized_Internal_BitVector.json b/prims/commonverilog/Clash_Sized_Internal_BitVector.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Sized_Internal_BitVector.json +++ /dev/null @@ -1,375 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.BV" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "BV :: Integer -> Integer -> BitVector n" - , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BITVECTOR INTERNALS" - , "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.Bit" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Bit :: Integer -> Integer -> BitVector n" - , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BIT INTERNALS" - , "template" : "~VAR[i][1][0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.high" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "high :: Bit" - , "template" : "1'b1" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.low" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "low :: Bit" - , "template" : "1'b0" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Bit -> BitVector 1" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: BitVector 1 -> Bit" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceAnd#" - , "kind" : "Expression" - , "type" : "reduceAnd# :: KnownNat n => BitVector n -> Bit" - , "template" : "~IF~SIZE[~TYP[1]]~THEN& (~ARG[1])~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceOr#" - , "kind" : "Expression" - , "type" : "reduceOr# :: KnownNat n => BitVector n -> Bit" - , "template" : "~IF~SIZE[~TYP[1]]~THEN| (~ARG[1])~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceXor#" - , "kind" : "Expression" - , "type" : "reduceXor# :: KnownNat n => BitVector n -> Bit" - , "template" : "~IF~SIZE[~TYP[1]]~THEN^ (~ARG[1])~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.eq##" - , "kind" : "Expression" - , "type" : "eq## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] == ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.neq##" - , "kind" : "Expression" - , "type" : "neq## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] != ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.fromInteger##" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger## :: Integer -> Integer -> Bit" - , "template" : "~VAR[i][0][0] ? 1'bx : ~VAR[i][1][0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.and##" - , "kind" : "Expression" - , "type" : "and## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.or##" - , "kind" : "Expression" - , "type" : "or## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.xor##" - , "kind" : "Expression" - , "type" : "xor## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] ^ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.complement##" - , "kind" : "Expression" - , "type" : "complement## :: Bit -> Bit" - , "template" : "~ ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.eq#" - , "kind" : "Expression" - , "type" : "eq# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] == ~ARG[2]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.neq#" - , "kind" : "Expression" - , "type" : "neq# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] != ~ARG[2]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.lt#" - , "kind" : "Expression" - , "type" : "lt# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] < ~ARG[2]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.ge#" - , "kind" : "Expression" - , "type" : "ge# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] >= ~ARG[2]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.gt#" - , "kind" : "Expression" - , "type" : "gt# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] > ~ARG[2]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.le#" - , "kind" : "Expression" - , "type" : "le# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] <= ~ARG[2]~ELSE1'b1~FI" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.BitVector.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.bvToIntegerVerilog" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => BitVector n -> Int" - , "template" : "~SIZE[~TYPO]'sd~SIZE[~TYP[1]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.maxIndex#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxIndex# :: KnownNat n => BitVector n -> Int" - , "template" : "~SIZE[~TYPO]'sd~SIZE[~TYP[1]] - ~SIZE[~TYPO]'sd1" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.++#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)" - , "template" : "~IF~AND[~SIZE[~TYP[1]],~SIZE[~TYP[2]]]~THEN{~ARG[1],~ARG[2]}~ELSE~IF~SIZE[~TYP[1]]~THEN~ARG[1]~ELSE~ARG[2]~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.index#" - , "kind" : "Expression" - , "type" : -"index# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Int -- ARG[2] - -> Bit" - , "template" : "~VAR[bv][1][~ARG[2]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.slice#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"slice# :: BitVector (m + 1 + i) -- ARG[0] - -> SNat m -- ARG[1] - -> SNat n -- ARG[2] - -> BitVector (m + 1 - n)" - , "template" : "~VAR[bv][0][~LIT[1] : ~LIT[2]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.msb#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"msb# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Bit" - , "template" : "~IF ~SIZE[~TYP[1]] ~THEN ~VAR[bv][1][~SIZE[~TYP[1]]-1] ~ELSE 1'b0 ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.lsb#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"lsb# :: BitVector n -- ARG[0] - -> Bit" - , "template" : "~IF ~SIZE[~TYP[0]] ~THEN ~VAR[bv][0][0] ~ELSE 1'b0 ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: BitVector n" - , "template" : "~SIZE[~TYPO]'d0" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => BitVector n" - , "template" : "{~SIZE[~TYPO] {1'b1}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] * ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => BitVector n -> BitVector n" - , "template" : "-~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Integer -> BitVector n" - , "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.plus#" - , "kind" : "Declaration" - , "type" : "plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] + ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN~ARG[2]~ELSE~ARG[3]~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.minus#" - , "kind" : "Declaration" - , "type" : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] - ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN~ARG[2]~ELSE-~ARG[3]~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.times#" - , "kind" : "Declaration" - , "type" : "times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] * ~ARG[3]~ELSE~SIZE[~TYPO]'d0~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.quot#" - , "kind" : "Expression" - , "type" : "quot# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] / ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rem#" - , "kind" : "Expression" - , "type" : "rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] % ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.and#" - , "kind" : "Expression" - , "type" : "and# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] & ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.or#" - , "kind" : "Expression" - , "type" : "or# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] | ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.xor#" - , "kind" : "Expression" - , "type" : "xor# :: KnownNat => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] ^ ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => BitVector n -> BitVector n" - , "template" : "~ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "~ARG[1] << ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "~ARG[1] >> ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.truncateB#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "truncateB# :: forall a b . KnownNat a => BitVector (a + b) -> BitVector a" - , "template" : "~VAR[bv][1][0+:~SIZE[~TYPO]]" - } - } -] diff --git a/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives b/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Sized_Internal_BitVector.primitives @@ -0,0 +1,375 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.BV" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "BV :: Integer -> Integer -> BitVector n" + , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BITVECTOR INTERNALS" + , "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.Bit" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Bit :: Integer -> Integer -> BitVector n" + , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BIT INTERNALS" + , "template" : "~VAR[i][1][0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.high" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "high :: Bit" + , "template" : "1'b1" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.low" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "low :: Bit" + , "template" : "1'b0" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Bit -> BitVector 1" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: BitVector 1 -> Bit" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceAnd#" + , "kind" : "Expression" + , "type" : "reduceAnd# :: KnownNat n => BitVector n -> Bit" + , "template" : "~IF~SIZE[~TYP[1]]~THEN& (~ARG[1])~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceOr#" + , "kind" : "Expression" + , "type" : "reduceOr# :: KnownNat n => BitVector n -> Bit" + , "template" : "~IF~SIZE[~TYP[1]]~THEN| (~ARG[1])~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceXor#" + , "kind" : "Expression" + , "type" : "reduceXor# :: KnownNat n => BitVector n -> Bit" + , "template" : "~IF~SIZE[~TYP[1]]~THEN^ (~ARG[1])~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.eq##" + , "kind" : "Expression" + , "type" : "eq## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] == ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.neq##" + , "kind" : "Expression" + , "type" : "neq## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] != ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromInteger##" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger## :: Integer -> Integer -> Bit" + , "template" : "~VAR[i][0][0] ? 1'bx : ~VAR[i][1][0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.and##" + , "kind" : "Expression" + , "type" : "and## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.or##" + , "kind" : "Expression" + , "type" : "or## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.xor##" + , "kind" : "Expression" + , "type" : "xor## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.complement##" + , "kind" : "Expression" + , "type" : "complement## :: Bit -> Bit" + , "template" : "~ ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.eq#" + , "kind" : "Expression" + , "type" : "eq# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] == ~ARG[2]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.neq#" + , "kind" : "Expression" + , "type" : "neq# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] != ~ARG[2]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.lt#" + , "kind" : "Expression" + , "type" : "lt# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] < ~ARG[2]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.ge#" + , "kind" : "Expression" + , "type" : "ge# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] >= ~ARG[2]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.gt#" + , "kind" : "Expression" + , "type" : "gt# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] > ~ARG[2]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.le#" + , "kind" : "Expression" + , "type" : "le# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] <= ~ARG[2]~ELSE1'b1~FI" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.BitVector.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.bvToIntegerVerilog" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => BitVector n -> Int" + , "template" : "~SIZE[~TYPO]'sd~SIZE[~TYP[1]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.maxIndex#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxIndex# :: KnownNat n => BitVector n -> Int" + , "template" : "~SIZE[~TYPO]'sd~SIZE[~TYP[1]] - ~SIZE[~TYPO]'sd1" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.++#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)" + , "template" : "~IF~AND[~SIZE[~TYP[1]],~SIZE[~TYP[2]]]~THEN{~ARG[1],~ARG[2]}~ELSE~IF~SIZE[~TYP[1]]~THEN~ARG[1]~ELSE~ARG[2]~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.index#" + , "kind" : "Expression" + , "type" : +"index# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit" + , "template" : "~VAR[bv][1][~ARG[2]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.slice#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"slice# :: BitVector (m + 1 + i) -- ARG[0] + -> SNat m -- ARG[1] + -> SNat n -- ARG[2] + -> BitVector (m + 1 - n)" + , "template" : "~VAR[bv][0][~LIT[1] : ~LIT[2]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.msb#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"msb# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Bit" + , "template" : "~IF ~SIZE[~TYP[1]] ~THEN ~VAR[bv][1][~SIZE[~TYP[1]]-1] ~ELSE 1'b0 ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.lsb#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"lsb# :: BitVector n -- ARG[0] + -> Bit" + , "template" : "~IF ~SIZE[~TYP[0]] ~THEN ~VAR[bv][0][0] ~ELSE 1'b0 ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: BitVector n" + , "template" : "~SIZE[~TYPO]'d0" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => BitVector n" + , "template" : "{~SIZE[~TYPO] {1'b1}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => BitVector n -> BitVector n" + , "template" : "-~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Integer -> BitVector n" + , "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.plus#" + , "kind" : "Declaration" + , "type" : "plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] + ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN~ARG[2]~ELSE~ARG[3]~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.minus#" + , "kind" : "Declaration" + , "type" : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] - ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN~ARG[2]~ELSE-~ARG[3]~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.times#" + , "kind" : "Declaration" + , "type" : "times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN~ARG[2] * ~ARG[3]~ELSE~SIZE[~TYPO]'d0~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.quot#" + , "kind" : "Expression" + , "type" : "quot# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] / ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rem#" + , "kind" : "Expression" + , "type" : "rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] % ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.and#" + , "kind" : "Expression" + , "type" : "and# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] & ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.or#" + , "kind" : "Expression" + , "type" : "or# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] | ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.xor#" + , "kind" : "Expression" + , "type" : "xor# :: KnownNat => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] ^ ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => BitVector n -> BitVector n" + , "template" : "~ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "~ARG[1] << ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "~ARG[1] >> ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.truncateB#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "truncateB# :: forall a b . KnownNat a => BitVector (a + b) -> BitVector a" + , "template" : "~VAR[bv][1][0+:~SIZE[~TYPO]]" + } + } +] diff --git a/prims/commonverilog/Clash_Sized_Internal_Index.json b/prims/commonverilog/Clash_Sized_Internal_Index.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Sized_Internal_Index.json +++ /dev/null @@ -1,138 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Index n -> BitVector (CLog 2 n)" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n" - , "template" : "~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.le#" - , "kind" : "Expression" - , "type" : "le# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Index n" - , "template" : "~ARG[0]-~SIZE[~TYPO]'d1" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "~ARG[1] * ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> 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.plus#" - , "kind" : "Declaration" - , "type" : "Index m -> Index n -> Index (m + n - 1)" - , "template" : "assign ~RESULT = ~ARG[0] + ~ARG[1];" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.minus#" - , "kind" : "Declaration" - , "type" : "Index m -> Index n -> Index (m + n - 1)" - , "template" : "assign ~RESULT = ~ARG[0] - ~ARG[1];" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.times#" - , "kind" : "Declaration" - , "type" : "Index m -> Index n -> Index (((m-1) * (n-1)) + 1)" - , "template" : "assign ~RESULT = ~ARG[0] * ~ARG[1];" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Index n -> Index n -> Index n" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Index.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.indexToIntegerVerilog" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: KnownNat m => Index n -> Index m" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN~VAR[bv][1][0+:~SIZE[~TYPO]]~ELSE{{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~ARG[1]}~FI~ELSE~SIZE[~TYPO]'d0~FI" - } - } -] diff --git a/prims/commonverilog/Clash_Sized_Internal_Index.primitives b/prims/commonverilog/Clash_Sized_Internal_Index.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Sized_Internal_Index.primitives @@ -0,0 +1,138 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Index n -> BitVector (CLog 2 n)" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n" + , "template" : "~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.le#" + , "kind" : "Expression" + , "type" : "le# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Index n" + , "template" : "~ARG[0]-~SIZE[~TYPO]'d1" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> 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.plus#" + , "kind" : "Declaration" + , "type" : "Index m -> Index n -> Index (m + n - 1)" + , "template" : "assign ~RESULT = ~ARG[0] + ~ARG[1];" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.minus#" + , "kind" : "Declaration" + , "type" : "Index m -> Index n -> Index (m + n - 1)" + , "template" : "assign ~RESULT = ~ARG[0] - ~ARG[1];" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.times#" + , "kind" : "Declaration" + , "type" : "Index m -> Index n -> Index (((m-1) * (n-1)) + 1)" + , "template" : "assign ~RESULT = ~ARG[0] * ~ARG[1];" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Index n -> Index n -> Index n" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Index.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.indexToIntegerVerilog" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: KnownNat m => Index n -> Index m" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN~VAR[bv][1][0+:~SIZE[~TYPO]]~ELSE{{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~ARG[1]}~FI~ELSE~SIZE[~TYPO]'d0~FI" + } + } +] diff --git a/prims/commonverilog/Clash_Sized_Internal_Signed.json b/prims/commonverilog/Clash_Sized_Internal_Signed.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Sized_Internal_Signed.json +++ /dev/null @@ -1,206 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.le#" - , "kind" : "Expression" - , "type" : "le# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Signed.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.signedToIntegerVerilog" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => Signed n -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: KnownNat n => Signed n -> BitVector n" - , "template" : "$unsigned(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: KnownNat n => BitVector n -> Signed n" - , "template" : "$signed(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: KnownNat n => Signed n" - , "comment" : "Generates incorrect SV for n=0" - , "template" : "$signed({1'b1, {(~LIT[0]-1) {1'b0}}})" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Signed n" - , "comment" : "Generates incorrect SV for n=0" - , "template" : "$signed({1'b0, {(~LIT[0]-1) {1'b1}}})" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] * ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => Signed n -> Signed n" - , "template" : "-~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.abs#" - , "kind" : "Expression" - , "type" : "abs# :: KnownNat n => Signed n -> Signed n" - , "template" : "(~ARG[1] < ~LIT[0]'sd0) ? -~ARG[1] : ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)" - , "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" - , "type" : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] + ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN~ARG[0]~ELSE~ARG[1]~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.minus#" - , "kind" : "Declaration" - , "type" : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN ~ARG[0] - ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN ~ARG[0]~ELSE - ~ARG[1] ~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.times#" - , "kind" : "Declaration" - , "type" : "times# :: Signed m -> Signed n -> Signed (m + n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSE~SIZE[~TYPO]'d0~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Signed n -> Signed n -> Signed n" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.and#" - , "kind" : "Expression" - , "type" : "and# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] & ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.or#" - , "kind" : "Expression" - , "type" : "or# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] | ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.xor#" - , "kind" : "Expression" - , "type" : "xor# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] ^ ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => Signed n -> Signed n" - , "template" : "~ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "~ARG[1] <<< ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "~ARG[1] >>> ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.truncateB#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "truncateB# :: KnownNat m => Signed (n + m) -> Signed m" - , "template" : "$signed(~VAR[s][1][0+:~SIZE[~TYPO]])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m" - , "template" : "~IF~SIZE[~TYP[2]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[2]]]~THEN$signed({~VAR[s][2][~LIT[0]-1],~VAR[s][2][0+:(~SIZE[~TYPO]-1)]})~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[2]]) {~VAR[s][2][~LIT[0]-1]}},~VAR[s][2]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" - } - } -] diff --git a/prims/commonverilog/Clash_Sized_Internal_Signed.primitives b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives @@ -0,0 +1,206 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.le#" + , "kind" : "Expression" + , "type" : "le# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Signed.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.signedToIntegerVerilog" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => Signed n -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: KnownNat n => Signed n -> BitVector n" + , "template" : "$unsigned(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: KnownNat n => BitVector n -> Signed n" + , "template" : "$signed(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: KnownNat n => Signed n" + , "comment" : "Generates incorrect SV for n=0" + , "template" : "$signed({1'b1, {(~LIT[0]-1) {1'b0}}})" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Signed n" + , "comment" : "Generates incorrect SV for n=0" + , "template" : "$signed({1'b0, {(~LIT[0]-1) {1'b1}}})" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => Signed n -> Signed n" + , "template" : "-~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.abs#" + , "kind" : "Expression" + , "type" : "abs# :: KnownNat n => Signed n -> Signed n" + , "template" : "(~ARG[1] < ~LIT[0]'sd0) ? -~ARG[1] : ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)" + , "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" + , "type" : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] + ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN~ARG[0]~ELSE~ARG[1]~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.minus#" + , "kind" : "Declaration" + , "type" : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN ~ARG[0] - ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN ~ARG[0]~ELSE - ~ARG[1] ~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.times#" + , "kind" : "Declaration" + , "type" : "times# :: Signed m -> Signed n -> Signed (m + n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSE~SIZE[~TYPO]'d0~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Signed n -> Signed n -> Signed n" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.and#" + , "kind" : "Expression" + , "type" : "and# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] & ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.or#" + , "kind" : "Expression" + , "type" : "or# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] | ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.xor#" + , "kind" : "Expression" + , "type" : "xor# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] ^ ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => Signed n -> Signed n" + , "template" : "~ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "~ARG[1] <<< ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "~ARG[1] >>> ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.truncateB#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "truncateB# :: KnownNat m => Signed (n + m) -> Signed m" + , "template" : "$signed(~VAR[s][1][0+:~SIZE[~TYPO]])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m" + , "template" : "~IF~SIZE[~TYP[2]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[2]]]~THEN$signed({~VAR[s][2][~LIT[0]-1],~VAR[s][2][0+:(~SIZE[~TYPO]-1)]})~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[2]]) {~VAR[s][2][~LIT[0]-1]}},~VAR[s][2]})~FI~ELSE~SIZE[~TYPO]'sd0~FI" + } + } +] diff --git a/prims/commonverilog/Clash_Sized_Internal_Unsigned.json b/prims/commonverilog/Clash_Sized_Internal_Unsigned.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Sized_Internal_Unsigned.json +++ /dev/null @@ -1,189 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.le#" - , "kind" : "Expression" - , "type" : "le# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Unsigned.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.unsignedToIntegerVerilog" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => Unsigned n -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Unsigned n -> BitVector n" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: KnownNat n => BitVector n -> Unsigned n" - , "template" : "~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: Unsigned n" - , "template" : "~SIZE[~TYPO]'d0" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Unsigned n" - , "template" : "{~LIT[0] {1'b1}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[1] * ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => Unsigned n -> Unsigned n" - , "template" : "- ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> 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" - , "type" : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] + ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN~ARG[0]~ELSE~ARG[1]~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.minus#" - , "kind" : "Declaration" - , "type" : "minus# :: (KnownNat m, KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN ~ARG[2] - ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN ~ARG[2]~ELSE - ~ARG[3]~FI~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.times#" - , "kind" : "Declaration" - , "type" : "times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)" - , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSE~SIZE[~TYPO]'d0~FI;" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.and#" - , "kind" : "Expression" - , "type" : "and# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.or#" - , "kind" : "Expression" - , "type" : "or# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.xor#" - , "kind" : "Expression" - , "type" : "xor# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] ^ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => Unsigned n -> Unsigned n" - , "template" : "~ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "~ARG[1] << ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "~ARG[1] >> ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: KnownNat m => Unsigned n -> Unsigned m" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN~VAR[bv][1][0+:~SIZE[~TYPO]]~ELSE{{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~ARG[1]}~FI~ELSE~SIZE[~TYPO]'d0~FI" - } - } -] diff --git a/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives b/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Sized_Internal_Unsigned.primitives @@ -0,0 +1,189 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] == ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] != ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSE1'b0~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.le#" + , "kind" : "Expression" + , "type" : "le# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSE1'b1~FI" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Unsigned.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.unsignedToIntegerVerilog" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => Unsigned n -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Unsigned n -> BitVector n" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: KnownNat n => BitVector n -> Unsigned n" + , "template" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: Unsigned n" + , "template" : "~SIZE[~TYPO]'d0" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Unsigned n" + , "template" : "{~LIT[0] {1'b1}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[1] * ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => Unsigned n -> Unsigned n" + , "template" : "- ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> 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" + , "type" : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] + ~ARG[1]~ELSE~IF~SIZE[~TYP[0]]~THEN~ARG[0]~ELSE~ARG[1]~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.minus#" + , "kind" : "Declaration" + , "type" : "minus# :: (KnownNat m, KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THEN ~ARG[2] - ~ARG[3]~ELSE~IF~SIZE[~TYP[2]]~THEN ~ARG[2]~ELSE - ~ARG[3]~FI~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.times#" + , "kind" : "Declaration" + , "type" : "times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)" + , "template" : "assign ~RESULT = ~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSE~SIZE[~TYPO]'d0~FI;" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.and#" + , "kind" : "Expression" + , "type" : "and# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.or#" + , "kind" : "Expression" + , "type" : "or# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.xor#" + , "kind" : "Expression" + , "type" : "xor# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => Unsigned n -> Unsigned n" + , "template" : "~ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "~ARG[1] << ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "~ARG[1] >> ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: KnownNat m => Unsigned n -> Unsigned m" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN~VAR[bv][1][0+:~SIZE[~TYPO]]~ELSE{{(~SIZE[~TYPO]-~SIZE[~TYP[1]]) {1'b0}},~ARG[1]}~FI~ELSE~SIZE[~TYPO]'d0~FI" + } + } +] diff --git a/prims/commonverilog/Clash_Sized_Vector.json b/prims/commonverilog/Clash_Sized_Vector.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Sized_Vector.json +++ /dev/null @@ -1,17 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Vector.maxIndex" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxIndex :: KnownNat n => Vec n a -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0] - ~SIZE[~TYPO]'sd1" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.length" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "length :: KnownNat n => Vec n a -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0]" - } - } -] diff --git a/prims/commonverilog/Clash_Sized_Vector.primitives b/prims/commonverilog/Clash_Sized_Vector.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Sized_Vector.primitives @@ -0,0 +1,17 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Vector.maxIndex" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxIndex :: KnownNat n => Vec n a -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0] - ~SIZE[~TYPO]'sd1" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.length" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "length :: KnownNat n => Vec n a -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0]" + } + } +] diff --git a/prims/commonverilog/Clash_Transformations.json b/prims/commonverilog/Clash_Transformations.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Transformations.json +++ /dev/null @@ -1,8 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Transformations.eqInt" - , "kind" : "Expression" - , "type" : "eqInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] == ~ARG[1]" - } - } -] diff --git a/prims/commonverilog/Clash_Transformations.primitives b/prims/commonverilog/Clash_Transformations.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Transformations.primitives @@ -0,0 +1,8 @@ +[ { "BlackBox" : + { "name" : "Clash.Transformations.eqInt" + , "kind" : "Expression" + , "type" : "eqInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] == ~ARG[1]" + } + } +] diff --git a/prims/commonverilog/Clash_Xilinx_ClockGen.json b/prims/commonverilog/Clash_Xilinx_ClockGen.json deleted file mode 100644 --- a/prims/commonverilog/Clash_Xilinx_ClockGen.json +++ /dev/null @@ -1,47 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Xilinx.ClockGen.clockWizard" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : -"clockWizard - :: ( KnownDomain domIn confIn -- ARG[0] - , KnownDomain domOut confOut ) -- ARG[1] - => SSymbol name -- ARG[2] - -> Clock pllIn -- ARG[3] - -> Reset pllIn -- ARG[4] - -> (Clock pllOut, Enable pllOut)" - , "template" : -"// clockWizard begin -~NAME[2] ~GENSYM[clockWizard_inst][2] -(.CLK_IN1 (~ARG[3]) -,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[4]) -,.CLK_OUT1 (~RESULT[1]) -,.LOCKED (~RESULT[0])); -// clockWizard end" - } - } -, { "BlackBox" : - { "name" : "Clash.Xilinx.ClockGen.clockWizardDifferential" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : -"clockWizardDifferential - :: ( KnownDomain domIn confIn -- ARG[0] - , KnownDomain domOut confOut ) -- ARG[1] - :: SSymbol name -- ARG[2] - -> Clock pllIn -- ARG[3] - -> Clock pllIn -- ARG[4] - -> Reset pllIn -- ARG[5] - -> (Clock pllOut, Enable pllOut)" - , "template" : -"// clockWizardDifferential begin -~NAME[2] ~GENSYM[clockWizardDifferential_inst][2] -(.CLK_IN1_D_clk_n (~ARG[3]) -,.CLK_IN1_D_clk_n (~ARG[4]) -,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[5]) -,.CLK_OUT1 (~RESULT[1]) -,.LOCKED (~RESULT[0])); -// clockWizardDifferential end" - } - } -] diff --git a/prims/commonverilog/Clash_Xilinx_ClockGen.primitives b/prims/commonverilog/Clash_Xilinx_ClockGen.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/Clash_Xilinx_ClockGen.primitives @@ -0,0 +1,47 @@ +[ { "BlackBox" : + { "name" : "Clash.Xilinx.ClockGen.clockWizard" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : +"clockWizard + :: ( KnownDomain domIn confIn -- ARG[0] + , KnownDomain domOut confOut ) -- ARG[1] + => SSymbol name -- ARG[2] + -> Clock pllIn -- ARG[3] + -> Reset pllIn -- ARG[4] + -> (Clock pllOut, Enable pllOut)" + , "template" : +"// clockWizard begin +~NAME[2] ~GENSYM[clockWizard_inst][2] +(.CLK_IN1 (~ARG[3]) +,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[4]) +,.CLK_OUT1 (~RESULT[1]) +,.LOCKED (~RESULT[0])); +// clockWizard end" + } + } +, { "BlackBox" : + { "name" : "Clash.Xilinx.ClockGen.clockWizardDifferential" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : +"clockWizardDifferential + :: ( KnownDomain domIn confIn -- ARG[0] + , KnownDomain domOut confOut ) -- ARG[1] + :: SSymbol name -- ARG[2] + -> Clock pllIn -- ARG[3] + -> Clock pllIn -- ARG[4] + -> Reset pllIn -- ARG[5] + -> (Clock pllOut, Enable pllOut)" + , "template" : +"// clockWizardDifferential begin +~NAME[2] ~GENSYM[clockWizardDifferential_inst][2] +(.CLK_IN1_D_clk_n (~ARG[3]) +,.CLK_IN1_D_clk_n (~ARG[4]) +,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[5]) +,.CLK_OUT1 (~RESULT[1]) +,.LOCKED (~RESULT[0])); +// clockWizardDifferential end" + } + } +] diff --git a/prims/commonverilog/GHC_Base.json b/prims/commonverilog/GHC_Base.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Base.json +++ /dev/null @@ -1,8 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Base.remInt" - , "kind" : "Expression" - , "type" : "remInt :: Int -> Int -> Int" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -] diff --git a/prims/commonverilog/GHC_Base.primitives b/prims/commonverilog/GHC_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Base.primitives @@ -0,0 +1,8 @@ +[ { "BlackBox" : + { "name" : "GHC.Base.remInt" + , "kind" : "Expression" + , "type" : "remInt :: Int -> Int -> Int" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +] diff --git a/prims/commonverilog/GHC_Classes.json b/prims/commonverilog/GHC_Classes.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Classes.json +++ /dev/null @@ -1,36 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.eqInt" - , "kind" : "Expression" - , "type" : "eqInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] == ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.neInt" - , "kind" : "Expression" - , "type" : "neInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] != ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.&&" - , "kind" : "Expression" - , "type" : "(&&) :: Bool -> Bool -> Bool" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.||" - , "kind" : "Expression" - , "type" : "(::) :: Bool -> Bool -> Bool" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.not" - , "kind" : "Expression" - , "type" : "not :: Bool -> Bool" - , "template" : "~ ~ARG[0]" - } - } -] diff --git a/prims/commonverilog/GHC_Classes.primitives b/prims/commonverilog/GHC_Classes.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Classes.primitives @@ -0,0 +1,36 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.eqInt" + , "kind" : "Expression" + , "type" : "eqInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] == ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.neInt" + , "kind" : "Expression" + , "type" : "neInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] != ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.&&" + , "kind" : "Expression" + , "type" : "(&&) :: Bool -> Bool -> Bool" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.||" + , "kind" : "Expression" + , "type" : "(::) :: Bool -> Bool -> Bool" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.not" + , "kind" : "Expression" + , "type" : "not :: Bool -> Bool" + , "template" : "~ ~ARG[0]" + } + } +] diff --git a/prims/commonverilog/GHC_Int.json b/prims/commonverilog/GHC_Int.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Int.json +++ /dev/null @@ -1,30 +0,0 @@ -[ - { - "BlackBoxHaskell": { - "name": "GHC.Int.I8#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Int.intTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Int.I16#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Int.intTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Int.I32#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Int.intTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Int.I64#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Int.intTF" - } - } -] diff --git a/prims/commonverilog/GHC_Int.primitives b/prims/commonverilog/GHC_Int.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Int.primitives @@ -0,0 +1,30 @@ +[ + { + "BlackBoxHaskell": { + "name": "GHC.Int.I8#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Int.intTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Int.I16#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Int.intTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Int.I32#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Int.intTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Int.I64#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Int.intTF" + } + } +] diff --git a/prims/commonverilog/GHC_Integer_Logarithms.json b/prims/commonverilog/GHC_Integer_Logarithms.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Integer_Logarithms.json +++ /dev/null @@ -1,23 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Logarithms.integerLogBase#" - , "kind" : "Expression" - , "type" : "integerLogBase# :: Integer -> Integer -> Int#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "integerLogBase" - , "extension" : "inc" - , "template" : -"// integer logBase -function integer ~INCLUDENAME[0]; - input integer base, value; - begin - for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) - value = value / base; - end -endfunction" - } - ] - , "template" : "~INCLUDENAME[0](~ARG[0],~ARG[1])" - } - } -] diff --git a/prims/commonverilog/GHC_Integer_Logarithms.primitives b/prims/commonverilog/GHC_Integer_Logarithms.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Integer_Logarithms.primitives @@ -0,0 +1,23 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Logarithms.integerLogBase#" + , "kind" : "Expression" + , "type" : "integerLogBase# :: Integer -> Integer -> Int#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "integerLogBase" + , "extension" : "inc" + , "template" : +"// integer logBase +function integer ~INCLUDENAME[0]; + input integer base, value; + begin + for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) + value = value / base; + end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~ARG[0],~ARG[1])" + } + } +] diff --git a/prims/commonverilog/GHC_Integer_Type.json b/prims/commonverilog/GHC_Integer_Type.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Integer_Type.json +++ /dev/null @@ -1,189 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.smallInteger" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "smallInteger :: Int# -> Integer" - , "template" : "assign ~RESULT = $signed(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToInt" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "integerToInt :: Integer -> Int#" - , "template" : "assign ~RESULT = $signed(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.timesInteger" - , "kind" : "Expression" - , "type" : "timesInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] * ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.negateInteger" - , "kind" : "Expression" - , "type" : "negateInteger :: Integer -> Integer" - , "template" : "-~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.absInteger" - , "kind" : "Expression" - , "type" : "absInteger :: Integer -> Integer" - , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~ARG[0] : ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.remInteger" - , "kind" : "Expression" - , "type" : "remInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger" - , "kind" : "Expression" - , "type" : "eqInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] == ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger" - , "kind" : "Expression" - , "type" : "neqInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] != ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger#" - , "kind" : "Expression" - , "type" : "eqInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger#" - , "kind" : "Expression" - , "type" : "neqInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.leInteger#" - , "kind" : "Expression" - , "type" : "leInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.gtInteger#" - , "kind" : "Expression" - , "type" : "gtInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.ltInteger#" - , "kind" : "Expression" - , "type" : "ltInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.geInteger#" - , "kind" : "Expression" - , "type" : "geInteger :: Integer -> Integer -> Bool" - , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.shiftRInteger" - , "kind" : "Expression" - , "type" : "shiftRInteger :: Integer -> Int# -> Integer" - , "template" : "~ARG[0] >>> ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.shiftLInteger" - , "kind" : "Expression" - , "type" : "shiftLInteger :: Integer -> Int# -> Integer" - , "template" : "~ARG[0] <<< ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.testBitInteger" - , "kind" : "Expression" - , "type" : "testBitInteger :: Integer -> Int# -> Bool" - , "template" : "~VAR[input][0][~ARG[1]] == 1'b1" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.wordToInteger" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "wordToInteger :: Word# -> Integer" - , "template" : "assign ~RESULT = $signed(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToWord" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "integerToWord :: Integer -> Word#" - , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToWord64" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "integerToWord :: Integer -> Word64#" - , "comment" : "only used by 32 bit GHC" - , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.bitInteger" - , "kind" : "Expression" - , "type" : "bitInteger :: Int -> Integer" - , "template" : "1 << ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.complementInteger" - , "kind" : "Expression" - , "type" : "complementInteger :: Integer -> Integer" - , "template" : "~ ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.xorInteger" - , "kind" : "Expression" - , "type" : "xorInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] ^ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.orInteger" - , "kind" : "Expression" - , "type" : "orInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.andInteger" - , "kind" : "Expression" - , "type" : "andInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.$wsignumInteger" - , "kind" : "Expression" - , "type" : "$wsignumInteger :: Integer -> Integer" - , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~SIZE[~TYPO]'sd1 : ((~ARG[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SIZE[~TYPO]'sd1)" - } - } -] diff --git a/prims/commonverilog/GHC_Integer_Type.primitives b/prims/commonverilog/GHC_Integer_Type.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Integer_Type.primitives @@ -0,0 +1,189 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.smallInteger" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "smallInteger :: Int# -> Integer" + , "template" : "assign ~RESULT = $signed(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToInt" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToInt :: Integer -> Int#" + , "template" : "assign ~RESULT = $signed(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.timesInteger" + , "kind" : "Expression" + , "type" : "timesInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.negateInteger" + , "kind" : "Expression" + , "type" : "negateInteger :: Integer -> Integer" + , "template" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.absInteger" + , "kind" : "Expression" + , "type" : "absInteger :: Integer -> Integer" + , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~ARG[0] : ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.remInteger" + , "kind" : "Expression" + , "type" : "remInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger" + , "kind" : "Expression" + , "type" : "eqInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] == ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger" + , "kind" : "Expression" + , "type" : "neqInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] != ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger#" + , "kind" : "Expression" + , "type" : "eqInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger#" + , "kind" : "Expression" + , "type" : "neqInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger#" + , "kind" : "Expression" + , "type" : "leInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger#" + , "kind" : "Expression" + , "type" : "gtInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger#" + , "kind" : "Expression" + , "type" : "ltInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger#" + , "kind" : "Expression" + , "type" : "geInteger :: Integer -> Integer -> Bool" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftRInteger" + , "kind" : "Expression" + , "type" : "shiftRInteger :: Integer -> Int# -> Integer" + , "template" : "~ARG[0] >>> ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftLInteger" + , "kind" : "Expression" + , "type" : "shiftLInteger :: Integer -> Int# -> Integer" + , "template" : "~ARG[0] <<< ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.testBitInteger" + , "kind" : "Expression" + , "type" : "testBitInteger :: Integer -> Int# -> Bool" + , "template" : "~VAR[input][0][~ARG[1]] == 1'b1" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.wordToInteger" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "wordToInteger :: Word# -> Integer" + , "template" : "assign ~RESULT = $signed(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToWord" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToWord :: Integer -> Word#" + , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToWord64" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToWord :: Integer -> Word64#" + , "comment" : "only used by 32 bit GHC" + , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.bitInteger" + , "kind" : "Expression" + , "type" : "bitInteger :: Int -> Integer" + , "template" : "1 << ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.complementInteger" + , "kind" : "Expression" + , "type" : "complementInteger :: Integer -> Integer" + , "template" : "~ ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.xorInteger" + , "kind" : "Expression" + , "type" : "xorInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.orInteger" + , "kind" : "Expression" + , "type" : "orInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.andInteger" + , "kind" : "Expression" + , "type" : "andInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.$wsignumInteger" + , "kind" : "Expression" + , "type" : "$wsignumInteger :: Integer -> Integer" + , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~SIZE[~TYPO]'sd1 : ((~ARG[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SIZE[~TYPO]'sd1)" + } + } +] diff --git a/prims/commonverilog/GHC_Natural.json b/prims/commonverilog/GHC_Natural.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Natural.json +++ /dev/null @@ -1,31 +0,0 @@ -[ - { - "BlackBox": { - "name": "GHC.Natural.naturalFromInteger", - "workInfo" : "Never", - "kind": "Expression", - "type": "naturalFromInteger :: Integer -> Natural", - "template": "$unsigned(~VAR[n][0][(~SIZE[~TYPO]-1):0])", - "warning": "GHC.Natural.naturalFromInteger: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "BlackBox": { - "name": "GHC.Natural.timesNatural", - "kind": "Expression", - "type": "timesNatural :: Natural -> Natural -> Natural", - "template": "~ARG[0] * ~ARG[1]", - "warning": "GHC.Natural.timesNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "BlackBox": { - "name": "GHC.Natural.wordToNatural#", - "workInfo" : "Never", - "kind": "Declaration", - "type": "wordToNatural# :: Word# -> Natural", - "template": "assign ~RESULT = $unsigned(~ARG[0]);", - "warning": "GHC.Natural.wordToNatural#: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - } -] diff --git a/prims/commonverilog/GHC_Natural.primitives b/prims/commonverilog/GHC_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Natural.primitives @@ -0,0 +1,31 @@ +[ + { + "BlackBox": { + "name": "GHC.Natural.naturalFromInteger", + "workInfo" : "Never", + "kind": "Expression", + "type": "naturalFromInteger :: Integer -> Natural", + "template": "$unsigned(~VAR[n][0][(~SIZE[~TYPO]-1):0])", + "warning": "GHC.Natural.naturalFromInteger: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Natural.timesNatural", + "kind": "Expression", + "type": "timesNatural :: Natural -> Natural -> Natural", + "template": "~ARG[0] * ~ARG[1]", + "warning": "GHC.Natural.timesNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Natural.wordToNatural#", + "workInfo" : "Never", + "kind": "Declaration", + "type": "wordToNatural# :: Word# -> Natural", + "template": "assign ~RESULT = $unsigned(~ARG[0]);", + "warning": "GHC.Natural.wordToNatural#: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + } +] diff --git a/prims/commonverilog/GHC_Num_Integer.primitives b/prims/commonverilog/GHC_Num_Integer.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Num_Integer.primitives @@ -0,0 +1,244 @@ +[ { "BlackBox": + { "name": "GHC.Num.Integer.integerToNatural" + , "workInfo" : "Never" + , "kind": "Expression" + , "type": "integerToNatural :: Integer -> Natural" + , "template": "$unsigned(~VAR[n][0][(~SIZE[~TYPO]-1):0])" + , "warning": "GHC.Num.Integer.integerToNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } +, { "BlackBox": + { "name": "GHC.Num.Integer.integerToNaturalThrow" + , "workInfo" : "Never" + , "kind": "Expression" + , "type": "integerToNaturalThrow :: Integer -> Natural" + , "template": "(~ARG[0] < ~SIZE[~TYP[0]]'d0 ? ~ERRORO: $unsigned(~VAR[n][0][(~SIZE[~TYPO]-1):0]))" + , "warning": "GHC.Num.Integer.integerToNaturalThrow: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } +} +, { "BlackBox": + { "name": "GHC.Num.Integer.integerToNaturalClamp" + , "workInfo" : "Never" + , "kind": "Expression" + , "type": "integerToNatural :: Integer -> Natural" + , "template": "(~ARG[0] < ~SIZE[~TYP[0]]'d0 ? ~SIZE[~TYPO]'d0 : $unsigned(~VAR[n][0][(~SIZE[~TYPO]-1):0]))" + , "warning": "GHC.Num.Integer.integerToNaturalClamp: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToInt#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToInt :: Integer -> Int#" + , "template" : "assign ~RESULT = $signed(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerMul" + , "kind" : "Expression" + , "type" : "integerMul :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNegate" + , "kind" : "Expression" + , "type" : "integerNegate :: Integer -> Integer" + , "template" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerAbs" + , "kind" : "Expression" + , "type" : "integerAbs :: Integer -> Integer" + , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~ARG[0] : ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerRem" + , "kind" : "Expression" + , "type" : "integerRem :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerEq" + , "kind" : "Expression" + , "type" : "integerEq :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] == ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNe" + , "kind" : "Expression" + , "type" : "integerNe :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] != ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerEq#" + , "kind" : "Expression" + , "type" : "integerEq :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNe#" + , "kind" : "Expression" + , "type" : "integerNe# :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLe#" + , "kind" : "Expression" + , "type" : "integerLe :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGt#" + , "kind" : "Expression" + , "type" : "integerGt# :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLt#" + , "kind" : "Expression" + , "type" : "integerLt# :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGe#" + , "kind" : "Expression" + , "type" : "integerGe# :: Integer -> Integer -> Int#" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerShiftR#" + , "kind" : "Expression" + , "type" : "integerShiftR :: Integer -> Word# -> Integer" + , "template" : "~ARG[0] >>> ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerShiftL#" + , "kind" : "Expression" + , "type" : "integerShiftL :: Integer -> Word# -> Integer" + , "template" : "~ARG[0] <<< ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerTestBit#" + , "kind" : "Expression" + , "type" : "integerTestBit :: Integer -> Word# -> Bool" + , "template" : "~VAR[input][0][~ARG[1]] == 1'b1" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerFromWord#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerFromWord# :: Word# -> Integer" + , "template" : "assign ~RESULT = $signed(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToWord#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToWord# :: Integer -> Word#" + , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToWord64#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "integerToWord64# :: Integer -> Word64#" + , "comment" : "only used by 32 bit GHC" + , "template" : "assign ~RESULT = $unsigned(~ARG[0]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerBit#" + , "kind" : "Expression" + , "type" : "integerBit# :: Word# -> Integer" + , "template" : "1 << ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerComplement" + , "kind" : "Expression" + , "type" : "integerComplement :: Integer -> Integer" + , "template" : "~ ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerXor" + , "kind" : "Expression" + , "type" : "integerXor :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerOr" + , "kind" : "Expression" + , "type" : "integerOr :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerAnd" + , "kind" : "Expression" + , "type" : "andInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerSignum" + , "kind" : "Expression" + , "type" : "integerSignum :: Integer -> Integer" + , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~SIZE[~TYPO]'sd1 : ((~ARG[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SIZE[~TYPO]'sd1)" + } + } + , { "BlackBox" : + { "name" : "GHC.Num.Integer.$wintegerSignum" + , "kind" : "Expression" + , "type" : "integerSignum :: Integer -> Int#" + , "template" : "(~ARG[0] < ~SIZE[~TYPO]'sd0) ? -~SIZE[~TYPO]'sd1 : ((~ARG[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SIZE[~TYPO]'sd1)" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLogBase#" + , "kind" : "Expression" + , "type" : "integerLogBase# :: Integer -> Integer -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "integerLogBase" + , "extension" : "inc" + , "template" : +"// integer logBase +function integer ~INCLUDENAME[0]; +input integer base, value; +begin + for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) + value = value / base; +end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~ARG[0],~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerCompare" + , "kind" : "Expression" + , "type" : "integerCompare :: Integer -> Integer -> Ordering" + , "template" : "(~ARG[0] < ~ARG[1]) ? -~SIZE[~TYPO]'d0 : ((~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d2)" + } + } +] diff --git a/prims/commonverilog/GHC_Num_Natural.primitives b/prims/commonverilog/GHC_Num_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Num_Natural.primitives @@ -0,0 +1,106 @@ +[ + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalMul", + "kind": "Expression", + "type": "naturalMul :: Natural -> Natural -> Natural", + "template": "~ARG[0] * ~ARG[1]", + "warning": "GHC.Num.Natural.naturalMul: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalFromWord#", + "workInfo" : "Never", + "kind": "Declaration", + "type": "naturalFromWord# :: Word# -> Natural", + "template": "assign ~RESULT = $unsigned(~ARG[0]);", + "warning": "GHC.Num.Natural.naturalFromWord#: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalRem" + , "kind" : "Expression" + , "type" : "naturalRem :: Natural -> Natural -> Natural" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLogBase#" + , "kind" : "Expression" + , "type" : "naturalLogBase# :: Natural -> Natural -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "naturalLogBase" + , "extension" : "inc" + , "template" : +"// natural logBase +function integer ~INCLUDENAME[0]; +input [~SIZE[~TYP[0]]-1:0] base, value; +begin + for (~INCLUDENAME[0] = 0; value >= base; ~INCLUDENAME[0]=~INCLUDENAME[0]+1) + value = value / base; +end +endfunction" + } + ] + , "template" : "~INCLUDENAME[0](~ARG[0],~ARG[1])" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalEq#" + , "kind" : "Expression" + , "type" : "naturalEq :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalNe#" + , "kind" : "Expression" + , "type" : "naturalNe# :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLe#" + , "kind" : "Expression" + , "type" : "naturalLe :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalGt#" + , "kind" : "Expression" + , "type" : "naturalGt# :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLt#" + , "kind" : "Expression" + , "type" : "naturalLt# :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalGe#" + , "kind" : "Expression" + , "type" : "naturalGe# :: Natural -> Natural -> Int#" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d0" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalShiftL#" + , "kind" : "Expression" + , "type" : "naturalShiftL :: Natural -> Word# -> Natural" + , "template" : "~ARG[0] <<< ~ARG[1]" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.NaturalCompare" + , "kind" : "Expression" + , "type" : "naturalCompare :: Natural -> Natural -> Ordering" + , "template" : "(~ARG[0] < ~ARG[1]) ? -~SIZE[~TYPO]'d0 : ((~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'d1 : ~SIZE[~TYPO]'d2)" + } +} +] diff --git a/prims/commonverilog/GHC_Prim.json b/prims/commonverilog/GHC_Prim.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Prim.json +++ /dev/null @@ -1,478 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Prim.gtChar#" - , "kind" : "Expression" - , "type" : "gtChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.geChar#" - , "kind" : "Expression" - , "type" : "geChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.eqChar#" - , "kind" : "Expression" - , "type" : "eqChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.neChar#" - , "kind" : "Expression" - , "type" : "neChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ltChar#" - , "kind" : "Expression" - , "type" : "ltChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.leChar#" - , "kind" : "Expression" - , "type" : "leChar# :: Char# -> Char# -> Int#" - , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ord#" - , "kind" : "Expression" - , "type" : "ord :: Char# -> Int#" - , "template" : "$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {1'b0}},~VAR[c][0]})" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.*#" - , "kind" : "Expression" - , "type" : "(*#) :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] * ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.remInt#" - , "kind" : "Expression" - , "type" : "remInt# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.andI#" - , "kind" : "Expression" - , "type" : "andI# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.orI#" - , "kind" : "Expression" - , "type" : "orI# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.xorI#" - , "kind" : "Expression" - , "type" : "xorI# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] ^ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.notI#" - , "kind" : "Expression" - , "type" : "notI# :: Int# -> Int#" - , "template" : "~ ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.negateInt#" - , "kind" : "Expression" - , "type" : "negateInt# :: Int# -> Int#" - , "template" : "-(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>#" - , "kind" : "Expression" - , "type" : "(>#) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>=#" - , "kind" : "Expression" - , "type" : "(>=#) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.==#" - , "kind" : "Expression" - , "type" : "(==) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim./=#" - , "kind" : "Expression" - , "type" : "(/=#) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<#" - , "kind" : "Expression" - , "type" : "(<#) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<=#" - , "kind" : "Expression" - , "type" : "(<=#) :: Int# -> Int# -> Int#" - , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.chr#" - , "kind" : "Expression" - , "type" : "ord :: Int# -> Char#" - , "template" : "$unsigned(~VAR[i][0][0+:~SIZE[~TYPO]])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.int2Word#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "int2Word# :: Int# -> Word#" - , "template" : "$unsigned(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftL#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftL# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] <<< ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftRA#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftRA# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] >>> ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftRL#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftRL# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] >> ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.timesWord#" - , "kind" : "Expression" - , "type" : "timesWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] * ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.remWord#" - , "kind" : "Expression" - , "type" : "remWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] % ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.and#" - , "kind" : "Expression" - , "type" : "and# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] & ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.or#" - , "kind" : "Expression" - , "type" : "or# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] | ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.xor#" - , "kind" : "Expression" - , "type" : "xor# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] ^ ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.not#" - , "kind" : "Expression" - , "type" : "not# :: Word# -> Word#" - , "template" : "~ ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedShiftL#" - , "kind" : "Expression" - , "type" : "uncheckedShiftL# :: Word# -> Int# -> Word#" - , "template" : "~ARG[0] << ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedShiftRL#" - , "kind" : "Expression" - , "type" : "uncheckedShiftRL# :: Word# -> Int# -> Word#" - , "template" : "~ARG[0] >> ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.word2Int#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "int2Word# :: Word# -> Int#" - , "template" : "$signed(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.gtWord#" - , "kind" : "Expression" - , "type" : "gtWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.geWord#" - , "kind" : "Expression" - , "type" : "geWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.eqWord#" - , "kind" : "Expression" - , "type" : "eqWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.neWord#" - , "kind" : "Expression" - , "type" : "neWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ltWord#" - , "kind" : "Expression" - , "type" : "ltWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.leWord#" - , "kind" : "Expression" - , "type" : "leWord# :: Word# -> Word# -> Int#" - , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap16#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap16# :: Word# -> Word#" - , "template" : -"// byteSwap16 begin~IF ~IW64 ~THEN -assign ~RESULT = {~VAR[w][0][63:16],~VAR[w][0][7:0],~VAR[w][0][15:8]};~ELSE -assign ~RESULT = {~VAR[w][0][31:16],~VAR[w][0][7:0],~VAR[w][0][15:8]};~FI -// byteSwap16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap32#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap32# :: Word# -> Word#" - , "template" : -"// byteSwap32 begin~IF ~IW64 ~THEN -assign ~RESULT = {~VAR[w][0][63:32],~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~ELSE -assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~FI -// byteSwap32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap64#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap64# :: Word# -> Word#" - , "template" : -"// byteSwap64 begin -assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24] - ,~VAR[w][0][39:32],~VAR[w][0][47:40],~VAR[w][0][55:48],~VAR[w][0][63:56]}; -// byteSwap64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap# :: Word# -> Word#" - , "template" : -"// byteSwap begin~IF ~IW64 ~THEN -assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24] - ,~VAR[w][0][39:32],~VAR[w][0][47:40],~VAR[w][0][55:48],~VAR[w][0][63:56]};~ELSE -assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~FI -// byteSwap end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow8Int#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow8Int# :: Int# -> Int#" - , "template" : -"// narrow8Int begin -assign ~RESULT = $signed(~VAR[i][0][7:0]); -// narrow8Int end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow16Int#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow16Int# :: Int# -> Int#" - , "template" : -"// narrow16Int begin -assign ~RESULT = $signed(~VAR[i][0][15:0]); -// narrow16Int end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow32Int#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow32Int# :: Int# -> Int#" - , "template" : -"// narrow32Int begin -assign ~RESULT = $signed(~VAR[i][0][31:0]); -// narrow32Int end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow8Word#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow8Int# :: Word# -> Word#" - , "template" : -"// narrow8Word begin -assign ~RESULT = $unsigned(~VAR[w][0][7:0]); -// narrow8Word end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow16Word#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow16Word# :: Word# -> Word#" - , "template" : -"// narrow16Word begin -assign ~RESULT = $unsigned(~VAR[w][0][15:0]); -// narrow16Word end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow32Word#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "narrow32Int# :: Word# -> Word#" - , "template" : -"// narrow32Word begin -assign ~RESULT = $unsigned(~VAR[w][0][31:0]); -// narrow32Word end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse# :: Word# -> Word#" - , "template" : -"// bitReverse begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0] = 0; ~SYM[0] < ~IF ~IW64 ~THEN 64 ~ELSE 32 ~FI; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse][2] - assign ~RESULT[~SYM[0]] = ~VAR[x][0][~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI-~SYM[0]]; -end -~ENDGENERATE -// bitReverse end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse8#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse8# :: Word# -> Word#" - , "template" : -"// bitReverse8 begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0] = 0; ~SYM[0] < 8; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse8][2] - assign ~RESULT[~SYM[0]] = ~VAR[x][0][7-~SYM[0]]; -end -~ENDGENERATE -// bitReverse8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse16#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse16# :: Word# -> Word#" - , "template" : -"// bitReverse16 begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0] = 0; ~SYM[0] < 16; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse16][2] - assign ~RESULT[~SYM[0]] = ~VAR[x][0][15-~SYM[0]]; -end -~ENDGENERATE -// bitReverse16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse32#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse32# :: Word# -> Word#" - , "template" : -"// bitReverse32 begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0] = 0; ~SYM[0] < 32; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse32][2] - assign ~RESULT[~SYM[0]] = ~VAR[x][0][31-~SYM[0]]; -end -~ENDGENERATE -// bitReverse32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse64#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse64# :: Word# -> Word#" - , "template" : -"// bitReverse64 begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0] = 0; ~SYM[0] < 64; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse64][2] - assign ~RESULT[~SYM[0]] = ~VAR[x][0][63-~SYM[0]]; -end -~ENDGENERATE -// bitReverse64 end" - } - } -] diff --git a/prims/commonverilog/GHC_Prim.primitives b/prims/commonverilog/GHC_Prim.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Prim.primitives @@ -0,0 +1,478 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.gtChar#" + , "kind" : "Expression" + , "type" : "gtChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.geChar#" + , "kind" : "Expression" + , "type" : "geChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.eqChar#" + , "kind" : "Expression" + , "type" : "eqChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.neChar#" + , "kind" : "Expression" + , "type" : "neChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ltChar#" + , "kind" : "Expression" + , "type" : "ltChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.leChar#" + , "kind" : "Expression" + , "type" : "leChar# :: Char# -> Char# -> Int#" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ord#" + , "kind" : "Expression" + , "type" : "ord :: Char# -> Int#" + , "template" : "$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[0]]) {1'b0}},~VAR[c][0]})" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.*#" + , "kind" : "Expression" + , "type" : "(*#) :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remInt#" + , "kind" : "Expression" + , "type" : "remInt# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.andI#" + , "kind" : "Expression" + , "type" : "andI# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.orI#" + , "kind" : "Expression" + , "type" : "orI# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.xorI#" + , "kind" : "Expression" + , "type" : "xorI# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.notI#" + , "kind" : "Expression" + , "type" : "notI# :: Int# -> Int#" + , "template" : "~ ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.negateInt#" + , "kind" : "Expression" + , "type" : "negateInt# :: Int# -> Int#" + , "template" : "-(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>#" + , "kind" : "Expression" + , "type" : "(>#) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>=#" + , "kind" : "Expression" + , "type" : "(>=#) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.==#" + , "kind" : "Expression" + , "type" : "(==) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim./=#" + , "kind" : "Expression" + , "type" : "(/=#) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<#" + , "kind" : "Expression" + , "type" : "(<#) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<=#" + , "kind" : "Expression" + , "type" : "(<=#) :: Int# -> Int# -> Int#" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.chr#" + , "kind" : "Expression" + , "type" : "ord :: Int# -> Char#" + , "template" : "$unsigned(~VAR[i][0][0+:~SIZE[~TYPO]])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.int2Word#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "int2Word# :: Int# -> Word#" + , "template" : "$unsigned(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftL#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftL# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] <<< ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftRA#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftRA# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] >>> ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftRL#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftRL# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] >> ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.timesWord#" + , "kind" : "Expression" + , "type" : "timesWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] * ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remWord#" + , "kind" : "Expression" + , "type" : "remWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] % ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.and#" + , "kind" : "Expression" + , "type" : "and# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] & ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.or#" + , "kind" : "Expression" + , "type" : "or# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] | ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.xor#" + , "kind" : "Expression" + , "type" : "xor# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] ^ ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.not#" + , "kind" : "Expression" + , "type" : "not# :: Word# -> Word#" + , "template" : "~ ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedShiftL#" + , "kind" : "Expression" + , "type" : "uncheckedShiftL# :: Word# -> Int# -> Word#" + , "template" : "~ARG[0] << ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedShiftRL#" + , "kind" : "Expression" + , "type" : "uncheckedShiftRL# :: Word# -> Int# -> Word#" + , "template" : "~ARG[0] >> ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.word2Int#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "int2Word# :: Word# -> Int#" + , "template" : "$signed(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.gtWord#" + , "kind" : "Expression" + , "type" : "gtWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.geWord#" + , "kind" : "Expression" + , "type" : "geWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] >= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.eqWord#" + , "kind" : "Expression" + , "type" : "eqWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] == ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.neWord#" + , "kind" : "Expression" + , "type" : "neWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] != ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ltWord#" + , "kind" : "Expression" + , "type" : "ltWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] < ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.leWord#" + , "kind" : "Expression" + , "type" : "leWord# :: Word# -> Word# -> Int#" + , "template" : "(~ARG[0] <= ~ARG[1]) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap16#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap16# :: Word# -> Word#" + , "template" : +"// byteSwap16 begin~IF ~IW64 ~THEN +assign ~RESULT = {~VAR[w][0][63:16],~VAR[w][0][7:0],~VAR[w][0][15:8]};~ELSE +assign ~RESULT = {~VAR[w][0][31:16],~VAR[w][0][7:0],~VAR[w][0][15:8]};~FI +// byteSwap16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap32#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap32# :: Word# -> Word#" + , "template" : +"// byteSwap32 begin~IF ~IW64 ~THEN +assign ~RESULT = {~VAR[w][0][63:32],~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~ELSE +assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~FI +// byteSwap32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap64#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap64# :: Word# -> Word#" + , "template" : +"// byteSwap64 begin +assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24] + ,~VAR[w][0][39:32],~VAR[w][0][47:40],~VAR[w][0][55:48],~VAR[w][0][63:56]}; +// byteSwap64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap# :: Word# -> Word#" + , "template" : +"// byteSwap begin~IF ~IW64 ~THEN +assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24] + ,~VAR[w][0][39:32],~VAR[w][0][47:40],~VAR[w][0][55:48],~VAR[w][0][63:56]};~ELSE +assign ~RESULT = {~VAR[w][0][7:0],~VAR[w][0][15:8],~VAR[w][0][23:16],~VAR[w][0][31:24]};~FI +// byteSwap end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow8Int#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow8Int# :: Int# -> Int#" + , "template" : +"// narrow8Int begin +assign ~RESULT = $signed(~VAR[i][0][7:0]); +// narrow8Int end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow16Int#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow16Int# :: Int# -> Int#" + , "template" : +"// narrow16Int begin +assign ~RESULT = $signed(~VAR[i][0][15:0]); +// narrow16Int end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow32Int#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow32Int# :: Int# -> Int#" + , "template" : +"// narrow32Int begin +assign ~RESULT = $signed(~VAR[i][0][31:0]); +// narrow32Int end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow8Word#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow8Int# :: Word# -> Word#" + , "template" : +"// narrow8Word begin +assign ~RESULT = $unsigned(~VAR[w][0][7:0]); +// narrow8Word end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow16Word#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow16Word# :: Word# -> Word#" + , "template" : +"// narrow16Word begin +assign ~RESULT = $unsigned(~VAR[w][0][15:0]); +// narrow16Word end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow32Word#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "narrow32Int# :: Word# -> Word#" + , "template" : +"// narrow32Word begin +assign ~RESULT = $unsigned(~VAR[w][0][31:0]); +// narrow32Word end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse# :: Word# -> Word#" + , "template" : +"// bitReverse begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0] = 0; ~SYM[0] < ~IF ~IW64 ~THEN 64 ~ELSE 32 ~FI; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse][2] + assign ~RESULT[~SYM[0]] = ~VAR[x][0][~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI-~SYM[0]]; +end +~ENDGENERATE +// bitReverse end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse8#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse8# :: Word# -> Word#" + , "template" : +"// bitReverse8 begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0] = 0; ~SYM[0] < 8; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse8][2] + assign ~RESULT[~SYM[0]] = ~VAR[x][0][7-~SYM[0]]; +end +~ENDGENERATE +// bitReverse8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse16#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse16# :: Word# -> Word#" + , "template" : +"// bitReverse16 begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0] = 0; ~SYM[0] < 16; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse16][2] + assign ~RESULT[~SYM[0]] = ~VAR[x][0][15-~SYM[0]]; +end +~ENDGENERATE +// bitReverse16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse32#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse32# :: Word# -> Word#" + , "template" : +"// bitReverse32 begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0] = 0; ~SYM[0] < 32; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse32][2] + assign ~RESULT[~SYM[0]] = ~VAR[x][0][31-~SYM[0]]; +end +~ENDGENERATE +// bitReverse32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse64#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse64# :: Word# -> Word#" + , "template" : +"// bitReverse64 begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0] = 0; ~SYM[0] < 64; ~SYM[0]=~SYM[0]+1) begin : ~GENSYM[bitReverse64][2] + assign ~RESULT[~SYM[0]] = ~VAR[x][0][63-~SYM[0]]; +end +~ENDGENERATE +// bitReverse64 end" + } + } +] diff --git a/prims/commonverilog/GHC_Word.json b/prims/commonverilog/GHC_Word.json deleted file mode 100644 --- a/prims/commonverilog/GHC_Word.json +++ /dev/null @@ -1,30 +0,0 @@ -[ - { - "BlackBoxHaskell": { - "name": "GHC.Word.W8#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Word.wordTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Word.W16#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Word.wordTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Word.W32#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Word.wordTF" - } - }, - { - "BlackBoxHaskell": { - "name": "GHC.Word.W64#", - "workInfo" : "Never", - "templateFunction": "Clash.Primitives.GHC.Word.wordTF" - } - } -] diff --git a/prims/commonverilog/GHC_Word.primitives b/prims/commonverilog/GHC_Word.primitives new file mode 100644 --- /dev/null +++ b/prims/commonverilog/GHC_Word.primitives @@ -0,0 +1,30 @@ +[ + { + "BlackBoxHaskell": { + "name": "GHC.Word.W8#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Word.wordTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Word.W16#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Word.wordTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Word.W32#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Word.wordTF" + } + }, + { + "BlackBoxHaskell": { + "name": "GHC.Word.W64#", + "workInfo" : "Never", + "templateFunction": "Clash.Primitives.GHC.Word.wordTF" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_BlockRam.json b/prims/systemverilog/Clash_Explicit_BlockRam.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_BlockRam.json +++ /dev/null @@ -1,140 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam#" - , "kind" : "Declaration" - , "type" : -"blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "template" : -"// blockRam begin -~SIGD[~GENSYM[RAM][1]][5]; -logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2]; -initial begin - ~SYM[1] = ~CONST[5]; -end~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; -end~FI -assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; -// blockRam end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRamU#" - , "kind" : "Declaration" - , "type" : -"blockRamU# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "template" : -"// blockRamU begin, -~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LIT[5]-1]; -logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; -end~FI -assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; -// blockRamU end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam1#" - , "kind" : "Declaration" - , "type" : -"blockRam1# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> a -- init, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom a -- din, ARG[10] - -> Signal dom a" - , "template" : -"// blockRam1 begin, -~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LIT[5]-1]; -logic [~SIZE[~TYP[10]]-1:0] ~GENSYM[~RESULT_q][2]; -initial begin - ~SYM[1] = '{default: ~CONST[6]}; -end~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; - end - ~SYM[2] <= ~SYM[1][~ARG[7]]; - end~ELSE - if (~ARG[8] & ~ARG[4]) begin - ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; - end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[7]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; - end - ~SYM[2] <= ~SYM[1][~ARG[7]]; -end~FI -assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[10]]; -// blockRam1 end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_BlockRam.primitives b/prims/systemverilog/Clash_Explicit_BlockRam.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_BlockRam.primitives @@ -0,0 +1,140 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam#" + , "kind" : "Declaration" + , "type" : +"blockRam# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "template" : +"// blockRam begin +~SIGD[~GENSYM[RAM][1]][5]; +logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2]; +initial begin + ~SYM[1] = ~CONST[5]; +end~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + ~SYM[2] <= ~SYM[1][~ARG[6]]; + end~ELSE + if (~ARG[7] & ~ARG[4]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + if (~ARG[4]) begin + ~SYM[2] <= ~SYM[1][~ARG[6]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + ~SYM[2] <= ~SYM[1][~ARG[6]]; +end~FI +assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; +// blockRam end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRamU#" + , "kind" : "Declaration" + , "type" : +"blockRamU# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "template" : +"// blockRamU begin, +~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LIT[5]-1]; +logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + ~SYM[2] <= ~SYM[1][~ARG[6]]; + end~ELSE + if (~ARG[7] & ~ARG[4]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + if (~ARG[4]) begin + ~SYM[2] <= ~SYM[1][~ARG[6]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + end + ~SYM[2] <= ~SYM[1][~ARG[6]]; +end~FI +assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; +// blockRamU end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam1#" + , "kind" : "Declaration" + , "type" : +"blockRam1# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> a -- init, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom a -- din, ARG[10] + -> Signal dom a" + , "template" : +"// blockRam1 begin, +~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LIT[5]-1]; +logic [~SIZE[~TYP[10]]-1:0] ~GENSYM[~RESULT_q][2]; +initial begin + ~SYM[1] = '{default: ~CONST[6]}; +end~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; + end + ~SYM[2] <= ~SYM[1][~ARG[7]]; + end~ELSE + if (~ARG[8] & ~ARG[4]) begin + ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; + end + if (~ARG[4]) begin + ~SYM[2] <= ~SYM[1][~ARG[7]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; + end + ~SYM[2] <= ~SYM[1][~ARG[7]]; +end~FI +assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[10]]; +// blockRam1 end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_BlockRam_File.json b/prims/systemverilog/Clash_Explicit_BlockRam_File.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_BlockRam_File.json +++ /dev/null @@ -1,52 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" - , "kind" : "Declaration" - , "type" : -"blockRamFile# - :: ( KnownDomain dom -- ARG[0] - , KnownNat m -- ARG[1] - , HasCallStack ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> SNat n -- sz, ARG[5] - -> FilePath -- file, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom (BitVector m) -- din, ARG[10] - -> Signal dom (BitVector m)" - , "template" : -"// blockRamFile begin -~SIGDO[~GENSYM[RAM][1]] [0:~LIT[5]-1]; -~SIGD[~GENSYM[~RESULT_q][2]][10]; - -initial begin - $readmemb(~FILE[~LIT[6]],~SYM[1]); -end -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - ~SYM[2] <= ~SYM[1][~ARG[7]]; - end~ELSE - if (~ARG[8] & ~ARG[4]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[7]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - ~SYM[2] <= ~SYM[1][~ARG[7]]; -end~FI - -assign ~RESULT = ~SYM[2]; -// blockRamFile end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives b/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives @@ -0,0 +1,52 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" + , "kind" : "Declaration" + , "type" : +"blockRamFile# + :: ( KnownDomain dom -- ARG[0] + , KnownNat m -- ARG[1] + , HasCallStack ) -- ARG[2] + => Clock dom -- clk, ARG[3] + => Enable dom -- en, ARG[4] + -> SNat n -- sz, ARG[5] + -> FilePath -- file, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom (BitVector m) -- din, ARG[10] + -> Signal dom (BitVector m)" + , "template" : +"// blockRamFile begin +~SIGDO[~GENSYM[RAM][1]] [0:~LIT[5]-1]; +~SIGD[~GENSYM[~RESULT_q][2]][10]; + +initial begin + $readmemb(~FILE[~LIT[6]],~SYM[1]); +end +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + ~SYM[2] <= ~SYM[1][~ARG[7]]; + end~ELSE + if (~ARG[8] & ~ARG[4]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + if (~ARG[4]) begin + ~SYM[2] <= ~SYM[1][~ARG[7]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + ~SYM[2] <= ~SYM[1][~ARG[7]]; +end~FI + +assign ~RESULT = ~SYM[2]; +// blockRamFile end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_DDR.json b/prims/systemverilog/Clash_Explicit_DDR.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_DDR.json +++ /dev/null @@ -1,93 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrIn#" - , "kind" : "Declaration" - , "type" : -"ddrIn# :: forall a slow fast n pFast gated synchronous. - ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4], clk - -> Reset slow -- ARG[5], rst - -> Enable slow -- ARG[6], en - -> a -- ARG[7] - -> a -- ARG[8] - -> a -- ARG[9] - -> Signal fast a -- ARG[10] - -> Signal slow (a,a)" - , "template" : -"// ddrIn begin -~SIGD[~GENSYM[data_Pos][1]][9]; -~SIGD[~GENSYM[data_Neg][2]][9]; -~SIGD[~GENSYM[data_Neg_Latch][3]][9]; -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[1] <= ~ARG[8]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[1] <= ~ARG[10]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[2] <= ~ARG[9]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[2] <= ~ARG[10]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[3] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[3] <= ~SYM[2]; - end -end - -assign ~RESULT = {~SYM[3], ~SYM[1]}; -// ddrIn end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrOut#" - , "kind" : "Declaration" - , "type" : -"ddrOut# :: ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> a -- ARG[7] - -> Signal slow a -- ARG[8] - -> Signal slow a -- ARG[9] - -> Signal fast a" - , "template" : -"// ddrOut begin -~SIGD[~GENSYM[data_Pos][1]][7]; -~SIGD[~GENSYM[data_Neg][2]][7]; -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[1] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[1] <= ~ARG[8]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[2] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[2] <= ~ARG[9]; - end -end - -always @(*) begin - if (~ARG[4]) begin - ~RESULT = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI; - end else begin - ~RESULT = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; - end -end -// ddrOut end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_DDR.primitives b/prims/systemverilog/Clash_Explicit_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_DDR.primitives @@ -0,0 +1,93 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrIn#" + , "kind" : "Declaration" + , "type" : +"ddrIn# :: forall a slow fast n pFast gated synchronous. + ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4], clk + -> Reset slow -- ARG[5], rst + -> Enable slow -- ARG[6], en + -> a -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> Signal fast a -- ARG[10] + -> Signal slow (a,a)" + , "template" : +"// ddrIn begin +~SIGD[~GENSYM[data_Pos][1]][9]; +~SIGD[~GENSYM[data_Neg][2]][9]; +~SIGD[~GENSYM[data_Neg_Latch][3]][9]; +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[1] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[10]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[2] <= ~ARG[9]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[10]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[3] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[3] <= ~SYM[2]; + end +end + +assign ~RESULT = {~SYM[3], ~SYM[1]}; +// ddrIn end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrOut#" + , "kind" : "Declaration" + , "type" : +"ddrOut# :: ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> a -- ARG[7] + -> Signal slow a -- ARG[8] + -> Signal slow a -- ARG[9] + -> Signal fast a" + , "template" : +"// ddrOut begin +~SIGD[~GENSYM[data_Pos][1]][7]; +~SIGD[~GENSYM[data_Neg][2]][7]; +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[1] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[8]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[2] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[9]; + end +end + +always @(*) begin + if (~ARG[4]) begin + ~RESULT = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI; + end else begin + ~RESULT = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; + end +end +// ddrOut end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_RAM.json b/prims/systemverilog/Clash_Explicit_RAM.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_RAM.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.RAM.asyncRam#" - , "kind" : "Declaration" - , "type" : -"asyncRam# - :: ( HasCallStack -- ARG[0] - , KnownDomain wdom wconf -- ARG[1] - , KnownDomain rdom rconf ) -- ARG[2] - => Clock wdom -- ^ wclk, ARG[3] - -> Clock rdom -- ^ rclk, ARG[4] - -> Enable wdom -- ^ wen, ARG[5] - -> SNat n -- ^ sz, ARG[6] - -> Signal rdom Int -- ^ rd, ARG[7] - -> Signal wdom Bool -- ^ en, ARG[8] - -> Signal wdom Int -- ^ wr, ARG[9] - -> Signal wdom a -- ^ din, ARG[10] - -> Signal rdom a" - , "template" : -"// asyncRam begin -logic [~SIZE[~TYP[10]]-1:0] ~GENSYM[RAM][0] [0:~LIT[6]-1]; -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_Ram][1] - if (~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] & ~ELSE ~FI ~ARG[8]) begin - ~SYM[0][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; - end -end - -assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[7]\\]][~TYPO]; -// asyncRam end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_RAM.primitives b/prims/systemverilog/Clash_Explicit_RAM.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_RAM.primitives @@ -0,0 +1,31 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.RAM.asyncRam#" + , "kind" : "Declaration" + , "type" : +"asyncRam# + :: ( HasCallStack -- ARG[0] + , KnownDomain wdom wconf -- ARG[1] + , KnownDomain rdom rconf ) -- ARG[2] + => Clock wdom -- ^ wclk, ARG[3] + -> Clock rdom -- ^ rclk, ARG[4] + -> Enable wdom -- ^ wen, ARG[5] + -> SNat n -- ^ sz, ARG[6] + -> Signal rdom Int -- ^ rd, ARG[7] + -> Signal wdom Bool -- ^ en, ARG[8] + -> Signal wdom Int -- ^ wr, ARG[9] + -> Signal wdom a -- ^ din, ARG[10] + -> Signal rdom a" + , "template" : +"// asyncRam begin +logic [~SIZE[~TYP[10]]-1:0] ~GENSYM[RAM][0] [0:~LIT[6]-1]; +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_Ram][1] + if (~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] & ~ELSE ~FI ~ARG[8]) begin + ~SYM[0][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; + end +end + +assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[7]\\]][~TYPO]; +// asyncRam end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_ROM.json b/prims/systemverilog/Clash_Explicit_ROM.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_ROM.json +++ /dev/null @@ -1,32 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.rom#" - , "kind" : "Declaration" - , "type" : -"rom# :: ( KnownDomain dom ARG[0] - , KnownNat n -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom a" - , "template" : -"// rom begin -~SIGD[~GENSYM[ROM][1]][5]; -assign ~SYM[1] = ~LIT[5]; - -logic [~SIZE[~TYPO]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][3] - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - ~SYM[2] <= ~SYM[1][~ARG[6]]; -end~FI - -assign ~RESULT = ~FROMBV[~SYM[2]][~TYPO]; -// rom end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_ROM.primitives b/prims/systemverilog/Clash_Explicit_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_ROM.primitives @@ -0,0 +1,32 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.rom#" + , "kind" : "Declaration" + , "type" : +"rom# :: ( KnownDomain dom ARG[0] + , KnownNat n -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + => Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom a" + , "template" : +"// rom begin +~SIGD[~GENSYM[ROM][1]][5]; +assign ~SYM[1] = ~LIT[5]; + +logic [~SIZE[~TYPO]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][3] + if (~ARG[4]) begin + ~SYM[2] <= ~SYM[1][~ARG[6]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + ~SYM[2] <= ~SYM[1][~ARG[6]]; +end~FI + +assign ~RESULT = ~FROMBV[~SYM[2]][~TYPO]; +// rom end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_ROM_File.json b/prims/systemverilog/Clash_Explicit_ROM_File.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_ROM_File.json +++ /dev/null @@ -1,35 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.File.romFile#" - , "kind" : "Declaration" - , "type" : -"romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom ) -- ARG[1] - => Clock dom -- clk, ARG[2] - -> Enable dom -- en, ARG[3] - -> SNat n -- sz, ARG[4] - -> FilePath -- file, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom (BitVector m)" - , "template" : -"// romFile begin -~SIGDO[~GENSYM[ROM][0]] [0:~LIT[4]-1]; - -initial begin - $readmemb(~FILE[~LIT[5]],~SYM[0]); -end - -~SIGDO[~GENSYM[~RESULT_q][1]];~IF ~ISACTIVEENABLE[3] ~THEN -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] - if (~ARG[3]) begin - ~SYM[1] <= ~SYM[0][~ARG[6]]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] - ~SYM[1] <= ~SYM[0][~ARG[6]]; -end~FI - -assign ~RESULT = ~SYM[1]; -// romFile end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_ROM_File.primitives b/prims/systemverilog/Clash_Explicit_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_ROM_File.primitives @@ -0,0 +1,35 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.File.romFile#" + , "kind" : "Declaration" + , "type" : +"romFile# :: ( KnownNat m -- ARG[0] + , KnownDomain dom ) -- ARG[1] + => Clock dom -- clk, ARG[2] + -> Enable dom -- en, ARG[3] + -> SNat n -- sz, ARG[4] + -> FilePath -- file, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom (BitVector m)" + , "template" : +"// romFile begin +~SIGDO[~GENSYM[ROM][0]] [0:~LIT[4]-1]; + +initial begin + $readmemb(~FILE[~LIT[5]],~SYM[0]); +end + +~SIGDO[~GENSYM[~RESULT_q][1]];~IF ~ISACTIVEENABLE[3] ~THEN +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] + if (~ARG[3]) begin + ~SYM[1] <= ~SYM[0][~ARG[6]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] + ~SYM[1] <= ~SYM[0][~ARG[6]]; +end~FI + +assign ~RESULT = ~SYM[1]; +// romFile end" + } + } +] diff --git a/prims/systemverilog/Clash_Explicit_Testbench.json b/prims/systemverilog/Clash_Explicit_Testbench.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Explicit_Testbench.json +++ /dev/null @@ -1,60 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assert" - , "kind" : "Declaration" - , "type" : -"assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) - => Clock dom -- ARG[3] - -> Reset dom -- ARG[4] - -> String -- ARG[5] - -> Signal dom a -- Checked value (ARG[6]) - -> Signal dom a -- Expected value (ARG[7]) - -> Signal dom b -- Return valued (ARG[8]) - -> Signal dom b" - , "template" : -"// assert begin -// pragma translate_off -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin - if (~ARG[6] !== ~ARG[7]) begin - $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[5], ~TOBV[~ARG[7]][~TYP[7]], ~TOBV[~ARG[6]][~TYP[6]]); - $stop; - end -end -// pragma translate_on -assign ~RESULT = ~ARG[8]; -// assert end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assertBitVector" - , "kind" : "Declaration" - , "type" : -"assertBitVector - :: ( KnownDomain dom -- ARG[0] - , KnownNat n ) -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> String -- ARG[4] - -> Signal dom (BitVector n) -- Checked value (ARG[5]) - -> Signal dom (BitVector n) -- Expected value (ARG[6]) - -> Signal dom b -- Return valued (ARG[7]) - -> Signal dom b" - , "template" : -"// assertBitVector begin -// pragma translate_off -wire ~TYP[6] ~GENSYM[maskXor][0] = ~ARG[6] ^ ~ARG[6]; -wire ~TYP[6] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; -wire ~TYP[6] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; - -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin - if (~SYM[1] !== ~SYM[2]) begin - $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[4], ~TOBV[~ARG[6]][~TYP[6]], ~TOBV[~ARG[5]][~TYP[5]]); - $stop; - end -end -// pragma translate_on -assign ~RESULT = ~ARG[7]; -// assertBitVector end" - } - } -] diff --git a/prims/systemverilog/Clash_Explicit_Testbench.primitives b/prims/systemverilog/Clash_Explicit_Testbench.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Explicit_Testbench.primitives @@ -0,0 +1,60 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assert" + , "kind" : "Declaration" + , "type" : +"assert + :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) + => Clock dom -- ARG[3] + -> Reset dom -- ARG[4] + -> String -- ARG[5] + -> Signal dom a -- Checked value (ARG[6]) + -> Signal dom a -- Expected value (ARG[7]) + -> Signal dom b -- Return valued (ARG[8]) + -> Signal dom b" + , "template" : +"// assert begin +// pragma translate_off +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin + if (~ARG[6] !== ~ARG[7]) begin + $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[5], ~TOBV[~ARG[7]][~TYP[7]], ~TOBV[~ARG[6]][~TYP[6]]); + $stop; + end +end +// pragma translate_on +assign ~RESULT = ~ARG[8]; +// assert end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assertBitVector" + , "kind" : "Declaration" + , "type" : +"assertBitVector + :: ( KnownDomain dom -- ARG[0] + , KnownNat n ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> String -- ARG[4] + -> Signal dom (BitVector n) -- Checked value (ARG[5]) + -> Signal dom (BitVector n) -- Expected value (ARG[6]) + -> Signal dom b -- Return valued (ARG[7]) + -> Signal dom b" + , "template" : +"// assertBitVector begin +// pragma translate_off +wire ~TYP[6] ~GENSYM[maskXor][0] = ~ARG[6] ^ ~ARG[6]; +wire ~TYP[6] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; +wire ~TYP[6] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; + +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin + if (~SYM[1] !== ~SYM[2]) begin + $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[4], ~TOBV[~ARG[6]][~TYP[6]], ~TOBV[~ARG[5]][~TYP[5]]); + $stop; + end +end +// pragma translate_on +assign ~RESULT = ~ARG[7]; +// assertBitVector end" + } + } +] diff --git a/prims/systemverilog/Clash_Intel_DDR.json b/prims/systemverilog/Clash_Intel_DDR.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Intel_DDR.json +++ /dev/null @@ -1,48 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Intel.DDR.altddioIn" - , "kind" : "Declaration" - , "type" : -"altddioIn - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - => SSymbol deviceFamily -- ARG[4] - -> Clock slow -- ARG[5] - -> Reset slow -- ARG[6] - -> Enable slow -- ARG[7] - -> Signal fast (BitVector m) -- ARG[8] - -> Signal slow (BitVector m,BitVector m)" - , "libraries" : ["altera_mf"] - , "template" : -"// altddioIn begin -~SIGD[~GENSYM[dataout_l][1]][8]; -~SIGD[~GENSYM[dataout_h][2]][8]; - -altddio_in - #( - .intended_device_family (~LIT[4]), - .invert_input_clocks (\"OFF\"), - .lpm_hint (\"UNUSED\"), - .lpm_type (\"altddio_in\"), - .power_up_high (\"OFF\"), - .width (~SIZE[~TYP[8]]) - ) - ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), - .aclr (1'b0),~ELSE - .aclr (~ARG[6]), - .sclr (1'b0),~FI - .datain (~ARG[8]), - .inclock (~ARG[5]), - .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN~ARG[7]~ELSE1'b1,~FI), - .dataout_h (~SYM[2]), - .dataout_l (~SYM[1]), - .aset (1'b0), - .sset (1'b0) - ); -assign ~RESULT = {~SYM[1],~SYM[2]}; -// altddioIn end" - } - } -] diff --git a/prims/systemverilog/Clash_Intel_DDR.primitives b/prims/systemverilog/Clash_Intel_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Intel_DDR.primitives @@ -0,0 +1,48 @@ +[ { "BlackBox" : + { "name" : "Clash.Intel.DDR.altddioIn" + , "kind" : "Declaration" + , "type" : +"altddioIn + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + => SSymbol deviceFamily -- ARG[4] + -> Clock slow -- ARG[5] + -> Reset slow -- ARG[6] + -> Enable slow -- ARG[7] + -> Signal fast (BitVector m) -- ARG[8] + -> Signal slow (BitVector m,BitVector m)" + , "libraries" : ["altera_mf"] + , "template" : +"// altddioIn begin +~SIGD[~GENSYM[dataout_l][1]][8]; +~SIGD[~GENSYM[dataout_h][2]][8]; + +altddio_in + #( + .intended_device_family (~LIT[4]), + .invert_input_clocks (\"OFF\"), + .lpm_hint (\"UNUSED\"), + .lpm_type (\"altddio_in\"), + .power_up_high (\"OFF\"), + .width (~SIZE[~TYP[8]]) + ) + ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN + .sclr (~ARG[6]), + .aclr (1'b0),~ELSE + .aclr (~ARG[6]), + .sclr (1'b0),~FI + .datain (~ARG[8]), + .inclock (~ARG[5]), + .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN~ARG[7]~ELSE1'b1,~FI), + .dataout_h (~SYM[2]), + .dataout_l (~SYM[1]), + .aset (1'b0), + .sset (1'b0) + ); +assign ~RESULT = {~SYM[1],~SYM[2]}; +// altddioIn end" + } + } +] diff --git a/prims/systemverilog/Clash_Prelude_ROM.json b/prims/systemverilog/Clash_Prelude_ROM.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Prelude_ROM.json +++ /dev/null @@ -1,18 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.asyncRom#" - , "kind" : "Declaration" - , "type" : -"asyncRom# :: KnownNat n -- ^ ARG[0] - => Vec n a -- ^ ARG[1] - -> Int -- ^ ARG[2] - -> a" - , "template" : -"// asyncRom begin -~SIGD[~GENSYM[ROM][0]][1]; -assign ~SYM[0] = ~LIT[1]; - -assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[2]\\]][~TYPO]; -// asyncRom end" - } - } -] diff --git a/prims/systemverilog/Clash_Prelude_ROM.primitives b/prims/systemverilog/Clash_Prelude_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Prelude_ROM.primitives @@ -0,0 +1,18 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.asyncRom#" + , "kind" : "Declaration" + , "type" : +"asyncRom# :: KnownNat n -- ^ ARG[0] + => Vec n a -- ^ ARG[1] + -> Int -- ^ ARG[2] + -> a" + , "template" : +"// asyncRom begin +~SIGD[~GENSYM[ROM][0]][1]; +assign ~SYM[0] = ~LIT[1]; + +assign ~RESULT = ~FROMBV[~SYM[0][\\~ARG[2]\\]][~TYPO]; +// asyncRom end" + } + } +] diff --git a/prims/systemverilog/Clash_Prelude_ROM_File.json b/prims/systemverilog/Clash_Prelude_ROM_File.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Prelude_ROM_File.json +++ /dev/null @@ -1,22 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" - , "kind" : "Declaration" - , "type" : -"asyncRomFile :: KnownNat m -- ARG[0] - => SNat n -- sz, ARG[1] - -> FilePath -- file, ARG[2] - -> Int -- rd, ARG[3] - -> BitVector m" - , "template" : -"// asyncRomFile begin -~SIGDO[~GENSYM[ROM][0]] [0:~LIT[1]-1]; - -initial begin - $readmemb(~FILE[~LIT[2]],~SYM[0]); -end - -assign ~RESULT = ~SYM[0][~ARG[3]]; -// asyncRomFile end" - } - } -] diff --git a/prims/systemverilog/Clash_Prelude_ROM_File.primitives b/prims/systemverilog/Clash_Prelude_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Prelude_ROM_File.primitives @@ -0,0 +1,22 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" + , "kind" : "Declaration" + , "type" : +"asyncRomFile :: KnownNat m -- ARG[0] + => SNat n -- sz, ARG[1] + -> FilePath -- file, ARG[2] + -> Int -- rd, ARG[3] + -> BitVector m" + , "template" : +"// asyncRomFile begin +~SIGDO[~GENSYM[ROM][0]] [0:~LIT[1]-1]; + +initial begin + $readmemb(~FILE[~LIT[2]],~SYM[0]); +end + +assign ~RESULT = ~SYM[0][~ARG[3]]; +// asyncRomFile end" + } + } +] diff --git a/prims/systemverilog/Clash_Signal_BiSignal.json b/prims/systemverilog/Clash_Signal_BiSignal.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Signal_BiSignal.json +++ /dev/null @@ -1,35 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", - "kind" : "Declaration", - "renderVoid": "RenderVoid", - "type" : -"writeToBiSignal# - :: HasCallStack -- ARG[0] - => BiSignalIn ds d n -- ARG[1] - -> Signal d (Maybe (BitVector n)) -- ARG[2] - -> Signal d Bool -- ARG[3] - -> Signal d (BitVector n) -- ARG[4] - -> BiSignalOut ds d n", - "template": -"// writeToBiSignal# begin -assign ~ARG[1] = (~ARG[3] == 1'b1) ? ~ARG[4] : {~SIZE[~TYP[1]] {1'bz}}; -// writeToBiSignal# end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"readFromBiSignal# - :: ( HasCallStack -- ARG[0] - , KnownNat n) -- ARG[1] - => BiSignalIn ds d n -- ARG[2] - -> Signal d (BitVector n)" - , "template" : -"// readFromBiSignal begin -assign ~RESULT = ~ARG[2]; -// readFromBiSignal end" - } - } -] diff --git a/prims/systemverilog/Clash_Signal_BiSignal.primitives b/prims/systemverilog/Clash_Signal_BiSignal.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Signal_BiSignal.primitives @@ -0,0 +1,35 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", + "kind" : "Declaration", + "renderVoid": "RenderVoid", + "type" : +"writeToBiSignal# + :: HasCallStack -- ARG[0] + => BiSignalIn ds d n -- ARG[1] + -> Signal d (Maybe (BitVector n)) -- ARG[2] + -> Signal d Bool -- ARG[3] + -> Signal d (BitVector n) -- ARG[4] + -> BiSignalOut ds d n", + "template": +"// writeToBiSignal# begin +assign ~ARG[1] = (~ARG[3] == 1'b1) ? ~ARG[4] : {~SIZE[~TYP[1]] {1'bz}}; +// writeToBiSignal# end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"readFromBiSignal# + :: ( HasCallStack -- ARG[0] + , KnownNat n) -- ARG[1] + => BiSignalIn ds d n -- ARG[2] + -> Signal d (BitVector n)" + , "template" : +"// readFromBiSignal begin +assign ~RESULT = ~ARG[2]; +// readFromBiSignal end" + } + } +] diff --git a/prims/systemverilog/Clash_Signal_Internal.json b/prims/systemverilog/Clash_Signal_Internal.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Signal_Internal.json +++ /dev/null @@ -1,138 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.Internal.delay#" - , "kind" : "Declaration" - , "type" : -"delay# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Enable dom -- ARG[3] - -> a -- ARG[4] - -> Signal clk a -- ARG[5] - -> Signal clk a" - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } - , "template" : -"// delay begin~IF ~ISACTIVEENABLE[3] ~THEN -always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] - if (~ARG[3]) begin - ~RESULT <= ~ARG[5]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] - ~RESULT <= ~ARG[5]; -end~FI -// delay end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.register#" - , "kind" : "Declaration" - , "type" : -"register# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> Enable dom -- ARG[4] - -> a -- ARG[5] (powerup value) - -> a -- ARG[6] (reset value) - -> Signal clk a -- ARG[7] - -> Signal clk a" - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } - , "template" : -"// register begin -always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] - if (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin - ~RESULT <= ~CONST[6]; - end else ~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin - ~RESULT <= ~ARG[7]; - end -end -// register end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.clockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" - , "type" : -"clockGen - :: KnownDomain dom -- ARG[0] - => Clock dom" - , "template" : -"// clockGen begin -// pragma translate_off -// 1 = 0.1ps -localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); -always begin - ~RESULT = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; - #30000 forever begin - ~RESULT = ~ ~RESULT; - #~SYM[0]; - ~RESULT = ~ ~RESULT; - #~SYM[0]; - end -end -// pragma translate_on -// clockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.tbClockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" - , "type" : -"tbClockGen - :: KnownDomain dom -- ARG[0] - => Signal dom Bool -- ARG[1] - -> Clock dom" - , "template" : -"// tbClockGen begin -// pragma translate_off -// 1 = 0.1ps -localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); -always begin - ~RESULT = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; - #30000 forever begin - if (~ ~ARG[1]) begin - $finish; - end - ~RESULT = ~ ~RESULT; - #~SYM[0]; - ~RESULT = ~ ~RESULT; - #~SYM[0]; - end -end -// pragma translate_on -// tbClockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.resetGenN" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" - , "template" : -"// resetGen begin -// pragma translate_off -~IF~ISSYNC[0]~THEN -localparam ~GENSYM[reset_period][1] = 29998 + (~LIT[2] * ~PERIOD[0]0); -initial begin - #1 ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; - #~SYM[1] ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; -end~ELSE -localparam ~SYM[1] = 30001 + ((~LIT[2] - 1) * ~PERIOD[0]0); -initial begin - #1 ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; - #~SYM[1] ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; -end -~FI -// pragma translate_on -// resetGen end" - } - } -] diff --git a/prims/systemverilog/Clash_Signal_Internal.primitives b/prims/systemverilog/Clash_Signal_Internal.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Signal_Internal.primitives @@ -0,0 +1,166 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.Internal.delay#" + , "kind" : "Declaration" + , "type" : +"delay# + :: ( KnownDomain dom -- ARG[0] + , Undefined a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Enable dom -- ARG[3] + -> a -- ARG[4] + -> Signal clk a -- ARG[5] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } + , "template" : +"// delay begin~IF ~ISACTIVEENABLE[3] ~THEN +always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] + if (~ARG[3]) begin + ~RESULT <= ~ARG[5]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] + ~RESULT <= ~ARG[5]; +end~FI +// delay end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.asyncRegister#" + , "kind" : "Declaration" + , "type" : +"asyncRegister# + :: ( KnownDomain dom -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"// async register begin +always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + ~RESULT <= ~CONST[6]; + end else ~FI~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin + ~RESULT <= ~ARG[7]; + end +end +// async register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.register#" + , "kind" : "Declaration" + , "type" : +"register# + :: ( KnownDomain dom -- ARG[0] + , Undefined a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"// register begin +always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + ~RESULT <= ~CONST[6]; + end else ~FI~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin + ~RESULT <= ~ARG[7]; + end +end +// register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.clockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" + , "type" : +"clockGen + :: KnownDomain dom -- ARG[0] + => Clock dom" + , "template" : +"// clockGen begin +// pragma translate_off +// 1 = 0.1ps +localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); +always begin + ~RESULT = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; + #30000 forever begin + ~RESULT = ~ ~RESULT; + #~SYM[0]; + ~RESULT = ~ ~RESULT; + #~SYM[0]; + end +end +// pragma translate_on +// clockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.tbClockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" + , "type" : +"tbClockGen + :: KnownDomain dom -- ARG[0] + => Signal dom Bool -- ARG[1] + -> Clock dom" + , "template" : +"// tbClockGen begin +// pragma translate_off +// 1 = 0.1ps +localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); +always begin + ~RESULT = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; + #30000 forever begin + if (~ ~ARG[1]) begin + $finish; + end + ~RESULT = ~ ~RESULT; + #~SYM[0]; + ~RESULT = ~ ~RESULT; + #~SYM[0]; + end +end +// pragma translate_on +// tbClockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.resetGenN" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" + , "template" : +"// resetGen begin +// pragma translate_off +~IF~ISSYNC[0]~THEN +localparam ~GENSYM[reset_period][1] = 29998 + (~LIT[2] * ~PERIOD[0]0); +initial begin + #1 ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; + #~SYM[1] ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; +end~ELSE +localparam ~SYM[1] = 30001 + ((~LIT[2] - 1) * ~PERIOD[0]0); +initial begin + #1 ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; + #~SYM[1] ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; +end +~FI +// pragma translate_on +// resetGen end" + } + } +] diff --git a/prims/systemverilog/Clash_Sized_Internal_BitVector.json b/prims/systemverilog/Clash_Sized_Internal_BitVector.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Sized_Internal_BitVector.json +++ /dev/null @@ -1,79 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" - , "kind" : "Declaration" - , "type" : -"replaceBit# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Int -- ARG[2] - -> Bit -- ARG[3] - -> BitVector n" - , "template" : -"// replaceBit start -always_comb begin - ~RESULT = ~ARG[1]; - ~RESULT[~ARG[2]] = ~ARG[3]; -end -// replaceBit end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.setSlice#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"setSlice# :: SNat (m + 1 + i) - -> BitVector (m + 1 + i) -- ARG[1] - -> SNat m -- ARG[2] - -> SNat n -- ARG[3] - -> BitVector (m + 1 - n) -- ARG[4] - -> BitVector (m + 1 + i)" - , "template" : -"// setSlice begin -always_comb begin - ~RESULT = ~ARG[1]; - ~RESULT[~LIT[2] : ~LIT[3]] = ~ARG[4]; -end -// setSlice end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.split#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"split# :: KnownNat n -- ARG[0] - => BitVector (m + n) -- ARG[1] - -> (BitVector m, BitVector n)" - , "template" : -"// split begin -assign ~RESULT = { ~VAR[bv][1][$high(~VAR[bv][1]) : ~LIT[0]] - , ~VAR[bv][1][(~LIT[0]-1) : 0] - }; -// split end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : -"// rotateL begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : -"// rotateR begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; -// rotateR end" - } - } -] diff --git a/prims/systemverilog/Clash_Sized_Internal_BitVector.primitives b/prims/systemverilog/Clash_Sized_Internal_BitVector.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Sized_Internal_BitVector.primitives @@ -0,0 +1,79 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" + , "kind" : "Declaration" + , "type" : +"replaceBit# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit -- ARG[3] + -> BitVector n" + , "template" : +"// replaceBit start +always_comb begin + ~RESULT = ~ARG[1]; + ~RESULT[~ARG[2]] = ~ARG[3]; +end +// replaceBit end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.setSlice#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"setSlice# :: SNat (m + 1 + i) + -> BitVector (m + 1 + i) -- ARG[1] + -> SNat m -- ARG[2] + -> SNat n -- ARG[3] + -> BitVector (m + 1 - n) -- ARG[4] + -> BitVector (m + 1 + i)" + , "template" : +"// setSlice begin +always_comb begin + ~RESULT = ~ARG[1]; + ~RESULT[~LIT[2] : ~LIT[3]] = ~ARG[4]; +end +// setSlice end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.split#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"split# :: KnownNat n -- ARG[0] + => BitVector (m + n) -- ARG[1] + -> (BitVector m, BitVector n)" + , "template" : +"// split begin +assign ~RESULT = { ~VAR[bv][1][$high(~VAR[bv][1]) : ~LIT[0]] + , ~VAR[bv][1][(~LIT[0]-1) : 0] + }; +// split end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : +"// rotateL begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : +"// rotateR begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; +// rotateR end" + } + } +] diff --git a/prims/systemverilog/Clash_Sized_Internal_Signed.json b/prims/systemverilog/Clash_Sized_Internal_Signed.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Sized_Internal_Signed.json +++ /dev/null @@ -1,69 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.div#" - , "kind" : "Declaration" - , "type" : "div# :: Signed n -> Signed n -> Signed n" - , "template" : -"// divSigned begin -logic ~GENSYM[resultPos][1]; -logic ~GENSYM[dividerNeg][2]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divSigned end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.mod#" - , "kind" : "Declaration" - , "type" : "mod# :: Signed n -> Signed n -> Signed n" - , "template" : -"// modSigned begin -// remainder -~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - (~SYM[0] == ~SIZE[~TYPO]'sd0 ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modSigned end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : -"// rotateL begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = $signed(~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]); -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : -"// rotateR begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = $signed(~SYM[0][~SIZE[~TYPO]-1 : 0]); -// rotateR end" - } - } -] diff --git a/prims/systemverilog/Clash_Sized_Internal_Signed.primitives b/prims/systemverilog/Clash_Sized_Internal_Signed.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Sized_Internal_Signed.primitives @@ -0,0 +1,69 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.div#" + , "kind" : "Declaration" + , "type" : "div# :: Signed n -> Signed n -> Signed n" + , "template" : +"// divSigned begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divSigned end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.mod#" + , "kind" : "Declaration" + , "type" : "mod# :: Signed n -> Signed n -> Signed n" + , "template" : +"// modSigned begin +// remainder +~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + (~SYM[0] == ~SIZE[~TYPO]'sd0 ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modSigned end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : +"// rotateL begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = $signed(~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]); +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : +"// rotateR begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = $signed(~SYM[0][~SIZE[~TYPO]-1 : 0]); +// rotateR end" + } + } +] diff --git a/prims/systemverilog/Clash_Sized_Internal_Unsigned.json b/prims/systemverilog/Clash_Sized_Internal_Unsigned.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Sized_Internal_Unsigned.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : -"// rotateL begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : -"// rotateR begin -logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; -// rotateR end" - } - } -] diff --git a/prims/systemverilog/Clash_Sized_Internal_Unsigned.primitives b/prims/systemverilog/Clash_Sized_Internal_Unsigned.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Sized_Internal_Unsigned.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : +"// rotateL begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : +"// rotateR begin +logic [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; +// rotateR end" + } + } +] diff --git a/prims/systemverilog/Clash_Sized_RTree.json b/prims/systemverilog/Clash_Sized_RTree.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Sized_RTree.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.RTree.treplicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat d -> a -> RTree d a" - , "template" : "'{(2**~LIT[0]) {~TOBV[~ARG[1]][~TYP[1]]}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.textract" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "textract :: RTree 0 a -> a" - , "template" : "~FROMBV[~VAR[tree][0][\\0\\]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.tsplit" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" - , "template" : "~TOBV[~VAR[tree][0]][~TYP[0]]" - } - } -] diff --git a/prims/systemverilog/Clash_Sized_RTree.primitives b/prims/systemverilog/Clash_Sized_RTree.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Sized_RTree.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.RTree.treplicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat d -> a -> RTree d a" + , "template" : "'{(2**~LIT[0]) {~TOBV[~ARG[1]][~TYP[1]]}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.textract" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "textract :: RTree 0 a -> a" + , "template" : "~FROMBV[~VAR[tree][0][\\0\\]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.tsplit" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" + , "template" : "~TOBV[~VAR[tree][0]][~TYP[0]]" + } + } +] diff --git a/prims/systemverilog/Clash_Sized_Vector.json b/prims/systemverilog/Clash_Sized_Vector.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Sized_Vector.json +++ /dev/null @@ -1,377 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Vector.head" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "head :: Vec (n + 1) a -> a" - , "template" : "~FROMBV[~VAR[vec][0][\\0\\]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.tail" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tail :: Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0][1 : $high(~VAR[vec][0])]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.last" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> a" - , "template" : "~FROMBV[~VAR[vec][0][\\$high(~VAR[vec][0])\\]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.init" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0][0 : $high(~VAR[vec][0]) - 1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.select" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] - => SNat f -- ARG[1] - -> SNat s -- ARG[2] - -> SNat n -- ARG[3] - -> Vec i a -- ARG[4] - -> Vec n a" - , "template" : -"// select begin -genvar ~GENSYM[n][1]; -~GENERATE - for (~SYM[1]=0; ~SYM[1] < ~LIT[3]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[select][2] - assign ~RESULT[~SYM[1]] = ~VAR[vec][4][~LIT[1] + (~LIT[2] * ~SYM[1])]; - end -~ENDGENERATE -// select end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.++" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" - , "template" : "~FROMBV[{~TOBV[~ARG[0]][~TYP[0]],~TOBV[~ARG[1]][~TYP[1]]}][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concat" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" - , "template" : -"// concat begin -genvar ~GENSYM[n][1]; -~GENERATE - for (~SYM[1]=0; ~SYM[1] < $size(~VAR[vec][0]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[concat][2] - assign ~RESULT[~SYM[1]*~LENGTH[~TYPEL[~TYP[0]]] : ~SYM[1]*~LENGTH[~TYPEL[~TYP[0]]]+(~LENGTH[~TYPEL[~TYP[0]]]-1)] = ~FROMBV[~VAR[vec][0][\\~SYM[1]\\]][~TYPEL[~TYP[0]]]; - end -~ENDGENERATE -// concat end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.splitAt" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" - , "template" : -"// splitAt begin~IF~LENGTH[~TYPO]~THEN -assign ~RESULT = ~ARG[1];~ELSE -logic [0:~LENGTH[~TYP[1]]-1] [0:~SIZE[~TYPEL[~TYP[1]]]-1] ~GENSYM[vec][0]; -assign ~SYM[0] = ~TOBV[~ARG[1]][~TYP[1]]; -~GENERATE - if (~LIT[0] == ~LENGTH[~TYP[1]]) begin : ~GENSYM[no_split][1] - assign ~RESULT = {~SYM[0]}; - end else begin : ~GENSYM[do_split][2] - assign ~RESULT = {~SYM[0][0:~LIT[0]-1] - ,~SYM[0][~LIT[0]:~LENGTH[~TYP[1]]-1] - }; - end -~ENDGENERATE~FI -// splitAt end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcat" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : - "unconcat :: KnownNat n -- ARG[0] - => SNat m -- ARG[1] - -> Vec (n * m) a -- ARG[2] - -> Vec n (Vec m a)" - , "template" : -"// unconcat begin~DEVNULL[~ARG[0]] -genvar ~GENSYM[n][1]; -~GENERATE - for (~SYM[1] = 0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[unconcat][2] - assign ~RESULT[~SYM[1]] = ~TOBV[~VAR[vec][2][\\(~SYM[1] * ~LIT[1]) : ((~SYM[1] * ~LIT[1]) + ~LIT[1] - 1)\\]][~TYPEL[~TYPO]]; - end -~ENDGENERATE -// unconcat end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.map" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" - , "template" : -"// map begin -genvar ~GENSYM[n][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[map][2]~IF~SIZE[~TYP[1]]~THEN - ~TYPEL[~TYP[1]] ~GENSYM[map_in][3]; - assign ~SYM[3] = ~FROMBV[~VAR[vec][1][\\~SYM[1]\\]][~TYPEL[~TYP[1]]];~ELSE ~FI - ~TYPEL[~TYPO] ~GENSYM[map_out][4]; - ~INST 0 - ~OUTPUT <= ~SYM[4]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ - ~INST - assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[4]][~TYPEL[~TYPO]]; -end -~ENDGENERATE -// map end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" - , "template" : -"// imap begin -genvar ~GENSYM[n][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] - ~INDEXTYPE[~LIT[0]] ~GENSYM[i][3]; - assign ~SYM[3] = ~SYM[1];~IF~SIZE[~TYP[2]]~THEN - ~TYPEL[~TYP[2]] ~GENSYM[imap_in][4]; - assign ~SYM[4] = ~FROMBV[~VAR[vec][2][\\~SYM[1]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI - ~TYPEL[~TYPO] ~GENSYM[imap_out][5]; - ~INST 1 - ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~INDEXTYPE[~LIT[0]]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[5]][~TYPEL[~TYPO]]; -end -~ENDGENERATE -// imap end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap_go" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap_go :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" - , "template" : -"// imap begin -genvar ~GENSYM[n][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] - ~TYP[0] ~GENSYM[i][3]; - assign ~SYM[3] = ~SYM[1] + ~ARG[0];~IF~SIZE[~TYP[2]]~THEN - ~TYPEL[~TYP[2]] ~GENSYM[imap_in][4]; - assign ~SYM[4] = ~FROMBV[~VAR[vec][2][\\~SYM[1]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI - ~TYPEL[~TYPO] ~GENSYM[imap_out][5]; - ~INST 1 - ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~TYP[0]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[5]][~TYPEL[~TYPO]]; -end -~ENDGENERATE -// imap end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.zipWith" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" - , "template" : -"// zipWith begin -genvar ~GENSYM[n][2]; -~GENERATE -for (~SYM[2] = 0; ~SYM[2] < $size(~RESULT); ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[zipWith][3]~IF~SIZE[~TYP[1]]~THEN - ~TYPEL[~TYP[1]] ~GENSYM[zipWith_in1][4]; - assign ~SYM[4] = ~FROMBV[~VAR[vec1][1][\\~SYM[2]\\]][~TYPEL[~TYP[1]]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN - ~TYPEL[~TYP[2]] ~GENSYM[zipWith_in2][5]; - assign ~SYM[5] = ~FROMBV[~VAR[vec2][2][\\~SYM[2]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI - ~TYPEL[~TYPO] ~GENSYM[zipWith_out][6]; - ~INST 0 - ~OUTPUT <= ~SYM[6]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[2]] = ~TOBV[~SYM[6]][~TYPEL[~TYPO]]; -end -~ENDGENERATE -// zipWith end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.foldr" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" - , "template" : -"// foldr start~IF ~LENGTH[~TYP[2]] ~THEN -~SIGDO[~GENSYM[intermediate][0]] [0:~LENGTH[~TYP[2]]]; -assign ~SYM[0][~LENGTH[~TYP[2]]] = ~ARG[1]; - -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0; ~SYM[3] < ~LENGTH[~TYP[2]]; ~SYM[3]=~SYM[3]+1) begin : ~GENSYM[foldr_loop][4]~IF~SIZE[~TYP[2]]~THEN - ~TYPEL[~TYP[2]] ~GENSYM[foldr_in][5]; - assign ~SYM[5] = ~FROMBV[~VAR[xs][2][\\~SYM[3]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI - ~INST 0 - ~OUTPUT <= ~SYM[0][~SYM[3]]~ ~TYP[1]~ - ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[0][~SYM[3]+1]~ ~TYP[1]~ - ~INST -end -~ENDGENERATE - -assign ~RESULT = ~SYM[0][0]; -~ELSE -assign ~RESULT = ~ARG[1]; -~FI// foldr end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.index_int" - , "kind" : "Expression" - , "type" : "index_int :: KnownNat n => Vec n a -> Int -> a" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~FROMBV[~VAR[vec][1][\\~ARG[2]\\]][~TYPO]~ELSE~ERRORO~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replace_int" - , "kind" : "Declaration" - , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" - , "template" : -"// replaceVec start -always_comb begin - ~RESULT = ~ARG[1]; - ~RESULT[~ARG[2]] = ~TOBV[~ARG[3]][~TYP[3]]; -end -// replaceVec end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat n -> a -> Vec n a" - , "template" : "'{~LIT[0] {~TOBV[~ARG[1]][~TYP[1]]}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.transpose" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" - , "template" : -"// transpose begin -genvar ~GENSYM[row_index][1]; -genvar ~GENSYM[col_index][2]; -~GENERATE - for (~SYM[1] = 0; ~SYM[1] < $size(~VAR[matrix][1]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[transpose_outer][3] - for (~SYM[2] = 0; ~SYM[2] < $size(~RESULT); ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[transpose_inner][4]~IF ~VIVADO ~THEN - assign ~RESULT[~SYM[2]][($size(~VAR[matrix][1])-~SYM[1])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 : ($size(~VAR[matrix][1])-~SYM[1]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]] = ~VAR[matrix][1][~SYM[1]][($size(~RESULT)-~SYM[2])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 : ($size(~RESULT)-~SYM[2]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]];~ELSE - assign ~RESULT[~SYM[2]][~SYM[1]] = ~VAR[matrix][1][~SYM[1]][~SYM[2]];~FI - end - end -~ENDGENERATE -// transpose end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.reverse" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "reverse :: Vec n a -> Vec n a" - , "template" : -"// reverse begin -genvar ~GENSYM[n][1]; -~GENERATE - for (~SYM[1] = 0; ~SYM[1] < $size(~VAR[vec][0]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[reverse][2] - assign ~RESULT[$high(~VAR[vec][0]) - ~SYM[1]] = ~VAR[vec][0][~SYM[1]]; - end -~ENDGENERATE -// reverse end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concatBitVector#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"concatBitVector# :: (KnownNat n,KnownNat m) -- (ARG[0],ARG[1]) - => Vec n (BitVector m) -- ARG[2] - -> BitVector (n * m)" - , "template" : "~TOBV[~ARG[2]][~TYP[2]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcatBitVector#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) - => BitVector (n * m) -- ARG[2] - -> Vec n (BitVector m)" - , "template" : "~FROMBV[~ARG[2]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateLeftS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"// rotateLeftS begin -localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; - -~GENERATE -if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] - assign ~RESULT = ~VAR[vec][1]; -end else begin : ~GENSYM[do_shift][4] - assign ~RESULT[0:~LIT[0]-~SYM[2]-1] = ~VAR[vec][1][~SYM[2]:~LIT[0]-1]; - assign ~RESULT[~LIT[0]-~SYM[2]:~LIT[0]-1] = ~VAR[vec][1][0:~SYM[2]-1]; -end -~ENDGENERATE -// rotateLeftS end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateRightS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"// rotateRightS begin -localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; - -~GENERATE -if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] - assign ~RESULT = ~VAR[vec][1]; -end else begin : ~GENSYM[do_shift][4] - assign ~RESULT[0:~SYM[2]-1] = ~VAR[vec][1][~LIT[0]-~SYM[2]:~LIT[0]-1]; - assign ~RESULT[~SYM[2]:~LIT[0]-1] = ~VAR[vec][1][0:~LIT[0]-~SYM[2]-1]; -end -~ENDGENERATE -// rotateRightS end" - } - } -] diff --git a/prims/systemverilog/Clash_Sized_Vector.primitives b/prims/systemverilog/Clash_Sized_Vector.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Sized_Vector.primitives @@ -0,0 +1,377 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Vector.head" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "head :: Vec (n + 1) a -> a" + , "template" : "~FROMBV[~VAR[vec][0][\\0\\]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.tail" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tail :: Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0][1 : $high(~VAR[vec][0])]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.last" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> a" + , "template" : "~FROMBV[~VAR[vec][0][\\$high(~VAR[vec][0])\\]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.init" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0][0 : $high(~VAR[vec][0]) - 1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.select" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] + => SNat f -- ARG[1] + -> SNat s -- ARG[2] + -> SNat n -- ARG[3] + -> Vec i a -- ARG[4] + -> Vec n a" + , "template" : +"// select begin +genvar ~GENSYM[n][1]; +~GENERATE + for (~SYM[1]=0; ~SYM[1] < ~LIT[3]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[select][2] + assign ~RESULT[~SYM[1]] = ~VAR[vec][4][~LIT[1] + (~LIT[2] * ~SYM[1])]; + end +~ENDGENERATE +// select end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.++" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" + , "template" : "~FROMBV[{~TOBV[~ARG[0]][~TYP[0]],~TOBV[~ARG[1]][~TYP[1]]}][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concat" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" + , "template" : +"// concat begin +genvar ~GENSYM[n][1]; +~GENERATE + for (~SYM[1]=0; ~SYM[1] < $size(~VAR[vec][0]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[concat][2] + assign ~RESULT[~SYM[1]*~LENGTH[~TYPEL[~TYP[0]]] : ~SYM[1]*~LENGTH[~TYPEL[~TYP[0]]]+(~LENGTH[~TYPEL[~TYP[0]]]-1)] = ~FROMBV[~VAR[vec][0][\\~SYM[1]\\]][~TYPEL[~TYP[0]]]; + end +~ENDGENERATE +// concat end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.splitAt" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" + , "template" : +"// splitAt begin~IF~LENGTH[~TYPO]~THEN +assign ~RESULT = ~ARG[1];~ELSE +logic [0:~LENGTH[~TYP[1]]-1] [0:~SIZE[~TYPEL[~TYP[1]]]-1] ~GENSYM[vec][0]; +assign ~SYM[0] = ~TOBV[~ARG[1]][~TYP[1]]; +~GENERATE + if (~LIT[0] == ~LENGTH[~TYP[1]]) begin : ~GENSYM[no_split][1] + assign ~RESULT = {~SYM[0]}; + end else begin : ~GENSYM[do_split][2] + assign ~RESULT = {~SYM[0][0:~LIT[0]-1] + ,~SYM[0][~LIT[0]:~LENGTH[~TYP[1]]-1] + }; + end +~ENDGENERATE~FI +// splitAt end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcat" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : + "unconcat :: KnownNat n -- ARG[0] + => SNat m -- ARG[1] + -> Vec (n * m) a -- ARG[2] + -> Vec n (Vec m a)" + , "template" : +"// unconcat begin~DEVNULL[~ARG[0]] +genvar ~GENSYM[n][1]; +~GENERATE + for (~SYM[1] = 0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[unconcat][2] + assign ~RESULT[~SYM[1]] = ~TOBV[~VAR[vec][2][\\(~SYM[1] * ~LIT[1]) : ((~SYM[1] * ~LIT[1]) + ~LIT[1] - 1)\\]][~TYPEL[~TYPO]]; + end +~ENDGENERATE +// unconcat end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.map" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" + , "template" : +"// map begin +genvar ~GENSYM[n][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[map][2]~IF~SIZE[~TYP[1]]~THEN + ~TYPEL[~TYP[1]] ~GENSYM[map_in][3]; + assign ~SYM[3] = ~FROMBV[~VAR[vec][1][\\~SYM[1]\\]][~TYPEL[~TYP[1]]];~ELSE ~FI + ~TYPEL[~TYPO] ~GENSYM[map_out][4]; + ~INST 0 + ~OUTPUT <= ~SYM[4]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ + ~INST + assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[4]][~TYPEL[~TYPO]]; +end +~ENDGENERATE +// map end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" + , "template" : +"// imap begin +genvar ~GENSYM[n][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + ~INDEXTYPE[~LIT[0]] ~GENSYM[i][3]; + assign ~SYM[3] = ~SYM[1];~IF~SIZE[~TYP[2]]~THEN + ~TYPEL[~TYP[2]] ~GENSYM[imap_in][4]; + assign ~SYM[4] = ~FROMBV[~VAR[vec][2][\\~SYM[1]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI + ~TYPEL[~TYPO] ~GENSYM[imap_out][5]; + ~INST 1 + ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~INDEXTYPE[~LIT[0]]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[5]][~TYPEL[~TYPO]]; +end +~ENDGENERATE +// imap end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap_go" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap_go :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" + , "template" : +"// imap begin +genvar ~GENSYM[n][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < $size(~RESULT); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + ~TYP[0] ~GENSYM[i][3]; + assign ~SYM[3] = ~SYM[1] + ~ARG[0];~IF~SIZE[~TYP[2]]~THEN + ~TYPEL[~TYP[2]] ~GENSYM[imap_in][4]; + assign ~SYM[4] = ~FROMBV[~VAR[vec][2][\\~SYM[1]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI + ~TYPEL[~TYPO] ~GENSYM[imap_out][5]; + ~INST 1 + ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~TYP[0]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[1]] = ~TOBV[~SYM[5]][~TYPEL[~TYPO]]; +end +~ENDGENERATE +// imap end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.zipWith" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" + , "template" : +"// zipWith begin +genvar ~GENSYM[n][2]; +~GENERATE +for (~SYM[2] = 0; ~SYM[2] < $size(~RESULT); ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[zipWith][3]~IF~SIZE[~TYP[1]]~THEN + ~TYPEL[~TYP[1]] ~GENSYM[zipWith_in1][4]; + assign ~SYM[4] = ~FROMBV[~VAR[vec1][1][\\~SYM[2]\\]][~TYPEL[~TYP[1]]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN + ~TYPEL[~TYP[2]] ~GENSYM[zipWith_in2][5]; + assign ~SYM[5] = ~FROMBV[~VAR[vec2][2][\\~SYM[2]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI + ~TYPEL[~TYPO] ~GENSYM[zipWith_out][6]; + ~INST 0 + ~OUTPUT <= ~SYM[6]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[1]]~ + ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[2]] = ~TOBV[~SYM[6]][~TYPEL[~TYPO]]; +end +~ENDGENERATE +// zipWith end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.foldr" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" + , "template" : +"// foldr start~IF ~LENGTH[~TYP[2]] ~THEN +~SIGDO[~GENSYM[intermediate][0]] [0:~LENGTH[~TYP[2]]]; +assign ~SYM[0][~LENGTH[~TYP[2]]] = ~ARG[1]; + +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0; ~SYM[3] < ~LENGTH[~TYP[2]]; ~SYM[3]=~SYM[3]+1) begin : ~GENSYM[foldr_loop][4]~IF~SIZE[~TYP[2]]~THEN + ~TYPEL[~TYP[2]] ~GENSYM[foldr_in][5]; + assign ~SYM[5] = ~FROMBV[~VAR[xs][2][\\~SYM[3]\\]][~TYPEL[~TYP[2]]];~ELSE ~FI + ~INST 0 + ~OUTPUT <= ~SYM[0][~SYM[3]]~ ~TYP[1]~ + ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ + ~INPUT <= ~SYM[0][~SYM[3]+1]~ ~TYP[1]~ + ~INST +end +~ENDGENERATE + +assign ~RESULT = ~SYM[0][0]; +~ELSE +assign ~RESULT = ~ARG[1]; +~FI// foldr end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.index_int" + , "kind" : "Expression" + , "type" : "index_int :: KnownNat n => Vec n a -> Int -> a" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~FROMBV[~VAR[vec][1][\\~ARG[2]\\]][~TYPO]~ELSE~ERRORO~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replace_int" + , "kind" : "Declaration" + , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" + , "template" : +"// replaceVec start +always_comb begin + ~RESULT = ~ARG[1]; + ~RESULT[~ARG[2]] = ~TOBV[~ARG[3]][~TYP[3]]; +end +// replaceVec end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat n -> a -> Vec n a" + , "template" : "'{~LIT[0] {~TOBV[~ARG[1]][~TYP[1]]}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.transpose" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" + , "template" : +"// transpose begin +genvar ~GENSYM[row_index][1]; +genvar ~GENSYM[col_index][2]; +~GENERATE + for (~SYM[1] = 0; ~SYM[1] < $size(~VAR[matrix][1]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[transpose_outer][3] + for (~SYM[2] = 0; ~SYM[2] < $size(~RESULT); ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[transpose_inner][4]~IF ~VIVADO ~THEN + assign ~RESULT[~SYM[2]][($size(~VAR[matrix][1])-~SYM[1])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 : ($size(~VAR[matrix][1])-~SYM[1]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]] = ~VAR[matrix][1][~SYM[1]][($size(~RESULT)-~SYM[2])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 : ($size(~RESULT)-~SYM[2]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]];~ELSE + assign ~RESULT[~SYM[2]][~SYM[1]] = ~VAR[matrix][1][~SYM[1]][~SYM[2]];~FI + end + end +~ENDGENERATE +// transpose end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.reverse" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "reverse :: Vec n a -> Vec n a" + , "template" : +"// reverse begin +genvar ~GENSYM[n][1]; +~GENERATE + for (~SYM[1] = 0; ~SYM[1] < $size(~VAR[vec][0]); ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[reverse][2] + assign ~RESULT[$high(~VAR[vec][0]) - ~SYM[1]] = ~VAR[vec][0][~SYM[1]]; + end +~ENDGENERATE +// reverse end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concatBitVector#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"concatBitVector# :: (KnownNat n,KnownNat m) -- (ARG[0],ARG[1]) + => Vec n (BitVector m) -- ARG[2] + -> BitVector (n * m)" + , "template" : "~TOBV[~ARG[2]][~TYP[2]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcatBitVector#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => BitVector (n * m) -- ARG[2] + -> Vec n (BitVector m)" + , "template" : "~FROMBV[~ARG[2]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateLeftS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"// rotateLeftS begin +localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; + +~GENERATE +if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] + assign ~RESULT = ~VAR[vec][1]; +end else begin : ~GENSYM[do_shift][4] + assign ~RESULT[0:~LIT[0]-~SYM[2]-1] = ~VAR[vec][1][~SYM[2]:~LIT[0]-1]; + assign ~RESULT[~LIT[0]-~SYM[2]:~LIT[0]-1] = ~VAR[vec][1][0:~SYM[2]-1]; +end +~ENDGENERATE +// rotateLeftS end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateRightS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"// rotateRightS begin +localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; + +~GENERATE +if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] + assign ~RESULT = ~VAR[vec][1]; +end else begin : ~GENSYM[do_shift][4] + assign ~RESULT[0:~SYM[2]-1] = ~VAR[vec][1][~LIT[0]-~SYM[2]:~LIT[0]-1]; + assign ~RESULT[~SYM[2]:~LIT[0]-1] = ~VAR[vec][1][0:~LIT[0]-~SYM[2]-1]; +end +~ENDGENERATE +// rotateRightS end" + } + } +] diff --git a/prims/systemverilog/Clash_Xilinx_DDR.json b/prims/systemverilog/Clash_Xilinx_DDR.json deleted file mode 100644 --- a/prims/systemverilog/Clash_Xilinx_DDR.json +++ /dev/null @@ -1,92 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.iddr" - , "kind" : "Declaration" - , "type" : -"iddr - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - -> Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> Signal fast (BitVector m) -- ARG[7] - -> Signal slow (BitVector m,BitVector m)" - , "template" : -"// iddr begin -~SIGD[~GENSYM[dataout_l][1]][7]; -~SIGD[~GENSYM[dataout_h][2]][7]; -~SIGD[~GENSYM[d][3]][7]; -assign ~SYM[3] = ~ARG[7]; - -genvar ~GENSYM[i][8]; -~GENERATE -for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] - IDDR #( - .DDR_CLK_EDGE(\"SAME_EDGE\"), - .INIT_Q1(1'b0), - .INIT_Q2(1'b0), - .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - ) ~GENSYM[~COMPNAME_IDDR][9] ( - .Q1(~SYM[1][~SYM[8]]), - .Q2(~SYM[2][~SYM[8]]), - .C(~ARG[4]), - .CE(~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] ~ELSE 1'b1 ~FI), - .D(~SYM[3][~SYM[8]]), - .R(~ARG[5]), - .S(1'b0) - ); -end -~ENDGENERATE - -assign ~RESULT = {~SYM[2],~SYM[1]}; -// iddr end" - } - } -, { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.oddr#" - , "kind" : "Declaration" - , "type" : -"oddr# - :: ( KnownConfi~ fast domf -- ARG[0] - , KnownConfi~ slow doms -- ARG[1] - , KnownNat m ) -- ARG[2] - => Clock slow -- ARG[3] - -> Reset slow -- ARG[4] - -> Enable slow -- ARG[5] - -> Signal slow (BitVector m) -- ARG[6] - -> Signal slow (BitVector m) -- ARG[7] - -> Signal fast (BitVector m)" - , "template" : -"// oddr begin -~SIGD[~GENSYM[datain_l][1]][7]; -~SIGD[~GENSYM[datain_h][2]][7]; -~SIGD[~GENSYM[q][3]][7]; - -assign ~SYM[1] = ~ARG[6]; -assign ~SYM[2] = ~ARG[7]; - -genvar ~GENSYM[i][8]; -~GENERATE -for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] - ODDR #( - .DDR_CLK_EDGE(\"SAME_EDGE\"), - .INIT(1'b0), - .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - ) ~GENSYM[~COMPNAME_ODDR][9] ( - .Q(~SYM[3][~SYM[8]]), - .C(~ARG[3]), - .CE(~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] ~ELSE 1'b1 ~FI), - .D1(~SYM[1][~SYM[8]]), - .D2(~SYM[2][~SYM[8]]), - .R(~ARG[4]), - .S(1'b0) - ); -end -~ENDGENERATE - -assign ~RESULT = ~SYM[3]; -// oddr end" - } - } -] diff --git a/prims/systemverilog/Clash_Xilinx_DDR.primitives b/prims/systemverilog/Clash_Xilinx_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/Clash_Xilinx_DDR.primitives @@ -0,0 +1,92 @@ +[ { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.iddr" + , "kind" : "Declaration" + , "type" : +"iddr + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + -> Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> Signal fast (BitVector m) -- ARG[7] + -> Signal slow (BitVector m,BitVector m)" + , "template" : +"// iddr begin +~SIGD[~GENSYM[dataout_l][1]][7]; +~SIGD[~GENSYM[dataout_h][2]][7]; +~SIGD[~GENSYM[d][3]][7]; +assign ~SYM[3] = ~ARG[7]; + +genvar ~GENSYM[i][8]; +~GENERATE +for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] + IDDR #( + .DDR_CLK_EDGE(\"SAME_EDGE\"), + .INIT_Q1(1'b0), + .INIT_Q2(1'b0), + .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + ) ~GENSYM[~COMPNAME_IDDR][9] ( + .Q1(~SYM[1][~SYM[8]]), + .Q2(~SYM[2][~SYM[8]]), + .C(~ARG[4]), + .CE(~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] ~ELSE 1'b1 ~FI), + .D(~SYM[3][~SYM[8]]), + .R(~ARG[5]), + .S(1'b0) + ); +end +~ENDGENERATE + +assign ~RESULT = {~SYM[2],~SYM[1]}; +// iddr end" + } + } +, { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.oddr#" + , "kind" : "Declaration" + , "type" : +"oddr# + :: ( KnownConfi~ fast domf -- ARG[0] + , KnownConfi~ slow doms -- ARG[1] + , KnownNat m ) -- ARG[2] + => Clock slow -- ARG[3] + -> Reset slow -- ARG[4] + -> Enable slow -- ARG[5] + -> Signal slow (BitVector m) -- ARG[6] + -> Signal slow (BitVector m) -- ARG[7] + -> Signal fast (BitVector m)" + , "template" : +"// oddr begin +~SIGD[~GENSYM[datain_l][1]][7]; +~SIGD[~GENSYM[datain_h][2]][7]; +~SIGD[~GENSYM[q][3]][7]; + +assign ~SYM[1] = ~ARG[6]; +assign ~SYM[2] = ~ARG[7]; + +genvar ~GENSYM[i][8]; +~GENERATE +for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] + ODDR #( + .DDR_CLK_EDGE(\"SAME_EDGE\"), + .INIT(1'b0), + .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + ) ~GENSYM[~COMPNAME_ODDR][9] ( + .Q(~SYM[3][~SYM[8]]), + .C(~ARG[3]), + .CE(~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] ~ELSE 1'b1 ~FI), + .D1(~SYM[1][~SYM[8]]), + .D2(~SYM[2][~SYM[8]]), + .R(~ARG[4]), + .S(1'b0) + ); +end +~ENDGENERATE + +assign ~RESULT = ~SYM[3]; +// oddr end" + } + } +] diff --git a/prims/systemverilog/GHC_Base.json b/prims/systemverilog/GHC_Base.json deleted file mode 100644 --- a/prims/systemverilog/GHC_Base.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Base.divInt" - , "kind" : "Declaration" - , "type" : "divInt :: Int -> Int -> Int" - , "template" : -"// divInt begin -// divide (rounds towards zero) -~SIGD[~GENSYM[quot_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] / ~VAR[divider][1]; - -// round toward minus infinity -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? ~SYM[0] : ~SYM[0] - ~SIZE[~TYPO]'sd1; -// divInt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.modInt" - , "kind" : "Declaration" - , "type" : "modInt :: Int -> Int -> Int" - , "template" : -"// modInt begin -// remainder -~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~VAR[dividend][0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInt end" - } - } -] diff --git a/prims/systemverilog/GHC_Base.primitives b/prims/systemverilog/GHC_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/GHC_Base.primitives @@ -0,0 +1,33 @@ +[ { "BlackBox" : + { "name" : "GHC.Base.divInt" + , "kind" : "Declaration" + , "type" : "divInt :: Int -> Int -> Int" + , "template" : +"// divInt begin +// divide (rounds towards zero) +~SIGD[~GENSYM[quot_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] / ~VAR[divider][1]; + +// round toward minus infinity +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? ~SYM[0] : ~SYM[0] - ~SIZE[~TYPO]'sd1; +// divInt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.modInt" + , "kind" : "Declaration" + , "type" : "modInt :: Int -> Int -> Int" + , "template" : +"// modInt begin +// remainder +~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~VAR[dividend][0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInt end" + } + } +] diff --git a/prims/systemverilog/GHC_Classes.json b/prims/systemverilog/GHC_Classes.json deleted file mode 100644 --- a/prims/systemverilog/GHC_Classes.json +++ /dev/null @@ -1,45 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.divInt#" - , "kind" : "Declaration" - , "type" : "divInt# :: Int# -> Int# -> Int#" - , "template" : -"// divInt# begin -logic ~GENSYM[resultPos][1]; -logic ~GENSYM[dividerNeg][2]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divInt# end" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.modInt#" - , "kind" : "Declaration" - , "type" : "modInt# :: Int# -> Int# -> Int#" - , "template" : -"// modInt# begin -// remainder -~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInt# end" - } - } -] diff --git a/prims/systemverilog/GHC_Classes.primitives b/prims/systemverilog/GHC_Classes.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/GHC_Classes.primitives @@ -0,0 +1,45 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.divInt#" + , "kind" : "Declaration" + , "type" : "divInt# :: Int# -> Int# -> Int#" + , "template" : +"// divInt# begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divInt# end" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.modInt#" + , "kind" : "Declaration" + , "type" : "modInt# :: Int# -> Int# -> Int#" + , "template" : +"// modInt# begin +// remainder +~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInt# end" + } + } +] diff --git a/prims/systemverilog/GHC_Integer_Type.json b/prims/systemverilog/GHC_Integer_Type.json deleted file mode 100644 --- a/prims/systemverilog/GHC_Integer_Type.json +++ /dev/null @@ -1,97 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.divInteger" - , "kind" : "Declaration" - , "type" : "divInteger :: Integer -> Integer -> Integer" - , "template" : -"// divInteger begin -logic ~GENSYM[resultPos][1]; -logic ~GENSYM[dividerNeg][2]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.modInteger" - , "kind" : "Declaration" - , "type" : "modInteger :: Integer -> Integer -> Integer" - , "template" : -"// modInteger begin -// remainder -~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.divModInteger" - , "kind" : "Declaration" - , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : -"// divModInteger begin -logic ~GENSYM[resultPos][1]; -logic ~GENSYM[dividerNeg][2]; -logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; -logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; -logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; -logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; -logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); - -logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[rem_res][8]; -logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[mod_res][9]; -assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; -assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? - ~SYM[8] : - ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); - -assign ~RESULT = {~SYM[7],~SYM[9]}; -// divModInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.quotRemInteger" - , "kind" : "Declaration" - , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : -"// quotRemInteger begin -~SIGD[~GENSYM[quot_res][0]][0]; -~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemInteger end" - } - } -] diff --git a/prims/systemverilog/GHC_Integer_Type.primitives b/prims/systemverilog/GHC_Integer_Type.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/GHC_Integer_Type.primitives @@ -0,0 +1,97 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.divInteger" + , "kind" : "Declaration" + , "type" : "divInteger :: Integer -> Integer -> Integer" + , "template" : +"// divInteger begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.modInteger" + , "kind" : "Declaration" + , "type" : "modInteger :: Integer -> Integer -> Integer" + , "template" : +"// modInteger begin +// remainder +~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divModInteger" + , "kind" : "Declaration" + , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// divModInteger begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); + +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[rem_res][8]; +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[mod_res][9]; +assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; +assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? + ~SYM[8] : + ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); + +assign ~RESULT = {~SYM[7],~SYM[9]}; +// divModInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotRemInteger" + , "kind" : "Declaration" + , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// quotRemInteger begin +~SIGD[~GENSYM[quot_res][0]][0]; +~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemInteger end" + } + } +] diff --git a/prims/systemverilog/GHC_Num_Integer.primitives b/prims/systemverilog/GHC_Num_Integer.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/GHC_Num_Integer.primitives @@ -0,0 +1,97 @@ +[ { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDiv" + , "kind" : "Declaration" + , "type" : "integerDiv :: Integer -> Integer -> Integer" + , "template" : +"// integerDiv begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// integerDiv end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerMod" + , "kind" : "Declaration" + , "type" : "integerMod :: Integer -> Integer -> Integer" + , "template" : +"// integerMod begin +// remainder +~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// integerMod end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDivMod#" + , "kind" : "Declaration" + , "type" : "integerDivMod :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// integerDivMod begin +logic ~GENSYM[resultPos][1]; +logic ~GENSYM[dividerNeg][2]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; +logic signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); + +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[rem_res][8]; +logic signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[mod_res][9]; +assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; +assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? + ~SYM[8] : + ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); + +assign ~RESULT = {~SYM[7],~SYM[9]}; +// integerDivMod end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerQuotRem#" + , "kind" : "Declaration" + , "type" : "integerQuotRem :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// integerQuotRem begin +~SIGD[~GENSYM[quot_res][0]][0]; +~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// integerQuotRem end" + } + } +] diff --git a/prims/systemverilog/GHC_Prim.json b/prims/systemverilog/GHC_Prim.json deleted file mode 100644 --- a/prims/systemverilog/GHC_Prim.json +++ /dev/null @@ -1,1459 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Prim.quotRemInt#" - , "kind" : "Declaration" - , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" - , "template" : -"// quotRemInt begin -~SIGD[~GENSYM[quot_res][0]][0]; -~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemInt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotRemWord#" - , "kind" : "Declaration" - , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" - , "template" : -"// quotRemWord begin -~SIGD[~GENSYM[quot_res][0]][0]; -~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemWord end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt8#" - , "kind" : "Declaration" - , "type" : "popCnt8# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "depth2Index" - , "extension" : "inc" - , "template" : -"// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]; - input integer levels; - input integer depth; - - ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt8 begin -localparam ~GENSYM[width][0] = 8; - -// depth of the tree -localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); - -logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt16#" - , "kind" : "Declaration" - , "type" : "popCnt16# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "depth2Index" - , "extension" : "inc" - , "template" : -"// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]; - input integer levels; - input integer depth; - - ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt16 begin -localparam ~GENSYM[width][0] = 16; - -// depth of the tree -localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); - -logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt32#" - , "kind" : "Declaration" - , "type" : "popCnt32# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "depth2Index" - , "extension" : "inc" - , "template" : -"// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]; - input integer levels; - input integer depth; - - ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt32 begin -localparam ~GENSYM[width][0] = 32; - -// depth of the tree -localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); - -logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt64#" - , "kind" : "Declaration" - , "type" : "popCnt64# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "depth2Index" - , "extension" : "inc" - , "template" : -"// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]; - input integer levels; - input integer depth; - - ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt64 begin -localparam ~GENSYM[width][0] = 64; - -// depth of the tree -localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); - -logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt#" - , "kind" : "Declaration" - , "type" : "popCnt# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "depth2Index" - , "extension" : "inc" - , "template" : -"// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]; - input integer levels; - input integer depth; - - ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt begin -localparam ~GENSYM[width][0] = ~SIZE[~TYPO]; - -// depth of the tree -localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); - -logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz8#" - , "kind" : "Declaration" - , "type" : "clz8 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz8 begin -logic [0:7] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][7:0]; - -logic [0:7] ~GENSYM[e][2]; -genvar ~GENSYM[n][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:5] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage1][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:3] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 3; -logic [5:0] i; -assign i = ~SYM[4][0:5]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz16#" - , "kind" : "Declaration" - , "type" : "clz16 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz16 begin -logic [0:15] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][15:0]; - -logic [0:15] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:11] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:7] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:4] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 4; -logic [7:0] i; -assign i = ~SYM[9][0:7]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz32#" - , "kind" : "Declaration" - , "type" : "clz32 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz32 begin -logic [0:31] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][31:0]; - -logic [0:31] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:23] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:15] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:9] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:5] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 5; -logic [9:0] i; -assign i = ~SYM[12][0:9]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz64#" - , "kind" : "Declaration" - , "type" : "clz64 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz64 begin -logic [0:63] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][63:0]; - -logic [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - logic [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -logic [11:0] i; -assign i = ~SYM[15][0:11]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz#" - , "kind" : "Declaration" - , "type" : "clz :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz begin -~IF ~IW64 ~THEN -logic [0:63] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][63:0]; - -logic [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - logic [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -logic [11:0] i; -assign i = ~SYM[15][0:11]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~ELSE -logic [0:31] ~SYM[1]; -assign ~SYM[1] = ~VAR[i][0][31:0]; - -logic [0:31] ~SYM[2]; -genvar ~SYM[3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:23] ~SYM[4]; -genvar ~SYM[5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:15] ~SYM[9]; -genvar ~SYM[10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:9] ~SYM[12]; -genvar ~SYM[13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:5] ~SYM[7]; -~GENERATE -if (1) begin -localparam n = 5; -logic [9:0] i; -assign i = ~SYM[12][0:9]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~FI -assign ~RESULT = $unsigned(~SYM[7]); -// clz end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz8#" - , "kind" : "Declaration" - , "type" : "ctz8 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz8 begin -logic [0:7] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:7] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:5] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:3] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 3; -logic [5:0] i; -assign i = ~SYM[4][0:5]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz16#" - , "kind" : "Declaration" - , "type" : "ctz16 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz16 begin -logic [0:15] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:15] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:11] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:7] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:4] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 4; -logic [7:0] i; -assign i = ~SYM[9][0:7]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz32#" - , "kind" : "Declaration" - , "type" : "ctz32 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz32 begin -logic [0:31] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:31] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:23] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:15] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:9] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:5] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 5; -logic [9:0] i; -assign i = ~SYM[12][0:9]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz64#" - , "kind" : "Declaration" - , "type" : "ctz64 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz64 begin -logic [0:63] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:47] a; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - logic [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -logic [11:0] i; -assign i = ~SYM[15][0:11]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz#" - , "kind" : "Declaration" - , "type" : "ctz :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz begin -~IF ~IW64 ~THEN -logic [0:63] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - logic [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -logic [11:0] i; -assign i = ~SYM[15][0:11]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~ELSE -logic [0:31] ~SYM[1]; -genvar ~SYM[18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -logic [0:31] ~SYM[2]; -genvar ~SYM[3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -logic [0:23] ~SYM[4]; -genvar ~SYM[5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] - localparam n = 2; - logic [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:15] ~SYM[9]; -genvar ~SYM[10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] - localparam n = 3; - logic [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:9] ~SYM[12]; -genvar ~SYM[13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] - localparam n = 4; - logic [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -logic [0:5] ~SYM[7]; -~GENERATE -if (1) begin -localparam n = 5; -logic [9:0] i; -assign i = ~SYM[12][0:9]; -always_comb begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~FI -assign ~RESULT = $unsigned(~SYM[7]); -// ctz end" - } - } -] diff --git a/prims/systemverilog/GHC_Prim.primitives b/prims/systemverilog/GHC_Prim.primitives new file mode 100644 --- /dev/null +++ b/prims/systemverilog/GHC_Prim.primitives @@ -0,0 +1,1459 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.quotRemInt#" + , "kind" : "Declaration" + , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" + , "template" : +"// quotRemInt begin +~SIGD[~GENSYM[quot_res][0]][0]; +~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemInt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotRemWord#" + , "kind" : "Declaration" + , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" + , "template" : +"// quotRemWord begin +~SIGD[~GENSYM[quot_res][0]][0]; +~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemWord end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt8#" + , "kind" : "Declaration" + , "type" : "popCnt8# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "depth2Index" + , "extension" : "inc" + , "template" : +"// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]; + input integer levels; + input integer depth; + + ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt8 begin +localparam ~GENSYM[width][0] = 8; + +// depth of the tree +localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); + +logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt16#" + , "kind" : "Declaration" + , "type" : "popCnt16# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "depth2Index" + , "extension" : "inc" + , "template" : +"// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]; + input integer levels; + input integer depth; + + ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt16 begin +localparam ~GENSYM[width][0] = 16; + +// depth of the tree +localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); + +logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt32#" + , "kind" : "Declaration" + , "type" : "popCnt32# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "depth2Index" + , "extension" : "inc" + , "template" : +"// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]; + input integer levels; + input integer depth; + + ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt32 begin +localparam ~GENSYM[width][0] = 32; + +// depth of the tree +localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); + +logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt64#" + , "kind" : "Declaration" + , "type" : "popCnt64# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "depth2Index" + , "extension" : "inc" + , "template" : +"// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]; + input integer levels; + input integer depth; + + ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt64 begin +localparam ~GENSYM[width][0] = 64; + +// depth of the tree +localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); + +logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt#" + , "kind" : "Declaration" + , "type" : "popCnt# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "depth2Index" + , "extension" : "inc" + , "template" : +"// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]; + input integer levels; + input integer depth; + + ~INCLUDENAME[0] = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt begin +localparam ~GENSYM[width][0] = ~SIZE[~TYPO]; + +// depth of the tree +localparam ~GENSYM[levels][2] = $clog2(~SYM[0]); + +logic [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0](~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz8#" + , "kind" : "Declaration" + , "type" : "clz8 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz8 begin +logic [0:7] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][7:0]; + +logic [0:7] ~GENSYM[e][2]; +genvar ~GENSYM[n][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:5] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage1][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:3] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 3; +logic [5:0] i; +assign i = ~SYM[4][0:5]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz16#" + , "kind" : "Declaration" + , "type" : "clz16 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz16 begin +logic [0:15] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][15:0]; + +logic [0:15] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:11] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:7] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:4] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 4; +logic [7:0] i; +assign i = ~SYM[9][0:7]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz32#" + , "kind" : "Declaration" + , "type" : "clz32 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz32 begin +logic [0:31] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][31:0]; + +logic [0:31] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:23] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:15] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:9] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:5] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 5; +logic [9:0] i; +assign i = ~SYM[12][0:9]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz64#" + , "kind" : "Declaration" + , "type" : "clz64 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz64 begin +logic [0:63] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][63:0]; + +logic [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + logic [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +logic [11:0] i; +assign i = ~SYM[15][0:11]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz#" + , "kind" : "Declaration" + , "type" : "clz :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz begin +~IF ~IW64 ~THEN +logic [0:63] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][63:0]; + +logic [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + logic [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +logic [11:0] i; +assign i = ~SYM[15][0:11]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~ELSE +logic [0:31] ~SYM[1]; +assign ~SYM[1] = ~VAR[i][0][31:0]; + +logic [0:31] ~SYM[2]; +genvar ~SYM[3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:23] ~SYM[4]; +genvar ~SYM[5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:15] ~SYM[9]; +genvar ~SYM[10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:9] ~SYM[12]; +genvar ~SYM[13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:5] ~SYM[7]; +~GENERATE +if (1) begin +localparam n = 5; +logic [9:0] i; +assign i = ~SYM[12][0:9]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~FI +assign ~RESULT = $unsigned(~SYM[7]); +// clz end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz8#" + , "kind" : "Declaration" + , "type" : "ctz8 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz8 begin +logic [0:7] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:7] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:5] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:3] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 3; +logic [5:0] i; +assign i = ~SYM[4][0:5]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz16#" + , "kind" : "Declaration" + , "type" : "ctz16 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz16 begin +logic [0:15] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:15] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:11] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:7] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:4] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 4; +logic [7:0] i; +assign i = ~SYM[9][0:7]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz32#" + , "kind" : "Declaration" + , "type" : "ctz32 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz32 begin +logic [0:31] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:31] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:23] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:15] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:9] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:5] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 5; +logic [9:0] i; +assign i = ~SYM[12][0:9]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz64#" + , "kind" : "Declaration" + , "type" : "ctz64 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz64 begin +logic [0:63] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:47] a; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + logic [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +logic [11:0] i; +assign i = ~SYM[15][0:11]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz#" + , "kind" : "Declaration" + , "type" : "ctz :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz begin +~IF ~IW64 ~THEN +logic [0:63] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + logic [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +logic [11:0] i; +assign i = ~SYM[15][0:11]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~ELSE +logic [0:31] ~SYM[1]; +genvar ~SYM[18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +logic [0:31] ~SYM[2]; +genvar ~SYM[3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +logic [0:23] ~SYM[4]; +genvar ~SYM[5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] + localparam n = 2; + logic [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:15] ~SYM[9]; +genvar ~SYM[10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] + localparam n = 3; + logic [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:9] ~SYM[12]; +genvar ~SYM[13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] + localparam n = 4; + logic [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +logic [0:5] ~SYM[7]; +~GENERATE +if (1) begin +localparam n = 5; +logic [9:0] i; +assign i = ~SYM[12][0:9]; +always_comb begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~FI +assign ~RESULT = $unsigned(~SYM[7]); +// ctz end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_BlockRam.json b/prims/verilog/Clash_Explicit_BlockRam.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_BlockRam.json +++ /dev/null @@ -1,151 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam#" - , "kind" : "Declaration" - , "type" : -"blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "outputReg" : true - , "template" : -"// blockRam begin -reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[5]]-1]; - -reg ~TYP[5] ~GENSYM[ram_init][3]; -integer ~GENSYM[i][4]; -initial begin - ~SYM[3] = ~CONST[5]; - for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin - ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; - end -end -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[1][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - if (~ARG[4]) begin - ~RESULT <= ~SYM[1][~ARG[6]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[1][~ARG[6]]; -end~FI -// blockRam end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRamU#" - , "kind" : "Declaration" - , "type" : -"blockRamU# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "outputReg" : true - , "template" : -"// blockRamU begin -reg ~TYPO ~GENSYM[~RESULT_RAM][0] [0:~LIT[5]-1]; - -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[0][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[0][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[0][~ARG[8]] <= ~ARG[9]; - end - if (~ARG[4]) begin - ~RESULT <= ~SYM[0][~ARG[6]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - if (~ARG[7]) begin - ~SYM[0][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[0][~ARG[6]]; -end~FI -// blockRamU end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam1#" - , "kind" : "Declaration" - , "type" : -"blockRam1# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> a -- init, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom a -- din, ARG[10] - -> Signal dom a" - , "outputReg" : true - , "template" : -"// blockRam1 begin -reg ~TYPO ~GENSYM[~RESULT_RAM][0] [0:~LIT[5]-1]; -integer ~GENSYM[i][1]; -initial begin - for (~SYM[1]=0;~SYM[1]<~LIT[5];~SYM[1]=~SYM[1]+1) begin - ~SYM[0][~SYM[1]] = ~CONST[6]; - end -end - -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[8]) begin - ~SYM[0][~ARG[9]] <= ~ARG[10]; - end - ~RESULT <= ~SYM[0][~ARG[7]]; - end~ELSE - if (~ARG[8] & ~ARG[4]) begin - ~SYM[0][~ARG[9]] <= ~ARG[10]; - end - if (~ARG[4]) begin - ~RESULT <= ~SYM[0][~ARG[7]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - if (~ARG[8]) begin - ~SYM[0][~ARG[9]] <= ~ARG[10]; - end - ~RESULT <= ~SYM[0][~ARG[7]]; -end~FI -// blockRam1 end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_BlockRam.primitives b/prims/verilog/Clash_Explicit_BlockRam.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_BlockRam.primitives @@ -0,0 +1,151 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam#" + , "kind" : "Declaration" + , "type" : +"blockRam# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + => Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "outputReg" : true + , "template" : +"// blockRam begin +reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[5]]-1]; + +reg ~TYP[5] ~GENSYM[ram_init][3]; +integer ~GENSYM[i][4]; +initial begin + ~SYM[3] = ~CONST[5]; + for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + end +end +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~ARG[9]; + end + ~RESULT <= ~SYM[1][~ARG[6]]; + end~ELSE + if (~ARG[7] & ~ARG[4]) begin + ~SYM[1][~ARG[8]] <= ~ARG[9]; + end + if (~ARG[4]) begin + ~RESULT <= ~SYM[1][~ARG[6]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + if (~ARG[7]) begin + ~SYM[1][~ARG[8]] <= ~ARG[9]; + end + ~RESULT <= ~SYM[1][~ARG[6]]; +end~FI +// blockRam end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRamU#" + , "kind" : "Declaration" + , "type" : +"blockRamU# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "outputReg" : true + , "template" : +"// blockRamU begin +reg ~TYPO ~GENSYM[~RESULT_RAM][0] [0:~LIT[5]-1]; + +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[7]) begin + ~SYM[0][~ARG[8]] <= ~ARG[9]; + end + ~RESULT <= ~SYM[0][~ARG[6]]; + end~ELSE + if (~ARG[7] & ~ARG[4]) begin + ~SYM[0][~ARG[8]] <= ~ARG[9]; + end + if (~ARG[4]) begin + ~RESULT <= ~SYM[0][~ARG[6]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + if (~ARG[7]) begin + ~SYM[0][~ARG[8]] <= ~ARG[9]; + end + ~RESULT <= ~SYM[0][~ARG[6]]; +end~FI +// blockRamU end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam1#" + , "kind" : "Declaration" + , "type" : +"blockRam1# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> a -- init, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom a -- din, ARG[10] + -> Signal dom a" + , "outputReg" : true + , "template" : +"// blockRam1 begin +reg ~TYPO ~GENSYM[~RESULT_RAM][0] [0:~LIT[5]-1]; +integer ~GENSYM[i][1]; +initial begin + for (~SYM[1]=0;~SYM[1]<~LIT[5];~SYM[1]=~SYM[1]+1) begin + ~SYM[0][~SYM[1]] = ~CONST[6]; + end +end + +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[8]) begin + ~SYM[0][~ARG[9]] <= ~ARG[10]; + end + ~RESULT <= ~SYM[0][~ARG[7]]; + end~ELSE + if (~ARG[8] & ~ARG[4]) begin + ~SYM[0][~ARG[9]] <= ~ARG[10]; + end + if (~ARG[4]) begin + ~RESULT <= ~SYM[0][~ARG[7]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + if (~ARG[8]) begin + ~SYM[0][~ARG[9]] <= ~ARG[10]; + end + ~RESULT <= ~SYM[0][~ARG[7]]; +end~FI +// blockRam1 end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_BlockRam_File.json b/prims/verilog/Clash_Explicit_BlockRam_File.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_BlockRam_File.json +++ /dev/null @@ -1,50 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" - , "kind" : "Declaration" - , "type" : -"blockRamFile# - :: ( KnownDomain dom -- ARG[0] - , KnownNat m -- ARG[1] - , HasCallStack ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> SNat n -- sz, ARG[5] - -> FilePath -- file, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom (BitVector m) -- din, ARG[10] - -> Signal dom (BitVector m)" - , "outputReg" : true - , "template" : -"// blockRamFile begin -reg ~TYPO ~GENSYM[RAM][1] [0:~LIT[5]-1]; - -initial begin - $readmemb(~FILE[~LIT[6]],~SYM[1]); -end -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - ~RESULT <= ~SYM[1][~ARG[7]]; - end~ELSE - if (~ARG[8] & ~ARG[4]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - if (~ARG[4]) begin - ~RESULT <= ~SYM[1][~ARG[7]]; - end~FI -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[8]) begin - ~SYM[1][~ARG[9]] <= ~ARG[10]; - end - ~RESULT <= ~SYM[1][~ARG[7]]; -end~FI -// blockRamFile end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_BlockRam_File.primitives b/prims/verilog/Clash_Explicit_BlockRam_File.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_BlockRam_File.primitives @@ -0,0 +1,50 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" + , "kind" : "Declaration" + , "type" : +"blockRamFile# + :: ( KnownDomain dom -- ARG[0] + , KnownNat m -- ARG[1] + , HasCallStack ) -- ARG[2] + => Clock dom -- clk, ARG[3] + => Enable dom -- en, ARG[4] + -> SNat n -- sz, ARG[5] + -> FilePath -- file, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom (BitVector m) -- din, ARG[10] + -> Signal dom (BitVector m)" + , "outputReg" : true + , "template" : +"// blockRamFile begin +reg ~TYPO ~GENSYM[RAM][1] [0:~LIT[5]-1]; + +initial begin + $readmemb(~FILE[~LIT[6]],~SYM[1]); +end +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN + if (~ARG[4]) begin + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + ~RESULT <= ~SYM[1][~ARG[7]]; + end~ELSE + if (~ARG[8] & ~ARG[4]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + if (~ARG[4]) begin + ~RESULT <= ~SYM[1][~ARG[7]]; + end~FI +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + if (~ARG[8]) begin + ~SYM[1][~ARG[9]] <= ~ARG[10]; + end + ~RESULT <= ~SYM[1][~ARG[7]]; +end~FI +// blockRamFile end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_DDR.json b/prims/verilog/Clash_Explicit_DDR.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_DDR.json +++ /dev/null @@ -1,88 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrIn#" - , "kind" : "Declaration" - , "type" : -"ddrIn# :: forall a slow fast n pFast gated synchronous. - ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> a -- ARG[7] - -> a -- ARG[8] - -> a -- ARG[9] - -> Signal fast a -- ARG[10] - -> Signal slow (a,a)" - , "template" : -"// ddrIn begin -reg ~SIGD[~GENSYM[data_Pos][1]][9]; -reg ~SIGD[~GENSYM[data_Neg][2]][9]; -reg ~SIGD[~GENSYM[data_Neg_Latch][3]][9]; -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[1] <= ~ARG[8]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[1] <= ~ARG[10]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[2] <= ~ARG[9]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[2] <= ~ARG[10]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[3] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[3] <= ~SYM[2]; - end -end - -assign ~RESULT = {~SYM[3], ~SYM[1]}; -// ddrIn end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrOut#" - , "kind" : "Declaration" - , "type" : -"ddrOut# :: ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> a -- ARG[7] - -> Signal slow a -- ARG[8] - -> Signal slow a -- ARG[9] - -> Signal fast a" - , "template" : -"// ddrOut begin -reg ~SIGD[~GENSYM[data_Pos][1]][7]; -reg ~SIGD[~GENSYM[data_Neg][2]][7]; -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[1] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[1] <= ~ARG[8]; - end -end -always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] - if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin - ~SYM[2] <= ~ARG[7]; - end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin - ~SYM[2] <= ~ARG[9]; - end -end - -assign ~RESULT = ~ARG[4] ? ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1] : ~SYM[2]~ELSE~SYM[2] : ~SYM[1]~FI; - -// ddrOut end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_DDR.primitives b/prims/verilog/Clash_Explicit_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_DDR.primitives @@ -0,0 +1,88 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrIn#" + , "kind" : "Declaration" + , "type" : +"ddrIn# :: forall a slow fast n pFast gated synchronous. + ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> a -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> Signal fast a -- ARG[10] + -> Signal slow (a,a)" + , "template" : +"// ddrIn begin +reg ~SIGD[~GENSYM[data_Pos][1]][9]; +reg ~SIGD[~GENSYM[data_Neg][2]][9]; +reg ~SIGD[~GENSYM[data_Neg_Latch][3]][9]; +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[1] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[10]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[2] <= ~ARG[9]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[10]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[3] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[3] <= ~SYM[2]; + end +end + +assign ~RESULT = {~SYM[3], ~SYM[1]}; +// ddrIn end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrOut#" + , "kind" : "Declaration" + , "type" : +"ddrOut# :: ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> a -- ARG[7] + -> Signal slow a -- ARG[8] + -> Signal slow a -- ARG[9] + -> Signal fast a" + , "template" : +"// ddrOut begin +reg ~SIGD[~GENSYM[data_Pos][1]][7]; +reg ~SIGD[~GENSYM[data_Neg][2]][7]; +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[1] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[8]; + end +end +always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[4]~IF~ISSYNC[3]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[5])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[5]~ELSE! ~ARG[5]~FI) begin + ~SYM[2] <= ~ARG[7]; + end else ~IF ~ISACTIVEENABLE[6] ~THEN if (~ARG[6]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[9]; + end +end + +assign ~RESULT = ~ARG[4] ? ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1] : ~SYM[2]~ELSE~SYM[2] : ~SYM[1]~FI; + +// ddrOut end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_RAM.json b/prims/verilog/Clash_Explicit_RAM.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_RAM.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.RAM.asyncRam#" - , "kind" : "Declaration" - , "type" : -"asyncRam# - :: ( HasCallStack -- ARG[0] - , KnownDomain wdom wconf -- ARG[1] - , KnownDomain rdom rconf ) -- ARG[2] - => Clock wdom -- ^ wclk, ARG[3] - -> Clock rdom -- ^ rclk, ARG[4] - -> Enable wdom -- ^ wen, ARG[5] - -> SNat n -- ^ sz, ARG[6] - -> Signal rdom Int -- ^ rd, ARG[7] - -> Signal wdom Bool -- ^ en, ARG[8] - -> Signal wdom Int -- ^ wr, ARG[9] - -> Signal wdom a -- ^ din, ARG[10] - -> Signal rdom a" - , "template" : -"// asyncRam begin -reg ~TYPO ~GENSYM[RAM][0] [0:~LIT[6]-1]; -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_Ram][1] - if (~ARG[8] ~IF ~ISACTIVEENABLE[5] ~THEN & ~ARG[5] ~ELSE ~FI) begin - ~SYM[0][~ARG[9]] <= ~ARG[10]; - end -end - -assign ~RESULT = ~SYM[0][~ARG[7]]; -// asyncRam end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_RAM.primitives b/prims/verilog/Clash_Explicit_RAM.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_RAM.primitives @@ -0,0 +1,31 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.RAM.asyncRam#" + , "kind" : "Declaration" + , "type" : +"asyncRam# + :: ( HasCallStack -- ARG[0] + , KnownDomain wdom wconf -- ARG[1] + , KnownDomain rdom rconf ) -- ARG[2] + => Clock wdom -- ^ wclk, ARG[3] + -> Clock rdom -- ^ rclk, ARG[4] + -> Enable wdom -- ^ wen, ARG[5] + -> SNat n -- ^ sz, ARG[6] + -> Signal rdom Int -- ^ rd, ARG[7] + -> Signal wdom Bool -- ^ en, ARG[8] + -> Signal wdom Int -- ^ wr, ARG[9] + -> Signal wdom a -- ^ din, ARG[10] + -> Signal rdom a" + , "template" : +"// asyncRam begin +reg ~TYPO ~GENSYM[RAM][0] [0:~LIT[6]-1]; +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_Ram][1] + if (~ARG[8] ~IF ~ISACTIVEENABLE[5] ~THEN & ~ARG[5] ~ELSE ~FI) begin + ~SYM[0][~ARG[9]] <= ~ARG[10]; + end +end + +assign ~RESULT = ~SYM[0][~ARG[7]]; +// asyncRam end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_ROM.json b/prims/verilog/Clash_Explicit_ROM.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_ROM.json +++ /dev/null @@ -1,38 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.rom#" - , "kind" : "Declaration" - , "type" : -"rom# :: ( KnownDomain dom ARG[0] - , KnownNat n -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom a" - , "outputReg" : true - , "template" : -"// rom begin -reg ~TYPO ~GENSYM[ROM][1] [0:~LIT[1]-1]; - -reg ~TYP[5] ~GENSYM[rom_init][3]; -integer ~GENSYM[i][4]; -initial begin - ~SYM[3] = ~LIT[5]; - for (~SYM[4]=0; ~SYM[4] < ~LIT[1]; ~SYM[4] = ~SYM[4] + 1) begin - ~SYM[1][~LIT[1]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; - end -end -~IF ~ISACTIVEENABLE[4] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][5] - if (~ARG[4]) begin - ~RESULT <= ~SYM[1][~ARG[6]]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - ~RESULT <= ~SYM[1][~ARG[6]]; -end~FI -// rom end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_ROM.primitives b/prims/verilog/Clash_Explicit_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_ROM.primitives @@ -0,0 +1,38 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.rom#" + , "kind" : "Declaration" + , "type" : +"rom# :: ( KnownDomain dom ARG[0] + , KnownNat n -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom a" + , "outputReg" : true + , "template" : +"// rom begin +reg ~TYPO ~GENSYM[ROM][1] [0:~LIT[1]-1]; + +reg ~TYP[5] ~GENSYM[rom_init][3]; +integer ~GENSYM[i][4]; +initial begin + ~SYM[3] = ~LIT[5]; + for (~SYM[4]=0; ~SYM[4] < ~LIT[1]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LIT[1]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + end +end +~IF ~ISACTIVEENABLE[4] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][5] + if (~ARG[4]) begin + ~RESULT <= ~SYM[1][~ARG[6]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + ~RESULT <= ~SYM[1][~ARG[6]]; +end~FI +// rom end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_ROM_File.json b/prims/verilog/Clash_Explicit_ROM_File.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_ROM_File.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.File.romFile#" - , "kind" : "Declaration" - , "type" : -"romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom ) -- ARG[1] - => Clock dom -- clk, ARG[2] - -> Enable dom -- en, ARG[3] - -> SNat n -- sz, ARG[4] - -> FilePath -- file, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom (BitVector m)" - , "outputReg" : true - , "template" : -"// romFile begin -reg ~TYPO ~GENSYM[ROM][0] [0:~LIT[4]-1]; - -initial begin - $readmemb(~FILE[~LIT[5]],~SYM[0]); -end -~IF ~ISACTIVEENABLE[3] ~THEN -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] - if (~ARG[3]) begin - ~RESULT <= ~SYM[0][~ARG[6]]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] - ~RESULT <= ~SYM[0][~ARG[6]]; -end~FI -// romFile end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_ROM_File.primitives b/prims/verilog/Clash_Explicit_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_ROM_File.primitives @@ -0,0 +1,33 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.File.romFile#" + , "kind" : "Declaration" + , "type" : +"romFile# :: ( KnownNat m -- ARG[0] + , KnownDomain dom ) -- ARG[1] + => Clock dom -- clk, ARG[2] + -> Enable dom -- en, ARG[3] + -> SNat n -- sz, ARG[4] + -> FilePath -- file, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom (BitVector m)" + , "outputReg" : true + , "template" : +"// romFile begin +reg ~TYPO ~GENSYM[ROM][0] [0:~LIT[4]-1]; + +initial begin + $readmemb(~FILE[~LIT[5]],~SYM[0]); +end +~IF ~ISACTIVEENABLE[3] ~THEN +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] + if (~ARG[3]) begin + ~RESULT <= ~SYM[0][~ARG[6]]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] + ~RESULT <= ~SYM[0][~ARG[6]]; +end~FI +// romFile end" + } + } +] diff --git a/prims/verilog/Clash_Explicit_Testbench.json b/prims/verilog/Clash_Explicit_Testbench.json deleted file mode 100644 --- a/prims/verilog/Clash_Explicit_Testbench.json +++ /dev/null @@ -1,60 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assert" - , "kind" : "Declaration" - , "type" : -"assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) - => Clock dom -- ARG[3] - -> Reset dom -- ARG[4] - -> String -- ARG[5] - -> Signal dom a -- Checked value (ARG[6]) - -> Signal dom a -- Expected value (ARG[7]) - -> Signal dom b -- Return valued (ARG[8]) - -> Signal dom b" - , "template" : -"// assert begin -// pragma translate_off -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin - if (~ARG[6] !== ~ARG[7]) begin - $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[5], ~ARG[7], ~ARG[6]); - $finish; - end -end -// pragma translate_on -assign ~RESULT = ~ARG[8]; -// assert end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assertBitVector" - , "kind" : "Declaration" - , "type" : -"assertBitVector - :: ( KnownDomain dom -- ARG[0] - , KnownNat n -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> String -- ARG[4] - -> Signal dom (BitVector n) -- Checked value (ARG[5]) - -> Signal dom (BitVector n) -- Expected value (ARG[6]) - -> Signal dom b -- Return valued (ARG[7]) - -> Signal dom b" - , "template" : -"// assertBitVector begin -// pragma translate_off -wire ~TYP[5] ~GENSYM[maskXor][0] = ~ARG[6] ^ ~ARG[6]; -wire ~TYP[5] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; -wire ~TYP[5] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; - -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin - if (~SYM[1] !== ~SYM[2]) begin - $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[4], ~ARG[6], ~ARG[5]); - $finish; - end -end -// pragma translate_on -assign ~RESULT = ~ARG[7]; -// assertBitVector end" - } - } -] diff --git a/prims/verilog/Clash_Explicit_Testbench.primitives b/prims/verilog/Clash_Explicit_Testbench.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Explicit_Testbench.primitives @@ -0,0 +1,60 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assert" + , "kind" : "Declaration" + , "type" : +"assert + :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) + => Clock dom -- ARG[3] + -> Reset dom -- ARG[4] + -> String -- ARG[5] + -> Signal dom a -- Checked value (ARG[6]) + -> Signal dom a -- Expected value (ARG[7]) + -> Signal dom b -- Return valued (ARG[8]) + -> Signal dom b" + , "template" : +"// assert begin +// pragma translate_off +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin + if (~ARG[6] !== ~ARG[7]) begin + $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[5], ~ARG[7], ~ARG[6]); + $finish; + end +end +// pragma translate_on +assign ~RESULT = ~ARG[8]; +// assert end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assertBitVector" + , "kind" : "Declaration" + , "type" : +"assertBitVector + :: ( KnownDomain dom -- ARG[0] + , KnownNat n -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> String -- ARG[4] + -> Signal dom (BitVector n) -- Checked value (ARG[5]) + -> Signal dom (BitVector n) -- Expected value (ARG[6]) + -> Signal dom b -- Return valued (ARG[7]) + -> Signal dom b" + , "template" : +"// assertBitVector begin +// pragma translate_off +wire ~TYP[5] ~GENSYM[maskXor][0] = ~ARG[6] ^ ~ARG[6]; +wire ~TYP[5] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; +wire ~TYP[5] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; + +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin + if (~SYM[1] !== ~SYM[2]) begin + $display(\"@%0tns: %s, expected: %b, actual: %b\", $time, ~LIT[4], ~ARG[6], ~ARG[5]); + $finish; + end +end +// pragma translate_on +assign ~RESULT = ~ARG[7]; +// assertBitVector end" + } + } +] diff --git a/prims/verilog/Clash_Intel_DDR.json b/prims/verilog/Clash_Intel_DDR.json deleted file mode 100644 --- a/prims/verilog/Clash_Intel_DDR.json +++ /dev/null @@ -1,48 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Intel.DDR.altddioIn" - , "kind" : "Declaration" - , "type" : -"altddioIn - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - => SSymbol deviceFamily -- ARG[4] - -> Clock slow -- ARG[5] - -> Reset slow -- ARG[6] - -> Enable slow -- ARG[7] - -> Signal fast (BitVector m) -- ARG[8] - -> Signal slow (BitVector m,BitVector m)" - , "libraries" : ["altera_mf"] - , "template" : -"// altddioIn begin -wire ~SIGD[~GENSYM[dataout_l][1]][8]; -wire ~SIGD[~GENSYM[dataout_h][2]][8]; - -altddio_in - #( - .intended_device_family (~LIT[4]), - .invert_input_clocks (\"OFF\"), - .lpm_hint (\"UNUSED\"), - .lpm_type (\"altddio_in\"), - .power_up_high (\"OFF\"), - .width (~SIZE[~TYP[7]]) - ) - ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), - .aclr (1'b0),~ELSE - .aclr (~ARG[6]), - .sclr (1'b0),~FI - .datain (~ARG[8]),~ - .inclock (~ARG[5]), - .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] ~ELSE 1'b1 ~FI), - .dataout_h (~SYM[2]), - .dataout_l (~SYM[1]), - .aset (1'b0), - .sset (1'b0) - ); -assign ~RESULT = {~SYM[1],~SYM[2]}; -// altddioIn end" - } - } -] diff --git a/prims/verilog/Clash_Intel_DDR.primitives b/prims/verilog/Clash_Intel_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Intel_DDR.primitives @@ -0,0 +1,48 @@ +[ { "BlackBox" : + { "name" : "Clash.Intel.DDR.altddioIn" + , "kind" : "Declaration" + , "type" : +"altddioIn + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + => SSymbol deviceFamily -- ARG[4] + -> Clock slow -- ARG[5] + -> Reset slow -- ARG[6] + -> Enable slow -- ARG[7] + -> Signal fast (BitVector m) -- ARG[8] + -> Signal slow (BitVector m,BitVector m)" + , "libraries" : ["altera_mf"] + , "template" : +"// altddioIn begin +wire ~SIGD[~GENSYM[dataout_l][1]][8]; +wire ~SIGD[~GENSYM[dataout_h][2]][8]; + +altddio_in + #( + .intended_device_family (~LIT[4]), + .invert_input_clocks (\"OFF\"), + .lpm_hint (\"UNUSED\"), + .lpm_type (\"altddio_in\"), + .power_up_high (\"OFF\"), + .width (~SIZE[~TYP[7]]) + ) + ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN + .sclr (~ARG[6]), + .aclr (1'b0),~ELSE + .aclr (~ARG[6]), + .sclr (1'b0),~FI + .datain (~ARG[8]),~ + .inclock (~ARG[5]), + .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] ~ELSE 1'b1 ~FI), + .dataout_h (~SYM[2]), + .dataout_l (~SYM[1]), + .aset (1'b0), + .sset (1'b0) + ); +assign ~RESULT = {~SYM[1],~SYM[2]}; +// altddioIn end" + } + } +] diff --git a/prims/verilog/Clash_Prelude_ROM.json b/prims/verilog/Clash_Prelude_ROM.json deleted file mode 100644 --- a/prims/verilog/Clash_Prelude_ROM.json +++ /dev/null @@ -1,26 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.asyncRom#" - , "kind" : "Declaration" - , "type" : -"asyncRom# :: KnownNat n -- ^ ARG[0] - => Vec n a -- ^ ARG[1] - -> Int -- ^ ARG[2] - -> a" - , "template" : -"// asyncRom begin -wire ~TYPO ~GENSYM[ROM][0] [0:~LIT[0]-1]; - -wire ~TYP[1] ~GENSYM[romflat][1]; -assign ~SYM[1] = ~LIT[1]; -genvar ~GENSYM[i][2]; -~GENERATE -for (~SYM[2]=0; ~SYM[2] < ~LIT[0]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] - assign ~SYM[0][(~LIT[0]-1)-~SYM[2]] = ~SYM[1][~SYM[2]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; -end -~ENDGENERATE - -assign ~RESULT = ~SYM[0][~ARG[2]]; -// asyncRom end" - } - } -] diff --git a/prims/verilog/Clash_Prelude_ROM.primitives b/prims/verilog/Clash_Prelude_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Prelude_ROM.primitives @@ -0,0 +1,26 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.asyncRom#" + , "kind" : "Declaration" + , "type" : +"asyncRom# :: KnownNat n -- ^ ARG[0] + => Vec n a -- ^ ARG[1] + -> Int -- ^ ARG[2] + -> a" + , "template" : +"// asyncRom begin +wire ~TYPO ~GENSYM[ROM][0] [0:~LIT[0]-1]; + +wire ~TYP[1] ~GENSYM[romflat][1]; +assign ~SYM[1] = ~LIT[1]; +genvar ~GENSYM[i][2]; +~GENERATE +for (~SYM[2]=0; ~SYM[2] < ~LIT[0]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] + assign ~SYM[0][(~LIT[0]-1)-~SYM[2]] = ~SYM[1][~SYM[2]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; +end +~ENDGENERATE + +assign ~RESULT = ~SYM[0][~ARG[2]]; +// asyncRom end" + } + } +] diff --git a/prims/verilog/Clash_Prelude_ROM_File.json b/prims/verilog/Clash_Prelude_ROM_File.json deleted file mode 100644 --- a/prims/verilog/Clash_Prelude_ROM_File.json +++ /dev/null @@ -1,22 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" - , "kind" : "Declaration" - , "type" : -"asyncRomFile :: KnownNat m -- ARG[0] - => SNat n -- sz, ARG[1] - -> FilePath -- file, ARG[2] - -> Int -- rd, ARG[3] - -> BitVector m" - , "template" : -"// asyncRomFile begin -reg ~TYPO ~GENSYM[ROM][0] [0:~LIT[1]-1]; - -initial begin - $readmemb(~FILE[~LIT[2]],~SYM[0]); -end - -assign ~RESULT = ~SYM[0][~ARG[3]]; -// asyncRomFile end" - } - } -] diff --git a/prims/verilog/Clash_Prelude_ROM_File.primitives b/prims/verilog/Clash_Prelude_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Prelude_ROM_File.primitives @@ -0,0 +1,22 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" + , "kind" : "Declaration" + , "type" : +"asyncRomFile :: KnownNat m -- ARG[0] + => SNat n -- sz, ARG[1] + -> FilePath -- file, ARG[2] + -> Int -- rd, ARG[3] + -> BitVector m" + , "template" : +"// asyncRomFile begin +reg ~TYPO ~GENSYM[ROM][0] [0:~LIT[1]-1]; + +initial begin + $readmemb(~FILE[~LIT[2]],~SYM[0]); +end + +assign ~RESULT = ~SYM[0][~ARG[3]]; +// asyncRomFile end" + } + } +] diff --git a/prims/verilog/Clash_Signal_BiSignal.json b/prims/verilog/Clash_Signal_BiSignal.json deleted file mode 100644 --- a/prims/verilog/Clash_Signal_BiSignal.json +++ /dev/null @@ -1,35 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", - "kind" : "Declaration", - "renderVoid": "RenderVoid", - "type" : -"writeToBiSignal# - :: HasCallStack -- ARG[0] - => BiSignalIn ds d n -- ARG[1] - -> Signal d (Maybe (BitVector n)) -- ARG[2] - -> Signal d Bool -- ARG[3] - -> Signal d (BitVector n) -- ARG[4] - -> BiSignalOut ds d n", - "template": -"// writeToBiSignal# begin -assign ~ARG[1] = (~ARG[3] == 1'b1) ? ~ARG[4] : {~SIZE[~TYP[1]] {1'bz}}; -// writeToBiSignal# end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"readFromBiSignal# - :: ( HasCallStack -- ARG[0] - , KnownNat n) -- ARG[1] - => BiSignalIn ds d n -- ARG[2] - -> Signal d (BitVector n)" - , "template" : -"// readFromBiSignal begin -assign ~RESULT = ~ARG[2]; -// readFromBiSignal end" - } - } -] diff --git a/prims/verilog/Clash_Signal_BiSignal.primitives b/prims/verilog/Clash_Signal_BiSignal.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Signal_BiSignal.primitives @@ -0,0 +1,35 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", + "kind" : "Declaration", + "renderVoid": "RenderVoid", + "type" : +"writeToBiSignal# + :: HasCallStack -- ARG[0] + => BiSignalIn ds d n -- ARG[1] + -> Signal d (Maybe (BitVector n)) -- ARG[2] + -> Signal d Bool -- ARG[3] + -> Signal d (BitVector n) -- ARG[4] + -> BiSignalOut ds d n", + "template": +"// writeToBiSignal# begin +assign ~ARG[1] = (~ARG[3] == 1'b1) ? ~ARG[4] : {~SIZE[~TYP[1]] {1'bz}}; +// writeToBiSignal# end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"readFromBiSignal# + :: ( HasCallStack -- ARG[0] + , KnownNat n) -- ARG[1] + => BiSignalIn ds d n -- ARG[2] + -> Signal d (BitVector n)" + , "template" : +"// readFromBiSignal begin +assign ~RESULT = ~ARG[2]; +// readFromBiSignal end" + } + } +] diff --git a/prims/verilog/Clash_Signal_Internal.json b/prims/verilog/Clash_Signal_Internal.json deleted file mode 100644 --- a/prims/verilog/Clash_Signal_Internal.json +++ /dev/null @@ -1,149 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.Internal.delay#" - , "kind" : "Declaration" - , "type" : -"delay# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Enable dom -- ARG[3] - -> a -- ARG[4] - -> Signal clk a -- ARG[5] - -> Signal clk a" - , "outputReg" : true - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } - , "template" : -"// delay begin~IF ~ISACTIVEENABLE[3] ~THEN -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] - if (~ARG[3]) begin - ~RESULT <= ~ARG[5]; - end -end~ELSE -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] - ~RESULT <= ~ARG[5]; -end~FI -// delay end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.register#" - , "kind" : "Declaration" - , "type" : -"register# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> Enable dom -- ARG[4] - -> a -- ARG[5] (powerup value) - -> a -- ARG[6] (reset value) - -> Signal clk a -- ARG[7] - -> Signal clk a" - , "outputReg" : true - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } - , "template" : -"// register begin -always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] - if (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin - ~RESULT <= ~CONST[6]; - end else ~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin - ~RESULT <= ~ARG[7]; - end -end -// register end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.clockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" - , "type" : -"clockGen - :: KnownDomain dom -- ARG[0] - => Clock dom" - , "template" : -"// clockGen begin -// pragma translate_off -reg ~TYPO ~GENSYM[clk][0]; -// 1 = 0.1ps -localparam ~GENSYM[half_period][1] = (~PERIOD[0]0 / 2); -always begin - // Delay of 1 mitigates race conditions (https://github.com/steveicarus/iverilog/issues/160) - #1 ~SYM[0] = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; - #30000 forever begin - ~SYM[0] = ~ ~SYM[0]; - #~SYM[1]; - ~SYM[0] = ~ ~SYM[0]; - #~SYM[1]; - end -end -assign ~RESULT = ~SYM[0]; -// pragma translate_on -// clockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.tbClockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" - , "type" : -"tbClockGen - :: KnownDomain dom -- ARG[0] - => Signal dom Bool -- ARG[1] - -> Clock dom" - , "template" : -"// tbClockGen begin -// pragma translate_off -reg ~TYPO ~GENSYM[clk][0]; -// 1 = 0.1ps -localparam ~GENSYM[half_period][1] = (~PERIOD[0]0 / 2); -always begin - // Delay of 1 mitigates race conditions (https://github.com/steveicarus/iverilog/issues/160) - #1 ~SYM[0] = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; - #30000 forever begin - if (~ ~ARG[1]) begin - $finish; - end - ~SYM[0] = ~ ~SYM[0]; - #~SYM[1]; - ~SYM[0] = ~ ~SYM[0]; - #~SYM[1]; - end -end -assign ~RESULT = ~SYM[0]; -// pragma translate_on -// tbClockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.resetGenN" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" - , "template" : -"// resetGen on -// pragma translate_off -~IF~ISSYNC[0]~THEN -reg ~TYPO ~GENSYM[rst][0]; -localparam ~GENSYM[reset_period][1] = 29998 + (~LIT[2] * ~PERIOD[0]0); -initial begin - #1 ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; - #~SYM[1] ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; -end -assign ~RESULT = ~SYM[0];~ELSE -reg ~TYPO ~SYM[0]; -localparam ~SYM[1] = 30001 + ((~LIT[2] - 1) * ~PERIOD[0]0); -initial begin - #1 ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; - #~SYM[1] ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; -end -assign ~RESULT = ~SYM[0]; ~FI -// pragma translate_on -// resetGen end" - } - } -] diff --git a/prims/verilog/Clash_Signal_Internal.primitives b/prims/verilog/Clash_Signal_Internal.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Signal_Internal.primitives @@ -0,0 +1,178 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.Internal.delay#" + , "kind" : "Declaration" + , "type" : +"delay# + :: ( KnownDomain dom -- ARG[0] + , Undefined a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Enable dom -- ARG[3] + -> a -- ARG[4] + -> Signal clk a -- ARG[5] + -> Signal clk a" + , "outputReg" : true + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } + , "template" : +"// delay begin~IF ~ISACTIVEENABLE[3] ~THEN +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] + if (~ARG[3]) begin + ~RESULT <= ~ARG[5]; + end +end~ELSE +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] + ~RESULT <= ~ARG[5]; +end~FI +// delay end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.asyncRegister#" + , "kind" : "Declaration" + , "type" : +"asyncRegister# + :: ( KnownDomain dom -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "outputReg" : true + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"// async register begin +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + ~RESULT <= ~CONST[6]; + end else ~FI~IF ~ISACTIVEENABLE[4] ~THENif (~ARG[4]) ~ELSE~FIbegin + ~RESULT <= ~ARG[7]; + end +end +// async register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.register#" + , "kind" : "Declaration" + , "type" : +"register# + :: ( KnownDomain dom -- ARG[0] + , Undefined a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "outputReg" : true + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"// register begin +always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + ~RESULT <= ~CONST[6]; + end else ~FI~IF ~ISACTIVEENABLE[4] ~THENif (~ARG[4]) ~ELSE~FIbegin + ~RESULT <= ~ARG[7]; + end +end +// register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.clockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" + , "type" : +"clockGen + :: KnownDomain dom -- ARG[0] + => Clock dom" + , "template" : +"// clockGen begin +// pragma translate_off +reg ~TYPO ~GENSYM[clk][0]; +// 1 = 0.1ps +localparam ~GENSYM[half_period][1] = (~PERIOD[0]0 / 2); +always begin + // Delay of 1 mitigates race conditions (https://github.com/steveicarus/iverilog/issues/160) + #1 ~SYM[0] = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; + #30000 forever begin + ~SYM[0] = ~ ~SYM[0]; + #~SYM[1]; + ~SYM[0] = ~ ~SYM[0]; + #~SYM[1]; + end +end +assign ~RESULT = ~SYM[0]; +// pragma translate_on +// clockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.tbClockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" + , "type" : +"tbClockGen + :: KnownDomain dom -- ARG[0] + => Signal dom Bool -- ARG[1] + -> Clock dom" + , "template" : +"// tbClockGen begin +// pragma translate_off +reg ~TYPO ~GENSYM[clk][0]; +// 1 = 0.1ps +localparam ~GENSYM[half_period][1] = (~PERIOD[0]0 / 2); +always begin + // Delay of 1 mitigates race conditions (https://github.com/steveicarus/iverilog/issues/160) + #1 ~SYM[0] = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; + #30000 forever begin + if (~ ~ARG[1]) begin + $finish; + end + ~SYM[0] = ~ ~SYM[0]; + #~SYM[1]; + ~SYM[0] = ~ ~SYM[0]; + #~SYM[1]; + end +end +assign ~RESULT = ~SYM[0]; +// pragma translate_on +// tbClockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.resetGenN" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" + , "template" : +"// resetGen on +// pragma translate_off +~IF~ISSYNC[0]~THEN +reg ~TYPO ~GENSYM[rst][0]; +localparam ~GENSYM[reset_period][1] = 29998 + (~LIT[2] * ~PERIOD[0]0); +initial begin + #1 ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; + #~SYM[1] ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; +end +assign ~RESULT = ~SYM[0];~ELSE +reg ~TYPO ~SYM[0]; +localparam ~SYM[1] = 30001 + ((~LIT[2] - 1) * ~PERIOD[0]0); +initial begin + #1 ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; + #~SYM[1] ~SYM[0] = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; +end +assign ~RESULT = ~SYM[0]; ~FI +// pragma translate_on +// resetGen end" + } + } +] diff --git a/prims/verilog/Clash_Sized_Internal_BitVector.json b/prims/verilog/Clash_Sized_Internal_BitVector.json deleted file mode 100644 --- a/prims/verilog/Clash_Sized_Internal_BitVector.json +++ /dev/null @@ -1,75 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" - , "kind" : "Declaration" - , "type" : -"replaceBit# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Int -- ARG[2] - -> Bit -- ARG[3] - -> BitVector n" - , "outputReg" : true - , "template" : -"// replaceBit start -always @(*) begin - ~RESULT = ~ARG[1]; - ~RESULT[~ARG[2]] = ~VAR[din][3]; -end -// replaceBit end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.setSlice#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"setSlice# :: SNat (m + 1 + i) - -> BitVector (m + 1 + i) -- ARG[1] - -> SNat m -- ARG[2] - -> SNat n -- ARG[3] - -> BitVector (m + 1 - n) -- ARG[4] - -> BitVector (m + 1 + i)" - , "outputReg" : true - , "template" : -"// setSlice begin -always @(*) begin - ~RESULT = ~ARG[1]; - ~RESULT[~LIT[2] : ~LIT[3]] = ~VAR[din][4]; -end -// setSlice end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.split#" - , "kind" : "Expression" - , "type" : -"split# :: KnownNat n -- ARG[0] - => BitVector (m + n) -- ARG[1] - -> (BitVector m, BitVector n)" - , "template" : "~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : -"// rotateL begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : -"// rotateR begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; -// rotateR end" - } - } -] diff --git a/prims/verilog/Clash_Sized_Internal_BitVector.primitives b/prims/verilog/Clash_Sized_Internal_BitVector.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Sized_Internal_BitVector.primitives @@ -0,0 +1,75 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" + , "kind" : "Declaration" + , "type" : +"replaceBit# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit -- ARG[3] + -> BitVector n" + , "outputReg" : true + , "template" : +"// replaceBit start +always @(*) begin + ~RESULT = ~ARG[1]; + ~RESULT[~ARG[2]] = ~VAR[din][3]; +end +// replaceBit end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.setSlice#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"setSlice# :: SNat (m + 1 + i) + -> BitVector (m + 1 + i) -- ARG[1] + -> SNat m -- ARG[2] + -> SNat n -- ARG[3] + -> BitVector (m + 1 - n) -- ARG[4] + -> BitVector (m + 1 + i)" + , "outputReg" : true + , "template" : +"// setSlice begin +always @(*) begin + ~RESULT = ~ARG[1]; + ~RESULT[~LIT[2] : ~LIT[3]] = ~VAR[din][4]; +end +// setSlice end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.split#" + , "kind" : "Expression" + , "type" : +"split# :: KnownNat n -- ARG[0] + => BitVector (m + n) -- ARG[1] + -> (BitVector m, BitVector n)" + , "template" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : +"// rotateL begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : +"// rotateR begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[bv][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; +// rotateR end" + } + } +] diff --git a/prims/verilog/Clash_Sized_Internal_Signed.json b/prims/verilog/Clash_Sized_Internal_Signed.json deleted file mode 100644 --- a/prims/verilog/Clash_Sized_Internal_Signed.json +++ /dev/null @@ -1,69 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.div#" - , "kind" : "Declaration" - , "type" : "div# :: Signed n -> Signed n -> Signed n" - , "template" : -"// divSigned begin -wire ~GENSYM[resultPos][1]; -wire ~GENSYM[dividerNeg][2]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divSigned end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.mod#" - , "kind" : "Declaration" - , "type" : "mod# :: Signed n -> Signed n -> Signed n" - , "template" : -"// modSigned begin -// remainder -wire ~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - (~SYM[0] == ~SIZE[~TYPO]'sd0 ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modSigned end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : -"// rotateL begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = $signed(~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]); -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : -"// rotateR begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = $signed(~SYM[0][~SIZE[~TYPO]-1 : 0]); -// rotateR end" - } - } -] diff --git a/prims/verilog/Clash_Sized_Internal_Signed.primitives b/prims/verilog/Clash_Sized_Internal_Signed.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Sized_Internal_Signed.primitives @@ -0,0 +1,69 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.div#" + , "kind" : "Declaration" + , "type" : "div# :: Signed n -> Signed n -> Signed n" + , "template" : +"// divSigned begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divSigned end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.mod#" + , "kind" : "Declaration" + , "type" : "mod# :: Signed n -> Signed n -> Signed n" + , "template" : +"// modSigned begin +// remainder +wire ~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + (~SYM[0] == ~SIZE[~TYPO]'sd0 ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modSigned end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : +"// rotateL begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = $signed(~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]); +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : +"// rotateR begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[s][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = $signed(~SYM[0][~SIZE[~TYPO]-1 : 0]); +// rotateR end" + } + } +] diff --git a/prims/verilog/Clash_Sized_Internal_Unsigned.json b/prims/verilog/Clash_Sized_Internal_Unsigned.json deleted file mode 100644 --- a/prims/verilog/Clash_Sized_Internal_Unsigned.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" - , "kind" : "Declaration" - , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : -"// rotateL begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; -// rotateL end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" - , "kind" : "Declaration" - , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : -"// rotateR begin -wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; -assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); -assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; -// rotateR end" - } - } -] diff --git a/prims/verilog/Clash_Sized_Internal_Unsigned.primitives b/prims/verilog/Clash_Sized_Internal_Unsigned.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Sized_Internal_Unsigned.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" + , "kind" : "Declaration" + , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : +"// rotateL begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} << (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][2*~SIZE[~TYPO]-1 : ~SIZE[~TYPO]]; +// rotateL end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" + , "kind" : "Declaration" + , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : +"// rotateR begin +wire [2*~SIZE[~TYPO]-1:0] ~GENSYM[u][0]; +assign ~SYM[0] = {~ARG[1],~ARG[1]} >> (~ARG[2] % ~SIZE[~TYPO]); +assign ~RESULT = ~SYM[0][~SIZE[~TYPO]-1 : 0]; +// rotateR end" + } + } +] diff --git a/prims/verilog/Clash_Sized_RTree.json b/prims/verilog/Clash_Sized_RTree.json deleted file mode 100644 --- a/prims/verilog/Clash_Sized_RTree.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.RTree.treplicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat d -> a -> RTree d a" - , "template" : "{(2**~LIT[0]) {~ARG[1]}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.textract" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "textract :: RTree 0 a -> a" - , "template" : "~VAR[tree][0][~SIZE[~TYP[0]]-1 -: ~SIZE[~TYPO]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.tsplit" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" - , "template" : "~ARG[0]" - } - } -] diff --git a/prims/verilog/Clash_Sized_RTree.primitives b/prims/verilog/Clash_Sized_RTree.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Sized_RTree.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.RTree.treplicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat d -> a -> RTree d a" + , "template" : "{(2**~LIT[0]) {~ARG[1]}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.textract" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "textract :: RTree 0 a -> a" + , "template" : "~VAR[tree][0][~SIZE[~TYP[0]]-1 -: ~SIZE[~TYPO]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.tsplit" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" + , "template" : "~ARG[0]" + } + } +] diff --git a/prims/verilog/Clash_Sized_Vector.json b/prims/verilog/Clash_Sized_Vector.json deleted file mode 100644 --- a/prims/verilog/Clash_Sized_Vector.json +++ /dev/null @@ -1,379 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Vector.head" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "head :: Vec (n + 1) a -> a" - , "template" : "~FROMBV[~VAR[vec][0][\\~SIZE[~TYP[0]]-1 -: ~SIZE[~TYPO]\\]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.tail" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tail :: Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0][~SIZE[~TYPO]-1 : 0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.last" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> a" - , "template" : "~FROMBV[~VAR[vec][0][\\~SIZE[~TYPO]-1:0\\]][~TYPO]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.init" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0][~SIZE[~TYP[0]]-1 : ~SIZE[~TYPEL[~TYP[0]]]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.select" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] - => SNat f -- ARG[1] - -> SNat s -- ARG[2] - -> SNat n -- ARG[3] - -> Vec i a -- ARG[4] - -> Vec n a" - , "template" : -"// select begin -wire ~TYPEL[~TYPO] ~SYM[1] [0:~LENGTH[~TYP[4]]-1]; -genvar ~GENSYM[i][2]; -~GENERATE -for (~SYM[2]=0; ~SYM[2] < ~LENGTH[~TYP[4]]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] - assign ~SYM[1][(~LENGTH[~TYP[4]]-1)-~SYM[2]] = ~VAR[vec][4][~SYM[2]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]]; -end -~ENDGENERATE - -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4]=0; ~SYM[4] < ~LIT[3]; ~SYM[4] = ~SYM[4] + 1) begin : ~GENSYM[select][5] - assign ~RESULT[(~LIT[3]-1-~SYM[4])*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[1][~LIT[1] + (~LIT[2] * ~SYM[4])]; -end -~ENDGENERATE -// select end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.++" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" - , "template" : "{~ARG[0],~ARG[1]}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.splitAt" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" - , "template" : "~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : - "unconcat :: KnownNat n -- ARG[0] - => SNat m -- ARG[1] - -> Vec (n * m) a -- ARG[2] - -> Vec n (Vec m a)" - , "template" : "~ARG[2]~DEVNULL[~ARG[0]]~DEVNULL[~ARG[1]]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.map" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" - , "template" : -"// map begin -genvar ~GENSYM[i][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[map][2]~IF~SIZE[~TYP[1]]~THEN - wire ~TYPEL[~TYP[1]] ~GENSYM[map_in][3]; - assign ~SYM[3] = ~VAR[vec][1][~SYM[1]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI - ~OUTPUTWIREREG[0] ~TYPEL[~TYPO] ~GENSYM[map_out][4]; - ~INST 0 - ~OUTPUT <= ~SYM[4]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ - ~INST - assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[4]; -end -~ENDGENERATE -// map end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" - , "template" : -"// imap begin -genvar ~GENSYM[i][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] - wire [~SIZE[~INDEXTYPE[~LIT[0]]]-1:0] ~GENSYM[map_index][3];~IF~SIZE[~TYP[2]]~THEN - wire ~TYPEL[~TYP[2]] ~GENSYM[map_in][4]; - assign ~SYM[4] = ~VAR[vec][2][~SYM[1]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI - ~OUTPUTWIREREG[1] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; - - assign ~SYM[3] = ~SIZE[~INDEXTYPE[~LIT[0]]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~INDEXTYPE[~LIT[0]]]]; - ~INST 1 - ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~INDEXTYPE[~LIT[0]]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; -end -~ENDGENERATE -// imap end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap_go" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" - , "template" : -"// imap begin -genvar ~GENSYM[i][1]; -~GENERATE -for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] - wire ~TYP[0] ~GENSYM[map_index][3];~IF~SIZE[~TYP[2]]~THEN - wire ~TYPEL[~TYP[2]] ~GENSYM[map_in][4]; - assign ~SYM[4] = ~VAR[vec][2][~SYM[1]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI - ~OUTPUTWIREREG[1] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; - - assign ~SYM[3] = ~SIZE[~TYP[0]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~TYP[0]]] + ~ARG[0]; - ~INST 1 - ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~TYP[0]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; -end -~ENDGENERATE -// imap end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.zipWith" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" - , "template" : -"// zipWith start -genvar ~GENSYM[i][2]; -~GENERATE -for (~SYM[2] = 0; ~SYM[2] < ~LENGTH[~TYPO]; ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[zipWith][6]~IF~SIZE[~TYP[1]]~THEN - wire ~TYPEL[~TYP[1]] ~GENSYM[zipWith_in1][3]; - assign ~SYM[3] = ~VAR[vec1][1][~SYM[2]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN - wire ~TYPEL[~TYP[2]] ~GENSYM[zipWith_in2][4]; - assign ~SYM[4] = ~VAR[vec2][2][~SYM[2]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI - ~OUTPUTWIREREG[0] ~TYPEL[~TYPO] ~SYM[5]; - ~INST 0 - ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INST - assign ~RESULT[~SYM[2]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; -end -~ENDGENERATE -// zipWith end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.foldr" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" - , "template" : -"// foldr start~IF ~LENGTH[~TYP[2]] ~THEN -wire ~TYPO ~GENSYM[intermediate][0] [0:~LENGTH[~TYP[2]]]; -assign ~SYM[0][~LENGTH[~TYP[2]]] = ~ARG[1]; - -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0; ~SYM[3] < ~LENGTH[~TYP[2]]; ~SYM[3]=~SYM[3]+1) begin : ~GENSYM[foldr][4]~IF~SIZE[~TYP[2]]~THEN - wire ~TYPEL[~TYP[2]] ~GENSYM[foldr_in1][5]; - assign ~SYM[5] = ~VAR[xs][2][(~LENGTH[~TYP[2]]-1-~SYM[3])*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI - wire ~TYPO ~GENSYM[foldr_in2][6]; - ~OUTPUTWIREREG[0] ~TYPO ~GENSYM[foldr_out][7]; - - assign ~SYM[6] = ~SYM[0][~SYM[3]+1]; - ~INST 0 - ~OUTPUT <= ~SYM[7]~ ~TYP[1]~ - ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[6]~ ~TYP[1]~ - ~INST - assign ~SYM[0][~SYM[3]] = ~SYM[7]; -end -~ENDGENERATE - -assign ~RESULT = ~SYM[0][0]; -~ELSE -assign ~RESULT = ~ARG[1]; -~FI// foldr end" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Vector.index_int" - , "templateFunction" : "Clash.Primitives.Sized.Vector.indexIntVerilog" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replace_int" - , "kind" : "Declaration" - , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" - , "template" : -"// vector replace begin -genvar ~GENSYM[i][0]; -~GENERATE -for (~SYM[0]=0;~SYM[0]<~LENGTH[~TYPO];~SYM[0]=~SYM[0]+1) begin : ~GENSYM[vector_replace][1] - assign ~RESULT[(~MAXINDEX[~TYPO]-~SYM[0])*~SIZE[~TYP[3]]+:~SIZE[~TYP[3]]] = ~ARG[2] == ~SYM[0] ? ~ARG[3] : ~VAR[vec][1][(~MAXINDEX[~TYPO]-~SYM[0])*~SIZE[~TYP[3]]+:~SIZE[~TYP[3]]]; -end -~ENDGENERATE -// vector replace end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.maxIndex" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxIndex :: KnownNat n => Vec n a -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0] - ~SIZE[~TYPO]'d1" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.length" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "length :: KnownNat n => Vec n a -> Int" - , "template" : "~SIZE[~TYPO]'sd~LIT[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat n -> a -> Vec n a" - , "template" : "{~LIT[0] {~ARG[1]}}" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.transpose" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" - , "template" : -"// transpose begin -genvar ~GENSYM[row_index][1]; -genvar ~GENSYM[col_index][2]; -~GENERATE -for (~SYM[1] = 0; ~SYM[1] < ~LENGTH[~TYP[1]]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[transpose_outer][3] - for (~SYM[2] = 0; ~SYM[2] < ~LENGTH[~TYPO]; ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[transpose_inner][4] - assign ~RESULT[((~SYM[2]*~SIZE[~TYPEL[~TYPO]])+(~SYM[1]*~SIZE[~TYPEL[~TYPEL[~TYPO]]]))+:~SIZE[~TYPEL[~TYPEL[~TYPO]]]] = ~VAR[matrix][1][((~SYM[1]*~SIZE[~TYPEL[~TYP[1]]])+(~SYM[2]*~SIZE[~TYPEL[~TYPEL[~TYPO]]]))+:~SIZE[~TYPEL[~TYPEL[~TYPO]]]]; - end -end -~ENDGENERATE -// transpose end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.reverse" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "reverse :: Vec n a -> Vec n a" - , "template" : -"// reverse begin -genvar ~GENSYM[i][1]; -~GENERATE -for (~SYM[1] = 0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[reverse][2] - assign ~RESULT[(~LENGTH[~TYPO] - 1 - ~SYM[1])*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~VAR[vec][0][~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]]; -end -~ENDGENERATE -// reverse end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concatBitVector#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"concatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) - => Vec n (BitVector m) -- ARG[2] - -> BitVector (n * m)" - , "template" : "~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcatBitVector#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) - => BitVector (n * m) -- ARG[2] - -> Vec n (BitVector m)" - , "template" : "~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateLeftS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"// rotateLeftS begin -localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; - -~GENERATE -if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] - assign ~RESULT = ~VAR[vec][1]; -end else begin : ~GENSYM[do_shift][4] - assign ~RESULT = {~VAR[vec][1][((~LIT[0]-~SYM[2])*~SIZE[~TYPEL[~TYPO]])-1 : 0] - ,~VAR[vec][1][~SIZE[~TYPO]-1 : (~LIT[0]-~SYM[2])*~SIZE[~TYPEL[~TYPO]]] - }; -end -~ENDGENERATE -// rotateLeftS end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateRightS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"// rotateRightS begin -localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; - -~GENERATE -if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] - assign ~RESULT = ~VAR[vec][1]; -end else begin : ~GENSYM[do_shift][4] - assign ~RESULT = {~VAR[vec][1][(~SYM[2]*~SIZE[~TYPEL[~TYPO]])-1 : 0] - ,~VAR[vec][1][~SIZE[~TYPO]-1 : ~SYM[2]*~SIZE[~TYPEL[~TYPO]]] - }; -end -~ENDGENERATE -// rotateRightS end" - } - } -] diff --git a/prims/verilog/Clash_Sized_Vector.primitives b/prims/verilog/Clash_Sized_Vector.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Sized_Vector.primitives @@ -0,0 +1,379 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Vector.head" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "head :: Vec (n + 1) a -> a" + , "template" : "~FROMBV[~VAR[vec][0][\\~SIZE[~TYP[0]]-1 -: ~SIZE[~TYPO]\\]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.tail" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tail :: Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0][~SIZE[~TYPO]-1 : 0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.last" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> a" + , "template" : "~FROMBV[~VAR[vec][0][\\~SIZE[~TYPO]-1:0\\]][~TYPO]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.init" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0][~SIZE[~TYP[0]]-1 : ~SIZE[~TYPEL[~TYP[0]]]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.select" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] + => SNat f -- ARG[1] + -> SNat s -- ARG[2] + -> SNat n -- ARG[3] + -> Vec i a -- ARG[4] + -> Vec n a" + , "template" : +"// select begin +wire ~TYPEL[~TYPO] ~SYM[1] [0:~LENGTH[~TYP[4]]-1]; +genvar ~GENSYM[i][2]; +~GENERATE +for (~SYM[2]=0; ~SYM[2] < ~LENGTH[~TYP[4]]; ~SYM[2]=~SYM[2]+1) begin : ~GENSYM[mk_array][3] + assign ~SYM[1][(~LENGTH[~TYP[4]]-1)-~SYM[2]] = ~VAR[vec][4][~SYM[2]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]]; +end +~ENDGENERATE + +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4]=0; ~SYM[4] < ~LIT[3]; ~SYM[4] = ~SYM[4] + 1) begin : ~GENSYM[select][5] + assign ~RESULT[(~LIT[3]-1-~SYM[4])*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[1][~LIT[1] + (~LIT[2] * ~SYM[4])]; +end +~ENDGENERATE +// select end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.++" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" + , "template" : "{~ARG[0],~ARG[1]}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.splitAt" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" + , "template" : "~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : + "unconcat :: KnownNat n -- ARG[0] + => SNat m -- ARG[1] + -> Vec (n * m) a -- ARG[2] + -> Vec n (Vec m a)" + , "template" : "~ARG[2]~DEVNULL[~ARG[0]]~DEVNULL[~ARG[1]]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.map" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" + , "template" : +"// map begin +genvar ~GENSYM[i][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[map][2]~IF~SIZE[~TYP[1]]~THEN + wire ~TYPEL[~TYP[1]] ~GENSYM[map_in][3]; + assign ~SYM[3] = ~VAR[vec][1][~SYM[1]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI + ~OUTPUTWIREREG[0] ~TYPEL[~TYPO] ~GENSYM[map_out][4]; + ~INST 0 + ~OUTPUT <= ~SYM[4]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ + ~INST + assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[4]; +end +~ENDGENERATE +// map end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" + , "template" : +"// imap begin +genvar ~GENSYM[i][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + wire [~SIZE[~INDEXTYPE[~LIT[0]]]-1:0] ~GENSYM[map_index][3];~IF~SIZE[~TYP[2]]~THEN + wire ~TYPEL[~TYP[2]] ~GENSYM[map_in][4]; + assign ~SYM[4] = ~VAR[vec][2][~SYM[1]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI + ~OUTPUTWIREREG[1] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; + + assign ~SYM[3] = ~SIZE[~INDEXTYPE[~LIT[0]]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~INDEXTYPE[~LIT[0]]]]; + ~INST 1 + ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~INDEXTYPE[~LIT[0]]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; +end +~ENDGENERATE +// imap end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap_go" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" + , "template" : +"// imap begin +genvar ~GENSYM[i][1]; +~GENERATE +for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + wire ~TYP[0] ~GENSYM[map_index][3];~IF~SIZE[~TYP[2]]~THEN + wire ~TYPEL[~TYP[2]] ~GENSYM[map_in][4]; + assign ~SYM[4] = ~VAR[vec][2][~SYM[1]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI + ~OUTPUTWIREREG[1] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; + + assign ~SYM[3] = ~SIZE[~TYP[0]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~TYP[0]]] + ~ARG[0]; + ~INST 1 + ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~TYP[0]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; +end +~ENDGENERATE +// imap end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.zipWith" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" + , "template" : +"// zipWith start +genvar ~GENSYM[i][2]; +~GENERATE +for (~SYM[2] = 0; ~SYM[2] < ~LENGTH[~TYPO]; ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[zipWith][6]~IF~SIZE[~TYP[1]]~THEN + wire ~TYPEL[~TYP[1]] ~GENSYM[zipWith_in1][3]; + assign ~SYM[3] = ~VAR[vec1][1][~SYM[2]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN + wire ~TYPEL[~TYP[2]] ~GENSYM[zipWith_in2][4]; + assign ~SYM[4] = ~VAR[vec2][2][~SYM[2]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI + ~OUTPUTWIREREG[0] ~TYPEL[~TYPO] ~SYM[5]; + ~INST 0 + ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[3]~ ~TYPEL[~TYP[1]]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INST + assign ~RESULT[~SYM[2]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; +end +~ENDGENERATE +// zipWith end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.foldr" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" + , "template" : +"// foldr start~IF ~LENGTH[~TYP[2]] ~THEN +wire ~TYPO ~GENSYM[intermediate][0] [0:~LENGTH[~TYP[2]]]; +assign ~SYM[0][~LENGTH[~TYP[2]]] = ~ARG[1]; + +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0; ~SYM[3] < ~LENGTH[~TYP[2]]; ~SYM[3]=~SYM[3]+1) begin : ~GENSYM[foldr][4]~IF~SIZE[~TYP[2]]~THEN + wire ~TYPEL[~TYP[2]] ~GENSYM[foldr_in1][5]; + assign ~SYM[5] = ~VAR[xs][2][(~LENGTH[~TYP[2]]-1-~SYM[3])*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI + wire ~TYPO ~GENSYM[foldr_in2][6]; + ~OUTPUTWIREREG[0] ~TYPO ~GENSYM[foldr_out][7]; + + assign ~SYM[6] = ~SYM[0][~SYM[3]+1]; + ~INST 0 + ~OUTPUT <= ~SYM[7]~ ~TYP[1]~ + ~INPUT <= ~SYM[5]~ ~TYPEL[~TYP[2]]~ + ~INPUT <= ~SYM[6]~ ~TYP[1]~ + ~INST + assign ~SYM[0][~SYM[3]] = ~SYM[7]; +end +~ENDGENERATE + +assign ~RESULT = ~SYM[0][0]; +~ELSE +assign ~RESULT = ~ARG[1]; +~FI// foldr end" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Vector.index_int" + , "templateFunction" : "Clash.Primitives.Sized.Vector.indexIntVerilog" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replace_int" + , "kind" : "Declaration" + , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" + , "template" : +"// vector replace begin +genvar ~GENSYM[i][0]; +~GENERATE +for (~SYM[0]=0;~SYM[0]<~LENGTH[~TYPO];~SYM[0]=~SYM[0]+1) begin : ~GENSYM[vector_replace][1] + assign ~RESULT[(~MAXINDEX[~TYPO]-~SYM[0])*~SIZE[~TYP[3]]+:~SIZE[~TYP[3]]] = ~ARG[2] == ~SYM[0] ? ~ARG[3] : ~VAR[vec][1][(~MAXINDEX[~TYPO]-~SYM[0])*~SIZE[~TYP[3]]+:~SIZE[~TYP[3]]]; +end +~ENDGENERATE +// vector replace end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.maxIndex" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxIndex :: KnownNat n => Vec n a -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0] - ~SIZE[~TYPO]'d1" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.length" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "length :: KnownNat n => Vec n a -> Int" + , "template" : "~SIZE[~TYPO]'sd~LIT[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat n -> a -> Vec n a" + , "template" : "{~LIT[0] {~ARG[1]}}" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.transpose" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" + , "template" : +"// transpose begin +genvar ~GENSYM[row_index][1]; +genvar ~GENSYM[col_index][2]; +~GENERATE +for (~SYM[1] = 0; ~SYM[1] < ~LENGTH[~TYP[1]]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[transpose_outer][3] + for (~SYM[2] = 0; ~SYM[2] < ~LENGTH[~TYPO]; ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[transpose_inner][4] + assign ~RESULT[((~SYM[2]*~SIZE[~TYPEL[~TYPO]])+(~SYM[1]*~SIZE[~TYPEL[~TYPEL[~TYPO]]]))+:~SIZE[~TYPEL[~TYPEL[~TYPO]]]] = ~VAR[matrix][1][((~SYM[1]*~SIZE[~TYPEL[~TYP[1]]])+(~SYM[2]*~SIZE[~TYPEL[~TYPEL[~TYPO]]]))+:~SIZE[~TYPEL[~TYPEL[~TYPO]]]]; + end +end +~ENDGENERATE +// transpose end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.reverse" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "reverse :: Vec n a -> Vec n a" + , "template" : +"// reverse begin +genvar ~GENSYM[i][1]; +~GENERATE +for (~SYM[1] = 0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[reverse][2] + assign ~RESULT[(~LENGTH[~TYPO] - 1 - ~SYM[1])*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~VAR[vec][0][~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]]; +end +~ENDGENERATE +// reverse end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concatBitVector#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"concatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => Vec n (BitVector m) -- ARG[2] + -> BitVector (n * m)" + , "template" : "~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcatBitVector#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => BitVector (n * m) -- ARG[2] + -> Vec n (BitVector m)" + , "template" : "~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateLeftS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"// rotateLeftS begin +localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; + +~GENERATE +if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] + assign ~RESULT = ~VAR[vec][1]; +end else begin : ~GENSYM[do_shift][4] + assign ~RESULT = {~VAR[vec][1][((~LIT[0]-~SYM[2])*~SIZE[~TYPEL[~TYPO]])-1 : 0] + ,~VAR[vec][1][~SIZE[~TYPO]-1 : (~LIT[0]-~SYM[2])*~SIZE[~TYPEL[~TYPO]]] + }; +end +~ENDGENERATE +// rotateLeftS end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateRightS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"// rotateRightS begin +localparam ~GENSYM[shift_amount][2] = ~LIT[2] % ~LIT[0]; + +~GENERATE +if (~SYM[2] == 0) begin : ~GENSYM[no_shift][3] + assign ~RESULT = ~VAR[vec][1]; +end else begin : ~GENSYM[do_shift][4] + assign ~RESULT = {~VAR[vec][1][(~SYM[2]*~SIZE[~TYPEL[~TYPO]])-1 : 0] + ,~VAR[vec][1][~SIZE[~TYPO]-1 : ~SYM[2]*~SIZE[~TYPEL[~TYPO]]] + }; +end +~ENDGENERATE +// rotateRightS end" + } + } +] diff --git a/prims/verilog/Clash_Xilinx_DDR.json b/prims/verilog/Clash_Xilinx_DDR.json deleted file mode 100644 --- a/prims/verilog/Clash_Xilinx_DDR.json +++ /dev/null @@ -1,92 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.iddr" - , "kind" : "Declaration" - , "type" : -"iddr - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - -> Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> Signal fast (BitVector m) -- ARG[7] - -> Signal slow (BitVector m,BitVector m)" - , "template" : -"// iddr begin -wire ~SIGD[~GENSYM[dataout_l][1]][7]; -wire ~SIGD[~GENSYM[dataout_h][2]][7]; -wire ~SIGD[~GENSYM[d][3]][7]; -assign ~SYM[3] = ~ARG[7]; - -genvar ~GENSYM[i][8]; -~GENERATE -for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] - IDDR #( - .DDR_CLK_EDGE(\"SAME_EDGE\"), - .INIT_Q1(1'b0), - .INIT_Q2(1'b0), - .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - ) ~GENSYM[~COMPNAME_IDDR][9] ( - .Q1(~SYM[1][~SYM[8]]), - .Q2(~SYM[2][~SYM[8]]), - .C(~ARG[4]), - .CE(~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] ~ELSE 1'b1 ~FI), - .D(~SYM[3][~SYM[8]]), - .R(~ARG[5]), - .S(1'b0) - ); -end -~ENDGENERATE - -assign ~RESULT = {~SYM[2],~SYM[1]}; -// iddr end" - } - } -, { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.oddr#" - , "kind" : "Declaration" - , "type" : -"oddr# - :: ( KnownConfi~ fast domf -- ARG[0] - , KnownConfi~ slow doms -- ARG[1] - , KnownNat m ) -- ARG[2] - => Clock slow -- ARG[3] - -> Reset slow -- ARG[4] - -> Enable slow -- ARG[5] - -> Signal slow (BitVector m) -- ARG[6] - -> Signal slow (BitVector m) -- ARG[7] - -> Signal fast (BitVector m)" - , "template" : -"// oddr begin -wire ~SIGD[~GENSYM[datain_l][1]][7]; -wire ~SIGD[~GENSYM[datain_h][2]][7]; -wire ~SIGD[~GENSYM[q][3]][7]; - -assign ~SYM[1] = ~ARG[6]; -assign ~SYM[2] = ~ARG[7]; - -genvar ~GENSYM[i][8]; -~GENERATE -for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] - ODDR #( - .DDR_CLK_EDGE(\"SAME_EDGE\"), - .INIT(1'b0), - .SRTYPE(~IF ~ISSYNC[1] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - ) ~GENSYM[~COMPNAME_ODDR][9] ( - .Q(~SYM[3][~SYM[8]]), - .C(~ARG[3]), - .CE(~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] ~ELSE 1'b1 ~FI), - .D1(~SYM[1][~SYM[8]]), - .D2(~SYM[2][~SYM[8]]), - .R(~ARG[4]), - .S(1'b0) - ); -end -~ENDGENERATE - -assign ~RESULT = ~SYM[3]; -// oddr end" - } - } -] diff --git a/prims/verilog/Clash_Xilinx_DDR.primitives b/prims/verilog/Clash_Xilinx_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/Clash_Xilinx_DDR.primitives @@ -0,0 +1,92 @@ +[ { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.iddr" + , "kind" : "Declaration" + , "type" : +"iddr + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + -> Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> Signal fast (BitVector m) -- ARG[7] + -> Signal slow (BitVector m,BitVector m)" + , "template" : +"// iddr begin +wire ~SIGD[~GENSYM[dataout_l][1]][7]; +wire ~SIGD[~GENSYM[dataout_h][2]][7]; +wire ~SIGD[~GENSYM[d][3]][7]; +assign ~SYM[3] = ~ARG[7]; + +genvar ~GENSYM[i][8]; +~GENERATE +for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] + IDDR #( + .DDR_CLK_EDGE(\"SAME_EDGE\"), + .INIT_Q1(1'b0), + .INIT_Q2(1'b0), + .SRTYPE(~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + ) ~GENSYM[~COMPNAME_IDDR][9] ( + .Q1(~SYM[1][~SYM[8]]), + .Q2(~SYM[2][~SYM[8]]), + .C(~ARG[4]), + .CE(~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] ~ELSE 1'b1 ~FI), + .D(~SYM[3][~SYM[8]]), + .R(~ARG[5]), + .S(1'b0) + ); +end +~ENDGENERATE + +assign ~RESULT = {~SYM[2],~SYM[1]}; +// iddr end" + } + } +, { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.oddr#" + , "kind" : "Declaration" + , "type" : +"oddr# + :: ( KnownConfi~ fast domf -- ARG[0] + , KnownConfi~ slow doms -- ARG[1] + , KnownNat m ) -- ARG[2] + => Clock slow -- ARG[3] + -> Reset slow -- ARG[4] + -> Enable slow -- ARG[5] + -> Signal slow (BitVector m) -- ARG[6] + -> Signal slow (BitVector m) -- ARG[7] + -> Signal fast (BitVector m)" + , "template" : +"// oddr begin +wire ~SIGD[~GENSYM[datain_l][1]][7]; +wire ~SIGD[~GENSYM[datain_h][2]][7]; +wire ~SIGD[~GENSYM[q][3]][7]; + +assign ~SYM[1] = ~ARG[6]; +assign ~SYM[2] = ~ARG[7]; + +genvar ~GENSYM[i][8]; +~GENERATE +for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] + ODDR #( + .DDR_CLK_EDGE(\"SAME_EDGE\"), + .INIT(1'b0), + .SRTYPE(~IF ~ISSYNC[1] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + ) ~GENSYM[~COMPNAME_ODDR][9] ( + .Q(~SYM[3][~SYM[8]]), + .C(~ARG[3]), + .CE(~IF ~ISACTIVEENABLE[5] ~THEN ~ARG[5] ~ELSE 1'b1 ~FI), + .D1(~SYM[1][~SYM[8]]), + .D2(~SYM[2][~SYM[8]]), + .R(~ARG[4]), + .S(1'b0) + ); +end +~ENDGENERATE + +assign ~RESULT = ~SYM[3]; +// oddr end" + } + } +] diff --git a/prims/verilog/GHC_Base.json b/prims/verilog/GHC_Base.json deleted file mode 100644 --- a/prims/verilog/GHC_Base.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Base.divInt" - , "kind" : "Declaration" - , "type" : "divInt :: Int -> Int -> Int" - , "template" : -"// divInt begin -// divide (rounds towards zero) -wire ~SIGD[~GENSYM[quot_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] / ~VAR[divider][1]; - -// round toward minus infinity -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? ~SYM[0] : ~SYM[0] - ~SIZE[~TYPO]'sd1; -// divInt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.modInt" - , "kind" : "Declaration" - , "type" : "modInt :: Int -> Int -> Int" - , "template" : -"// modInt begin -// remainder -wire ~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~VAR[dividend][0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInt end" - } - } -] diff --git a/prims/verilog/GHC_Base.primitives b/prims/verilog/GHC_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/GHC_Base.primitives @@ -0,0 +1,33 @@ +[ { "BlackBox" : + { "name" : "GHC.Base.divInt" + , "kind" : "Declaration" + , "type" : "divInt :: Int -> Int -> Int" + , "template" : +"// divInt begin +// divide (rounds towards zero) +wire ~SIGD[~GENSYM[quot_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] / ~VAR[divider][1]; + +// round toward minus infinity +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? ~SYM[0] : ~SYM[0] - ~SIZE[~TYPO]'sd1; +// divInt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.modInt" + , "kind" : "Declaration" + , "type" : "modInt :: Int -> Int -> Int" + , "template" : +"// modInt begin +// remainder +wire ~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~VAR[dividend][0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInt end" + } + } +] diff --git a/prims/verilog/GHC_Classes.json b/prims/verilog/GHC_Classes.json deleted file mode 100644 --- a/prims/verilog/GHC_Classes.json +++ /dev/null @@ -1,45 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.divInt#" - , "kind" : "Declaration" - , "type" : "divInt# :: Int# -> Int# -> Int#" - , "template" : -"// divInt# begin -wire ~GENSYM[resultPos][1]; -wire ~GENSYM[dividerNeg][2]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divInt# end" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.modInt#" - , "kind" : "Declaration" - , "type" : "modInt# :: Int# -> Int# -> Int#" - , "template" : -"// modInt# begin -// remainder -wire ~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInt# end" - } - } -] diff --git a/prims/verilog/GHC_Classes.primitives b/prims/verilog/GHC_Classes.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/GHC_Classes.primitives @@ -0,0 +1,45 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.divInt#" + , "kind" : "Declaration" + , "type" : "divInt# :: Int# -> Int# -> Int#" + , "template" : +"// divInt# begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divInt# end" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.modInt#" + , "kind" : "Declaration" + , "type" : "modInt# :: Int# -> Int# -> Int#" + , "template" : +"// modInt# begin +// remainder +wire ~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInt# end" + } + } +] diff --git a/prims/verilog/GHC_Integer_Type.json b/prims/verilog/GHC_Integer_Type.json deleted file mode 100644 --- a/prims/verilog/GHC_Integer_Type.json +++ /dev/null @@ -1,99 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.divInteger" - , "kind" : "Declaration" - , "type" : "divInteger :: Integer -> Integer -> Integer" - , "template" : -"// divInteger begin -wire ~GENSYM[resultPos][1]; -wire ~GENSYM[dividerNeg][2]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; -wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); -// divInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.modInteger" - , "kind" : "Declaration" - , "type" : "modInteger :: Integer -> Integer -> Integer" - , "template" : -"// modInteger begin -// remainder -wire ~SIGD[~GENSYM[rem_res][0]][0]; -assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? - ~SYM[0] : - ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); -// modInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.divModInteger" - , "kind" : "Declaration" - , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : -"// divModInteger begin -wire ~GENSYM[resultPos][1]; -wire ~GENSYM[dividerNeg][2]; -wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; -wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; -wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; -wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; -wire signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; - -assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; -assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; -assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension -assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension - -assign ~SYM[3] = ~SYM[1] ? ~SYM[4] - : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) - : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); - -assign ~SYM[6] = ~SYM[3] / ~SYM[5]; -assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); - -wire ~SIGD[~GENSYM[rem_res][8]][0]; -wire ~SIGD[~GENSYM[mod_res][9]][0]; -assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; - -// modulo -assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? - ~SYM[8] : - ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); - -assign ~RESULT = {~SYM[7],~SYM[9]}; -// divModInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.quotRemInteger" - , "kind" : "Declaration" - , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : -"// quotRemInteger begin -wire ~SIGD[~GENSYM[quot_res][0]][0]; -wire ~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemInteger end" - } - } -] diff --git a/prims/verilog/GHC_Integer_Type.primitives b/prims/verilog/GHC_Integer_Type.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/GHC_Integer_Type.primitives @@ -0,0 +1,99 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.divInteger" + , "kind" : "Declaration" + , "type" : "divInteger :: Integer -> Integer -> Integer" + , "template" : +"// divInteger begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// divInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.modInteger" + , "kind" : "Declaration" + , "type" : "modInteger :: Integer -> Integer -> Integer" + , "template" : +"// modInteger begin +// remainder +wire ~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// modInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divModInteger" + , "kind" : "Declaration" + , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// divModInteger begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; +wire signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); + +wire ~SIGD[~GENSYM[rem_res][8]][0]; +wire ~SIGD[~GENSYM[mod_res][9]][0]; +assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? + ~SYM[8] : + ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); + +assign ~RESULT = {~SYM[7],~SYM[9]}; +// divModInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotRemInteger" + , "kind" : "Declaration" + , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// quotRemInteger begin +wire ~SIGD[~GENSYM[quot_res][0]][0]; +wire ~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemInteger end" + } + } +] diff --git a/prims/verilog/GHC_Num_Integer.primitives b/prims/verilog/GHC_Num_Integer.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/GHC_Num_Integer.primitives @@ -0,0 +1,99 @@ +[ { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDiv" + , "kind" : "Declaration" + , "type" : "integerDiv :: Integer -> Integer -> Integer" + , "template" : +"// integerDiv begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYPO]:0] ~GENSYM[quot_res][6]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYPO]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYPO]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYPO]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYPO]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYPO]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~RESULT = $signed(~SYM[6][~SIZE[~TYPO]-1:0]); +// integerDiv end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerMod" + , "kind" : "Declaration" + , "type" : "integerMod :: Integer -> Integer -> Integer" + , "template" : +"// integerMod begin +// remainder +wire ~SIGD[~GENSYM[rem_res][0]][0]; +assign ~SYM[0] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~RESULT = (~VAR[dividend][0][~SIZE[~TYPO]-1] == ~VAR[divider][1][~SIZE[~TYPO]-1]) ? + ~SYM[0] : + ((~SYM[0] == ~SIZE[~TYPO]'sd0) ? ~SIZE[~TYPO]'sd0 : ~SYM[0] + ~VAR[divider][1]); +// integerMod end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDivMod#" + , "kind" : "Declaration" + , "type" : "integerDivMod :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// integerDivMod begin +wire ~GENSYM[resultPos][1]; +wire ~GENSYM[dividerNeg][2]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividend2][3]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividendE][4]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[dividerE][5]; +wire signed [~SIZE[~TYP[0]]:0] ~GENSYM[quot_res][6]; +wire signed [~SIZE[~TYP[0]]-1:0] ~GENSYM[div_res][7]; + +assign ~SYM[1] = ~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]; +assign ~SYM[2] = ~VAR[divider][1][~SIZE[~TYP[0]]-1] == 1'b1; +assign ~SYM[4] = $signed({{~VAR[dividend][0][~SIZE[~TYP[0]]-1]},~VAR[dividend][0]}); // sign extension +assign ~SYM[5] = $signed({{~VAR[divider][1][~SIZE[~TYP[0]]-1]} ,~VAR[divider][1]} ); // sign extension + +assign ~SYM[3] = ~SYM[1] ? ~SYM[4] + : (~SYM[2] ? (~SYM[4] - ~SYM[5] - ~SIZE[~TYP[0]]'sd1) + : (~SYM[4] - ~SYM[5] + ~SIZE[~TYP[0]]'sd1)); + +assign ~SYM[6] = ~SYM[3] / ~SYM[5]; +assign ~SYM[7] = $signed(~SYM[6][~SIZE[~TYP[0]]-1:0]); + +wire ~SIGD[~GENSYM[rem_res][8]][0]; +wire ~SIGD[~GENSYM[mod_res][9]][0]; +assign ~SYM[8] = ~VAR[dividend][0] % ~VAR[divider][1]; + +// modulo +assign ~SYM[9] = (~VAR[dividend][0][~SIZE[~TYP[0]]-1] == ~VAR[divider][1][~SIZE[~TYP[0]]-1]) ? + ~SYM[8] : + ((~SYM[8] == ~SIZE[~TYP[0]]'sd0) ? ~SIZE[~TYP[0]]'sd0 : ~SYM[8] + ~VAR[divider][1]); + +assign ~RESULT = {~SYM[7],~SYM[9]}; +// integerDivMod end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerQuotRem#" + , "kind" : "Declaration" + , "type" : "integerQuotRem :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"// integerQuotRem begin +wire ~SIGD[~GENSYM[quot_res][0]][0]; +wire ~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// integerQuotRem end" + } + } +] diff --git a/prims/verilog/GHC_Prim.json b/prims/verilog/GHC_Prim.json deleted file mode 100644 --- a/prims/verilog/GHC_Prim.json +++ /dev/null @@ -1,1507 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Prim.quotRemInt#" - , "kind" : "Declaration" - , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" - , "template" : -"// quotRemInt begin -wire ~SIGD[~GENSYM[quot_res][0]][0]; -wire ~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemInt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotRemWord#" - , "kind" : "Declaration" - , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" - , "template" : -"// quotRemWord begin -wire ~SIGD[~GENSYM[quot_res][0]][0]; -wire ~SIGD[~GENSYM[rem_res][1]][0]; -assign ~SYM[0] = ~ARG[0] / ~ARG[1]; -assign ~SYM[1] = ~ARG[0] % ~ARG[1]; - -assign ~RESULT = {~SYM[0],~SYM[1]}; -// quotRemWord end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt8#" - , "kind" : "Declaration" - , "type" : "popCnt8# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "popCnt8" - , "extension" : "inc" - , "template" : -"// ceiling of log2 -function integer ~INCLUDENAME[0]_clog2; - input integer value; - begin - value = value-1; - for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) - value = value>>1; - end -endfunction - -// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]_depth2Index; - input integer levels; - input integer depth; - - ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt8 begin -localparam ~GENSYM[width][0] = 8; - -// depth of the tree -localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); - -wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt16#" - , "kind" : "Declaration" - , "type" : "popCnt16# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "popCnt16" - , "extension" : "inc" - , "template" : -"// ceiling of log2 -function integer ~INCLUDENAME[0]_clog2; - input integer value; - begin - value = value-1; - for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) - value = value>>1; - end -endfunction - -// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]_depth2Index; - input integer levels; - input integer depth; - - ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt16 begin -localparam ~GENSYM[width][0] = 16; - -// depth of the tree -localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); - -wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt32#" - , "kind" : "Declaration" - , "type" : "popCnt32# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "popCnt32" - , "extension" : "inc" - , "template" : -"// ceiling of log2 -function integer ~INCLUDENAME[0]_clog2; - input integer value; - begin - value = value-1; - for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) - value = value>>1; - end -endfunction - -// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]_depth2Index; - input integer levels; - input integer depth; - - ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt32 begin -localparam ~GENSYM[width][0] = 32; - -// depth of the tree -localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); - -wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt64#" - , "kind" : "Declaration" - , "type" : "popCnt64# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "popCnt64" - , "extension" : "inc" - , "template" : -"// ceiling of log2 -function integer ~INCLUDENAME[0]_clog2; - input integer value; - begin - value = value-1; - for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) - value = value>>1; - end -endfunction - -// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]_depth2Index; - input integer levels; - input integer depth; - - ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt64 begin -localparam ~GENSYM[width][0] = 64; - -// depth of the tree -localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); - -wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt#" - , "kind" : "Declaration" - , "type" : "popCnt# :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "popCnt" - , "extension" : "inc" - , "template" : -"// ceiling of log2 -function integer ~INCLUDENAME[0]_clog2; - input integer value; - begin - value = value-1; - for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) - value = value>>1; - end -endfunction - -// given a level and a depth, calculate the corresponding index into the -// intermediate array -function integer ~INCLUDENAME[0]_depth2Index; - input integer levels; - input integer depth; - - ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); -endfunction" - } - ] - , "template" : -"// popCnt begin -localparam ~GENSYM[width][0] = ~SIZE[~TYPO]; - -// depth of the tree -localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); - -wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; - -// put input into the first half of the intermediate array -genvar ~GENSYM[i][4]; -~GENERATE -for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] - assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); -end -~ENDGENERATE - -// Create the tree of instantiated components -genvar ~GENSYM[d][6]; -genvar ~GENSYM[i][7]; -~GENERATE -if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] - for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] - for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] - assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + - ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; - end - end -end -~ENDGENERATE - -// The last element of the intermediate array holds the result -assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); -// popCnt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz8#" - , "kind" : "Declaration" - , "type" : "clz8 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz8 begin -wire [0:7] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][7:0]; - -wire [0:7] ~GENSYM[e][2]; -genvar ~GENSYM[n][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:5] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage1][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:3] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 3; -wire [5:0] i; -assign i = ~SYM[4][0:5]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz16#" - , "kind" : "Declaration" - , "type" : "clz16 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz16 begin -wire [0:15] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][15:0]; - -wire [0:15] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:11] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:7] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:4] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 4; -wire [7:0] i; -assign i = ~SYM[9][0:7]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz32#" - , "kind" : "Declaration" - , "type" : "clz32 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz32 begin -wire [0:31] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][31:0]; - -wire [0:31] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:23] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:15] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:9] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:5] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 5; -wire [9:0] i; -assign i = ~SYM[12][0:9]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz64#" - , "kind" : "Declaration" - , "type" : "clz64 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz64 begin -wire [0:63] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][63:0]; - -wire [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - wire [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -wire [11:0] i; -assign i = ~SYM[15][0:11]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// clz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz#" - , "kind" : "Declaration" - , "type" : "clz :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// clz begin~IF ~IW64 ~THEN -wire [0:63] ~GENSYM[v][1]; -assign ~SYM[1] = ~VAR[i][0][63:0]; - -wire [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - wire [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -wire [11:0] i; -assign i = ~SYM[15][0:11]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~ELSE -wire [0:31] ~SYM[1]; -assign ~SYM[1] = ~VAR[i][0][31:0]; - -wire [0:31] ~SYM[2]; -genvar ~SYM[3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:23] ~SYM[4]; -genvar ~SYM[5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:15] ~SYM[9]; -genvar ~SYM[10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:9] ~SYM[12]; -genvar ~SYM[13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:5] ~SYM[7]; -~GENERATE -if (1) begin -localparam n = 5; -wire [9:0] i; -assign i = ~SYM[12][0:9]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~FI -assign ~RESULT = $unsigned(~SYM[7]); -// clz end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz8#" - , "kind" : "Declaration" - , "type" : "ctz8 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz8 begin -wire [0:7] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:7] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:5] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:3] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 3; -wire [5:0] i; -assign i = ~SYM[4][0:5]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz16#" - , "kind" : "Declaration" - , "type" : "ctz16 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz16 begin -wire [0:15] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:15] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:11] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:7] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:4] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 4; -wire [7:0] i; -assign i = ~SYM[9][0:7]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz32#" - , "kind" : "Declaration" - , "type" : "ctz32 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz32 begin -wire [0:31] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:31] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:23] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:15] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:9] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:5] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 5; -wire [9:0] i; -assign i = ~SYM[12][0:9]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz64#" - , "kind" : "Declaration" - , "type" : "ctz64 :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz64 begin -wire [0:63] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:47] a; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - wire [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -wire [11:0] i; -assign i = ~SYM[15][0:11]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE - -assign ~RESULT = $unsigned(~SYM[7]); -// ctz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz#" - , "kind" : "Declaration" - , "type" : "ctz :: Word# -> Word#" - , "imports" : ["~INCLUDENAME[0].inc"] - , "includes" : - [ { "name" : "enc" - , "extension" : "inc" - , "template" : -"function [1:0] ~INCLUDENAME[0]; - input [1:0] a; - case (a) - 2'b00: ~INCLUDENAME[0] = 2'b10; - 2'b01: ~INCLUDENAME[0] = 2'b01; - 2'b10: ~INCLUDENAME[0] = 2'b00; - default: ~INCLUDENAME[0] = 2'b00; - endcase -endfunction" - } - ] - , "template" : -"// ctz begin~IF ~IW64 ~THEN -wire [0:63] ~GENSYM[v][1]; -genvar ~GENSYM[k][18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:63] ~GENSYM[e][2]; -genvar ~GENSYM[i][3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:47] ~GENSYM[a][4]; -genvar ~GENSYM[i1][5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:31] ~GENSYM[b][9]; -genvar ~GENSYM[i2][10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:19] ~GENSYM[c][12]; -genvar ~GENSYM[i3][13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:11] ~GENSYM[d][15]; -genvar ~GENSYM[i4][16]; -~GENERATE -for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] - localparam n = 5; - wire [9:0] i; - assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:6] ~GENSYM[res][7]; -~GENERATE -if (1) begin -localparam n = 6; -wire [11:0] i; -assign i = ~SYM[15][0:11]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~ELSE -wire [0:31] ~SYM[1]; -genvar ~SYM[18]; -~GENERATE -for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19] - assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; -end -~ENDGENERATE - -wire [0:31] ~SYM[2]; -genvar ~SYM[3]; -~GENERATE -for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] - assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); -end -~ENDGENERATE - -reg [0:23] ~SYM[4]; -genvar ~SYM[5]; -~GENERATE -for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] - localparam n = 2; - wire [3:0] i; - assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:15] ~SYM[9]; -genvar ~SYM[10]; -~GENERATE -for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] - localparam n = 3; - wire [5:0] i; - assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:9] ~SYM[12]; -genvar ~SYM[13]; -~GENERATE -for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] - localparam n = 4; - wire [7:0] i; - assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; - always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase - end -end -~ENDGENERATE - -reg [0:5] ~SYM[7]; -~GENERATE -if (1) begin -localparam n = 5; -wire [9:0] i; -assign i = ~SYM[12][0:9]; -always @(*) begin - case (i[n-1+n]) - 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; - default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; - endcase -end -end -~ENDGENERATE -~FI -assign ~RESULT = $unsigned(~SYM[7]); -// ctz end" - } - } -] diff --git a/prims/verilog/GHC_Prim.primitives b/prims/verilog/GHC_Prim.primitives new file mode 100644 --- /dev/null +++ b/prims/verilog/GHC_Prim.primitives @@ -0,0 +1,1507 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.quotRemInt#" + , "kind" : "Declaration" + , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" + , "template" : +"// quotRemInt begin +wire ~SIGD[~GENSYM[quot_res][0]][0]; +wire ~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemInt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotRemWord#" + , "kind" : "Declaration" + , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" + , "template" : +"// quotRemWord begin +wire ~SIGD[~GENSYM[quot_res][0]][0]; +wire ~SIGD[~GENSYM[rem_res][1]][0]; +assign ~SYM[0] = ~ARG[0] / ~ARG[1]; +assign ~SYM[1] = ~ARG[0] % ~ARG[1]; + +assign ~RESULT = {~SYM[0],~SYM[1]}; +// quotRemWord end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt8#" + , "kind" : "Declaration" + , "type" : "popCnt8# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "popCnt8" + , "extension" : "inc" + , "template" : +"// ceiling of log2 +function integer ~INCLUDENAME[0]_clog2; + input integer value; + begin + value = value-1; + for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) + value = value>>1; + end +endfunction + +// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]_depth2Index; + input integer levels; + input integer depth; + + ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt8 begin +localparam ~GENSYM[width][0] = 8; + +// depth of the tree +localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); + +wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt16#" + , "kind" : "Declaration" + , "type" : "popCnt16# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "popCnt16" + , "extension" : "inc" + , "template" : +"// ceiling of log2 +function integer ~INCLUDENAME[0]_clog2; + input integer value; + begin + value = value-1; + for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) + value = value>>1; + end +endfunction + +// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]_depth2Index; + input integer levels; + input integer depth; + + ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt16 begin +localparam ~GENSYM[width][0] = 16; + +// depth of the tree +localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); + +wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt32#" + , "kind" : "Declaration" + , "type" : "popCnt32# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "popCnt32" + , "extension" : "inc" + , "template" : +"// ceiling of log2 +function integer ~INCLUDENAME[0]_clog2; + input integer value; + begin + value = value-1; + for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) + value = value>>1; + end +endfunction + +// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]_depth2Index; + input integer levels; + input integer depth; + + ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt32 begin +localparam ~GENSYM[width][0] = 32; + +// depth of the tree +localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); + +wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt64#" + , "kind" : "Declaration" + , "type" : "popCnt64# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "popCnt64" + , "extension" : "inc" + , "template" : +"// ceiling of log2 +function integer ~INCLUDENAME[0]_clog2; + input integer value; + begin + value = value-1; + for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) + value = value>>1; + end +endfunction + +// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]_depth2Index; + input integer levels; + input integer depth; + + ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt64 begin +localparam ~GENSYM[width][0] = 64; + +// depth of the tree +localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); + +wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt#" + , "kind" : "Declaration" + , "type" : "popCnt# :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "popCnt" + , "extension" : "inc" + , "template" : +"// ceiling of log2 +function integer ~INCLUDENAME[0]_clog2; + input integer value; + begin + value = value-1; + for (~INCLUDENAME[0]_clog2=0; value>0; ~INCLUDENAME[0]_clog2=~INCLUDENAME[0]_clog2+1) + value = value>>1; + end +endfunction + +// given a level and a depth, calculate the corresponding index into the +// intermediate array +function integer ~INCLUDENAME[0]_depth2Index; + input integer levels; + input integer depth; + + ~INCLUDENAME[0]_depth2Index = (2 ** levels) - (2 ** depth); +endfunction" + } + ] + , "template" : +"// popCnt begin +localparam ~GENSYM[width][0] = ~SIZE[~TYPO]; + +// depth of the tree +localparam ~GENSYM[levels][2] = ~INCLUDENAME[0]_clog2(~SYM[0]); + +wire [~SYM[2]:0] ~GENSYM[intermediate][3] [0:(2*~SYM[0])-2]; + +// put input into the first half of the intermediate array +genvar ~GENSYM[i][4]; +~GENERATE +for (~SYM[4] = 0; ~SYM[4] < ~SYM[0]; ~SYM[4]=~SYM[4]+1) begin : ~GENSYM[mk_array][11] + assign ~SYM[3][~SYM[4]] = $unsigned(~VAR[input][0][~SYM[4]]); +end +~ENDGENERATE + +// Create the tree of instantiated components +genvar ~GENSYM[d][6]; +genvar ~GENSYM[i][7]; +~GENERATE +if (~SYM[2] != 0) begin : ~GENSYM[make_tree][8] + for (~SYM[6] = ~SYM[2]; ~SYM[6] > 0; ~SYM[6]=~SYM[6]-1) begin : ~GENSYM[tree_depth][9] + for (~SYM[7] = 0; ~SYM[7] < (2**(~SYM[6]-1)); ~SYM[7] = ~SYM[7]+1) begin : ~GENSYM[tree_depth_loop][10] + assign ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6])+~SYM[7]] = + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])] + + ~SYM[3][~INCLUDENAME[0]_depth2Index(~SYM[2]+1,~SYM[6]+1)+(2*~SYM[7])+1]; + end + end +end +~ENDGENERATE + +// The last element of the intermediate array holds the result +assign ~RESULT = $unsigned(~SYM[3][(2*~SYM[0])-2]); +// popCnt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz8#" + , "kind" : "Declaration" + , "type" : "clz8 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz8 begin +wire [0:7] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][7:0]; + +wire [0:7] ~GENSYM[e][2]; +genvar ~GENSYM[n][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:5] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage1][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:3] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 3; +wire [5:0] i; +assign i = ~SYM[4][0:5]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz16#" + , "kind" : "Declaration" + , "type" : "clz16 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz16 begin +wire [0:15] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][15:0]; + +wire [0:15] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:11] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:7] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:4] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 4; +wire [7:0] i; +assign i = ~SYM[9][0:7]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz32#" + , "kind" : "Declaration" + , "type" : "clz32 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz32 begin +wire [0:31] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][31:0]; + +wire [0:31] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:23] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:15] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:9] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:5] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 5; +wire [9:0] i; +assign i = ~SYM[12][0:9]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz64#" + , "kind" : "Declaration" + , "type" : "clz64 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz64 begin +wire [0:63] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][63:0]; + +wire [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + wire [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +wire [11:0] i; +assign i = ~SYM[15][0:11]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// clz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz#" + , "kind" : "Declaration" + , "type" : "clz :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// clz begin~IF ~IW64 ~THEN +wire [0:63] ~GENSYM[v][1]; +assign ~SYM[1] = ~VAR[i][0][63:0]; + +wire [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + wire [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +wire [11:0] i; +assign i = ~SYM[15][0:11]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~ELSE +wire [0:31] ~SYM[1]; +assign ~SYM[1] = ~VAR[i][0][31:0]; + +wire [0:31] ~SYM[2]; +genvar ~SYM[3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:23] ~SYM[4]; +genvar ~SYM[5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:15] ~SYM[9]; +genvar ~SYM[10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:9] ~SYM[12]; +genvar ~SYM[13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:5] ~SYM[7]; +~GENERATE +if (1) begin +localparam n = 5; +wire [9:0] i; +assign i = ~SYM[12][0:9]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~FI +assign ~RESULT = $unsigned(~SYM[7]); +// clz end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz8#" + , "kind" : "Declaration" + , "type" : "ctz8 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz8 begin +wire [0:7] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:7] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<4;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:5] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<2;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:3] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 3; +wire [5:0] i; +assign i = ~SYM[4][0:5]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz16#" + , "kind" : "Declaration" + , "type" : "ctz16 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz16 begin +wire [0:15] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:15] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<8;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:11] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<4;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:7] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<2;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:4] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 4; +wire [7:0] i; +assign i = ~SYM[9][0:7]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz32#" + , "kind" : "Declaration" + , "type" : "ctz32 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz32 begin +wire [0:31] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:31] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:23] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:15] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:9] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:5] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 5; +wire [9:0] i; +assign i = ~SYM[12][0:9]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz64#" + , "kind" : "Declaration" + , "type" : "ctz64 :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz64 begin +wire [0:63] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:47] a; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + wire [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +wire [11:0] i; +assign i = ~SYM[15][0:11]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE + +assign ~RESULT = $unsigned(~SYM[7]); +// ctz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz#" + , "kind" : "Declaration" + , "type" : "ctz :: Word# -> Word#" + , "imports" : ["~INCLUDENAME[0].inc"] + , "includes" : + [ { "name" : "enc" + , "extension" : "inc" + , "template" : +"function [1:0] ~INCLUDENAME[0]; + input [1:0] a; + case (a) + 2'b00: ~INCLUDENAME[0] = 2'b10; + 2'b01: ~INCLUDENAME[0] = 2'b01; + 2'b10: ~INCLUDENAME[0] = 2'b00; + default: ~INCLUDENAME[0] = 2'b00; + endcase +endfunction" + } + ] + , "template" : +"// ctz begin~IF ~IW64 ~THEN +wire [0:63] ~GENSYM[v][1]; +genvar ~GENSYM[k][18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:63] ~GENSYM[e][2]; +genvar ~GENSYM[i][3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<32;~SYM[3]=~SYM[3]+1) begin : ~GENSYM[enc_stage][8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:47] ~GENSYM[a][4]; +genvar ~GENSYM[i1][5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:31] ~GENSYM[b][9]; +genvar ~GENSYM[i2][10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<8;~SYM[10]=~SYM[10]+1) begin : ~GENSYM[mux_stage2][11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:19] ~GENSYM[c][12]; +genvar ~GENSYM[i3][13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<4;~SYM[13]=~SYM[13]+1) begin : ~GENSYM[mux_stage3][14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:11] ~GENSYM[d][15]; +genvar ~GENSYM[i4][16]; +~GENERATE +for (~SYM[16]=0;~SYM[16]<2;~SYM[16]=~SYM[16]+1) begin : ~GENSYM[mux_stage4][17] + localparam n = 5; + wire [9:0] i; + assign i = ~SYM[12][~SYM[16]*10:~SYM[16]*10+9]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[15][~SYM[16]*6:~SYM[16]*6+5] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:6] ~GENSYM[res][7]; +~GENERATE +if (1) begin +localparam n = 6; +wire [11:0] i; +assign i = ~SYM[15][0:11]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~ELSE +wire [0:31] ~SYM[1]; +genvar ~SYM[18]; +~GENERATE +for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19] + assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]]; +end +~ENDGENERATE + +wire [0:31] ~SYM[2]; +genvar ~SYM[3]; +~GENERATE +for (~SYM[3]=0;~SYM[3]<16;~SYM[3]=~SYM[3]+1) begin : ~SYM[8] + assign ~SYM[2][~SYM[3]*2:~SYM[3]*2+1] = ~INCLUDENAME[0](~SYM[1][~SYM[3]*2:~SYM[3]*2+1]); +end +~ENDGENERATE + +reg [0:23] ~SYM[4]; +genvar ~SYM[5]; +~GENERATE +for (~SYM[5]=0;~SYM[5]<8;~SYM[5]=~SYM[5]+1) begin : ~SYM[6] + localparam n = 2; + wire [3:0] i; + assign i = ~SYM[2][~SYM[5]*4:~SYM[5]*4+3]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[4][~SYM[5]*3:~SYM[5]*3+2] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:15] ~SYM[9]; +genvar ~SYM[10]; +~GENERATE +for (~SYM[10]=0;~SYM[10]<4;~SYM[10]=~SYM[10]+1) begin : ~SYM[11] + localparam n = 3; + wire [5:0] i; + assign i = ~SYM[4][~SYM[10]*6:~SYM[10]*6+5]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[9][~SYM[10]*4:~SYM[10]*4+3] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:9] ~SYM[12]; +genvar ~SYM[13]; +~GENERATE +for (~SYM[13]=0;~SYM[13]<2;~SYM[13]=~SYM[13]+1) begin : ~SYM[14] + localparam n = 4; + wire [7:0] i; + assign i = ~SYM[9][~SYM[13]*8:~SYM[13]*8+7]; + always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[12][~SYM[13]*5:~SYM[13]*5+4] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase + end +end +~ENDGENERATE + +reg [0:5] ~SYM[7]; +~GENERATE +if (1) begin +localparam n = 5; +wire [9:0] i; +assign i = ~SYM[12][0:9]; +always @(*) begin + case (i[n-1+n]) + 1'b0 : ~SYM[7] = {i[n-1+n] && i[n-1],1'b0,i[2*n-2:n]}; + default : ~SYM[7] = {i[n-1+n] && i[n-1],~ i[n-1],i[n-2:0]}; + endcase +end +end +~ENDGENERATE +~FI +assign ~RESULT = $unsigned(~SYM[7]); +// ctz end" + } + } +] diff --git a/prims/vhdl/Clash_Class_Exp.json b/prims/vhdl/Clash_Class_Exp.json deleted file mode 100644 --- a/prims/vhdl/Clash_Class_Exp.json +++ /dev/null @@ -1,29 +0,0 @@ -[ - { - "BlackBox": { - "name": "Clash.Class.Exp.expIndex#", - "kind": "Expression", - "type": "expIndex# :: KnownNat m => Index m -> SNat n -> Index (m^n)", - "template": "~DEVNULL[~ARG[0]]to_unsigned(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - }, - { - "BlackBox": { - "name": "Clash.Class.Exp.expSigned#", - "kind": "Expression", - "type": "expSigned# :: KnownNat m => Signed m -> SNat n -> Signed (m*n)", - "template": "~DEVNULL[~ARG[0]]to_signed(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - }, - { - "BlackBox": { - "name": "Clash.Class.Exp.expUnsigned#", - "kind": "Expression", - "type": "expUnsigned# :: KnownNat m => Unsigned m -> SNat n -> Unsigned (m*n)", - "template": "~DEVNULL[~ARG[0]]to_unsigned(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", - "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." - } - } -] diff --git a/prims/vhdl/Clash_Class_Exp.primitives b/prims/vhdl/Clash_Class_Exp.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Class_Exp.primitives @@ -0,0 +1,29 @@ +[ + { + "BlackBox": { + "name": "Clash.Class.Exp.expIndex#", + "kind": "Expression", + "type": "expIndex# :: KnownNat m => Index m -> SNat n -> Index (m^n)", + "template": "~DEVNULL[~ARG[0]]to_unsigned(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + }, + { + "BlackBox": { + "name": "Clash.Class.Exp.expSigned#", + "kind": "Expression", + "type": "expSigned# :: KnownNat m => Signed m -> SNat n -> Signed (m*n)", + "template": "~DEVNULL[~ARG[0]]to_signed(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + }, + { + "BlackBox": { + "name": "Clash.Class.Exp.expUnsigned#", + "kind": "Expression", + "type": "expUnsigned# :: KnownNat m => Unsigned m -> SNat n -> Unsigned (m*n)", + "template": "~DEVNULL[~ARG[0]]to_unsigned(to_integer(~ARG[1]) ** ~LIT[2], ~SIZE[~TYPO])", + "warning": "Exponentiation is only supported on relatively small constructs (< 32 bits). Ideally, Clash should have constant folded your expression. See https://github.com/clash-lang/clash-compiler/issues/593." + } + } +] diff --git a/prims/vhdl/Clash_Explicit_BlockRam.json b/prims/vhdl/Clash_Explicit_BlockRam.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_BlockRam.json +++ /dev/null @@ -1,177 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam#" - , "kind" : "Declaration" - , "type" : -"blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "template" : -"-- blockRam begin -~GENSYM[~RESULT_blockRam][1] : block - signal ~GENSYM[~RESULT_RAM][2] : ~TYP[5] := ~CONST[5]; - signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[5]] - 1; - signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[5]] - 1; -begin - ~SYM[4] <= to_integer(~ARG[6]) - -- pragma translate_off - mod ~LENGTH[~TYP[5]] - -- pragma translate_on - ; - - ~SYM[5] <= to_integer(~ARG[8]) - -- pragma translate_off - mod ~LENGTH[~TYP[5]] - -- pragma translate_on - ; -~IF ~VIVADO ~THEN - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; - end if; - ~RESULT <= fromSLV(~SYM[2](~SYM[4])); - end if; - end process; ~ELSE - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~ARG[9]; - end if; - ~RESULT <= ~SYM[2](~SYM[4]); - end if; - end process; ~FI -end block; ---end blockRam" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRamU#" - , "kind" : "Declaration" - , "type" : -"blockRamU# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a" - , "template" : -"-- blockRamU begin -~GENSYM[~RESULT_blockRam][1] : block~IF~VIVADO~THEN - type ~GENSYM[ram_t][8] is array (0 to integer'(~LIT[5])-1) of std_logic_vector(~SIZE[~TYP[9]]-1 downto 0);~ELSE - type ~SYM[8] is array (0 to integer'(~LIT[5])-1) of ~TYP[9];~FI - signal ~GENSYM[~RESULT_RAM][2] : ~SYM[8]; - signal ~GENSYM[rd][4] : integer range 0 to ~LIT[5] - 1; - signal ~GENSYM[wr][5] : integer range 0 to ~LIT[5] - 1; -begin - ~SYM[4] <= to_integer(~ARG[6]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; - - ~SYM[5] <= to_integer(~ARG[8]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; -~IF ~VIVADO ~THEN - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; - end if; - ~RESULT <= fromSLV(~SYM[2](~SYM[4])); - end if; - end process; ~ELSE - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~ARG[9]; - end if; - ~RESULT <= ~SYM[2](~SYM[4]); - end if; - end process; ~FI -end block; ---end blockRamU" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.blockRam1#" - , "kind" : "Declaration" - , "type" : -"blockRam1# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> SNat n -- len, ARG[5] - -> a -- init, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom a -- din, ARG[10] - -> Signal dom a" - , "template" : -"-- blockRam1 begin -~GENSYM[~RESULT_blockRam][1] : block~IF~VIVADO~THEN - type ~GENSYM[ram_t][8] is array (0 to integer'(~LIT[5])-1) of std_logic_vector(~SIZE[~TYP[6]]-1 downto 0);~ELSE - type ~SYM[8] is array (0 to integer'(~LIT[5])-1) of ~TYP[6];~FI - signal ~GENSYM[~RESULT_RAM][2] : ~SYM[8] := (others => ~IF~VIVADO~THEN~TOBV[~CONST[6]][~TYP[6]]~ELSE~CONST[6]~FI); - signal ~GENSYM[rd][4] : integer range 0 to ~LIT[5] - 1; - signal ~GENSYM[wr][5] : integer range 0 to ~LIT[5] - 1; -begin - ~SYM[4] <= to_integer(~ARG[7]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; - - ~SYM[5] <= to_integer(~ARG[9]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; -~IF ~VIVADO ~THEN - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[10]][~TYP[10]]; - end if; - ~RESULT <= fromSLV(~SYM[2](~SYM[4])); - end if; - end process; ~ELSE - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~ARG[10]; - end if; - ~RESULT <= ~SYM[2](~SYM[4]); - end if; - end process; ~FI -end block; ---end blockRam1" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_BlockRam.primitives b/prims/vhdl/Clash_Explicit_BlockRam.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_BlockRam.primitives @@ -0,0 +1,177 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam#" + , "kind" : "Declaration" + , "type" : +"blockRam# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "template" : +"-- blockRam begin +~GENSYM[~RESULT_blockRam][1] : block + signal ~GENSYM[~RESULT_RAM][2] : ~TYP[5] := ~CONST[5]; + signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[5]] - 1; + signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[5]] - 1; +begin + ~SYM[4] <= to_integer(~ARG[6]) + -- pragma translate_off + mod ~LENGTH[~TYP[5]] + -- pragma translate_on + ; + + ~SYM[5] <= to_integer(~ARG[8]) + -- pragma translate_off + mod ~LENGTH[~TYP[5]] + -- pragma translate_on + ; +~IF ~VIVADO ~THEN + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; + end if; + ~RESULT <= fromSLV(~SYM[2](~SYM[4])); + end if; + end process; ~ELSE + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~ARG[9]; + end if; + ~RESULT <= ~SYM[2](~SYM[4]); + end if; + end process; ~FI +end block; +--end blockRam" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRamU#" + , "kind" : "Declaration" + , "type" : +"blockRamU# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom Bool -- wren, ARG[7] + -> Signal dom Int -- wr, ARG[8] + -> Signal dom a -- din, ARG[9] + -> Signal dom a" + , "template" : +"-- blockRamU begin +~GENSYM[~RESULT_blockRam][1] : block~IF~VIVADO~THEN + type ~GENSYM[ram_t][8] is array (0 to integer'(~LIT[5])-1) of std_logic_vector(~SIZE[~TYP[9]]-1 downto 0);~ELSE + type ~SYM[8] is array (0 to integer'(~LIT[5])-1) of ~TYP[9];~FI + signal ~GENSYM[~RESULT_RAM][2] : ~SYM[8]; + signal ~GENSYM[rd][4] : integer range 0 to ~LIT[5] - 1; + signal ~GENSYM[wr][5] : integer range 0 to ~LIT[5] - 1; +begin + ~SYM[4] <= to_integer(~ARG[6]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; + + ~SYM[5] <= to_integer(~ARG[8]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; +~IF ~VIVADO ~THEN + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; + end if; + ~RESULT <= fromSLV(~SYM[2](~SYM[4])); + end if; + end process; ~ELSE + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~ARG[9]; + end if; + ~RESULT <= ~SYM[2](~SYM[4]); + end if; + end process; ~FI +end block; +--end blockRamU" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.blockRam1#" + , "kind" : "Declaration" + , "type" : +"blockRam1# + :: ( KnownDomain dom ARG[0] + , HasCallStack -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> SNat n -- len, ARG[5] + -> a -- init, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom a -- din, ARG[10] + -> Signal dom a" + , "template" : +"-- blockRam1 begin +~GENSYM[~RESULT_blockRam][1] : block~IF~VIVADO~THEN + type ~GENSYM[ram_t][8] is array (0 to integer'(~LIT[5])-1) of std_logic_vector(~SIZE[~TYP[6]]-1 downto 0);~ELSE + type ~SYM[8] is array (0 to integer'(~LIT[5])-1) of ~TYP[6];~FI + signal ~GENSYM[~RESULT_RAM][2] : ~SYM[8] := (others => ~IF~VIVADO~THEN~TOBV[~CONST[6]][~TYP[6]]~ELSE~CONST[6]~FI); + signal ~GENSYM[rd][4] : integer range 0 to ~LIT[5] - 1; + signal ~GENSYM[wr][5] : integer range 0 to ~LIT[5] - 1; +begin + ~SYM[4] <= to_integer(~ARG[7]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; + + ~SYM[5] <= to_integer(~ARG[9]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; +~IF ~VIVADO ~THEN + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[10]][~TYP[10]]; + end if; + ~RESULT <= fromSLV(~SYM[2](~SYM[4])); + end if; + end process; ~ELSE + ~SYM[6] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~ARG[10]; + end if; + ~RESULT <= ~SYM[2](~SYM[4]); + end if; + end process; ~FI +end block; +--end blockRam1" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_BlockRam_File.json b/prims/vhdl/Clash_Explicit_BlockRam_File.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_BlockRam_File.json +++ /dev/null @@ -1,95 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" - , "kind" : "Declaration" - , "type" : -"blockRamFile# - :: ( KnownDomain dom -- ARG[0] - , KnownNat m -- ARG[1] - , HasCallStack ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> SNat n -- sz, ARG[5] - -> FilePath -- file, ARG[6] - -> Signal dom Int -- rd, ARG[7] - -> Signal dom Bool -- wren, ARG[8] - -> Signal dom Int -- wr, ARG[9] - -> Signal dom (BitVector m) -- din, ARG[10] - -> Signal dom (BitVector m)" - , "template" : -"-- blockRamFile begin -~GENSYM[~COMPNAME_blockRamFile][1] : block - type ~GENSYM[RamType][7] is array(natural range <>) of bit_vector(~LIT[1]-1 downto 0); - - impure function ~GENSYM[InitRamFromFile][2] (RamFileName : in string) return ~SYM[7] is - FILE RamFile : text open read_mode is RamFileName; - variable RamFileLine : line; - variable RAM : ~SYM[7](0 to ~LIT[5]-1); - begin - for i in RAM'range loop - readline(RamFile,RamFileLine); - read(RamFileLine,RAM(i)); - end loop; - return RAM; - end function; - - signal ~GENSYM[RAM][3] : ~SYM[7](0 to ~LIT[5]-1) := ~SYM[2](~FILE[~LIT[6]]); - signal ~GENSYM[rd][5] : integer range 0 to ~LIT[5]-1; - signal ~GENSYM[wr][6] : integer range 0 to ~LIT[5]-1; -begin - ~SYM[5] <= to_integer(~ARG[7]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; - - ~SYM[6] <= to_integer(~ARG[9]) - -- pragma translate_off - mod ~LIT[5] - -- pragma translate_on - ; - ~IF ~VIVADO ~THEN ~IF ~ISACTIVEENABLE[4] ~THEN - ~GENSYM[blockRamFile_sync][10] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[4] then - if ~ARG[8] then - ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); - end if; - ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); - end if; - end if; - end process;~ELSE - ~SYM[10] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[8] then - ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); - end if; - ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); - end if; - end process;~FI ~ELSE ~IF ~ISACTIVEENABLE[4] ~THEN - ~SYM[10] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[8] and ~ARG[4] then - ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); - end if; - if ~ARG[4] then - ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); - end if; - end if; - end process;~ELSE - ~SYM[10] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[8] then - ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); - end if; - ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); - end if; - end process;~FI ~FI -end block; --- blockRamFile end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_BlockRam_File.primitives b/prims/vhdl/Clash_Explicit_BlockRam_File.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_BlockRam_File.primitives @@ -0,0 +1,95 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.BlockRam.File.blockRamFile#" + , "kind" : "Declaration" + , "type" : +"blockRamFile# + :: ( KnownDomain dom -- ARG[0] + , KnownNat m -- ARG[1] + , HasCallStack ) -- ARG[2] + => Clock dom -- clk, ARG[3] + => Enable dom -- en, ARG[4] + -> SNat n -- sz, ARG[5] + -> FilePath -- file, ARG[6] + -> Signal dom Int -- rd, ARG[7] + -> Signal dom Bool -- wren, ARG[8] + -> Signal dom Int -- wr, ARG[9] + -> Signal dom (BitVector m) -- din, ARG[10] + -> Signal dom (BitVector m)" + , "template" : +"-- blockRamFile begin +~GENSYM[~COMPNAME_blockRamFile][1] : block + type ~GENSYM[RamType][7] is array(natural range <>) of bit_vector(~LIT[1]-1 downto 0); + + impure function ~GENSYM[InitRamFromFile][2] (RamFileName : in string) return ~SYM[7] is + FILE RamFile : text open read_mode is RamFileName; + variable RamFileLine : line; + variable RAM : ~SYM[7](0 to ~LIT[5]-1); + begin + for i in RAM'range loop + readline(RamFile,RamFileLine); + read(RamFileLine,RAM(i)); + end loop; + return RAM; + end function; + + signal ~GENSYM[RAM][3] : ~SYM[7](0 to ~LIT[5]-1) := ~SYM[2](~FILE[~LIT[6]]); + signal ~GENSYM[rd][5] : integer range 0 to ~LIT[5]-1; + signal ~GENSYM[wr][6] : integer range 0 to ~LIT[5]-1; +begin + ~SYM[5] <= to_integer(~ARG[7]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; + + ~SYM[6] <= to_integer(~ARG[9]) + -- pragma translate_off + mod ~LIT[5] + -- pragma translate_on + ; + ~IF ~VIVADO ~THEN ~IF ~ISACTIVEENABLE[4] ~THEN + ~GENSYM[blockRamFile_sync][10] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[4] then + if ~ARG[8] then + ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); + end if; + ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); + end if; + end if; + end process;~ELSE + ~SYM[10] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[8] then + ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); + end if; + ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); + end if; + end process;~FI ~ELSE ~IF ~ISACTIVEENABLE[4] ~THEN + ~SYM[10] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[8] and ~ARG[4] then + ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); + end if; + if ~ARG[4] then + ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); + end if; + end if; + end process;~ELSE + ~SYM[10] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~ARG[8] then + ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); + end if; + ~RESULT <= to_stdlogicvector(~SYM[3](~SYM[5])); + end if; + end process;~FI ~FI +end block; +-- blockRamFile end" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_DDR.json b/prims/vhdl/Clash_Explicit_DDR.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_DDR.json +++ /dev/null @@ -1,166 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrIn#" - , "kind" : "Declaration" - , "type" : -"ddrIn# :: forall a slow fast n pFast enabled synchronous. - ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> a -- ARG[7] - -> a -- ARG[8] - -> a -- ARG[9] - -> Signal fast a -- ARG[10] - -> Signal slow (a,a)" - , "template" : -"-- ddrIn begin -~GENSYM[~COMPNAME_ddrIn][0] : block - signal ~GENSYM[data_Pos][1] : ~TYP[9]; - signal ~GENSYM[data_Neg][2] : ~TYP[9]; - signal ~GENSYM[data_Neg_Latch][3] : ~TYP[9]; -begin - ~IF ~ISSYNC[3] ~THEN - -- sync - ------------- - ~GENSYM[~COMPNAME_ddrIn_pos][6] : process(~ARG[4]) - begin - if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[1] <= ~ARG[8]; - els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI - ~SYM[1] <= ~ARG[10]; - end if; - end if; - end process; - - ~GENSYM[~COMPNAME_ddrIn_neg][7] : process(~ARG[4]) - begin - if ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[4]) then - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[2] <= ~ARG[9]; - els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI - ~SYM[2] <= ~ARG[10]; - end if; - end if; - end process; - - ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] : process(~ARG[4]) - begin - if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[3] <= ~ARG[7]; - els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI - ~SYM[3] <= ~SYM[2]; - end if; - end if; - end process; - ~ELSE - -- async - -------------- - ~SYM[6] : process(~ARG[4],~ARG[5]~VARS[9]) - begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[1] <= ~ARG[8]; - elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - ~SYM[1] <= ~ARG[10]; - end if; - end process; - - ~SYM[7] : process(~ARG[4],~ARG[5]~VARS[9]) - begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[2] <= ~ARG[9]; - elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[4]) then - ~SYM[2] <= ~ARG[10]; - end if; - end process; - - ~SYM[8] : process(~ARG[4],~ARG[5],~SYM[2]) - begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[3] <= ~ARG[7]; - elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - ~SYM[3] <= ~SYM[2]; - end if; - end process; - ~FI - ~RESULT <= (~SYM[3], ~SYM[1]); -end block; --- ddrIn end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.DDR.ddrOut#" - , "kind" : "Declaration" - , "type" : -"ddrOut# :: ( HasCallStack -- ARG[0] - , Undefined a -- ARG[1] - , KnownConfi~ fast domf -- ARG[2] - , KnownConfi~ slow doms -- ARG[3] - => Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> a -- ARG[7] - -> Signal slow a -- ARG[8] - -> Signal slow a -- ARG[9] - -> Signal fast a" - , "template" : -"-- ddrOut begin -~GENSYM[~COMPNAME_ddrIn][0] : block - signal ~GENSYM[data_Pos][1] : ~TYP[7]; - signal ~GENSYM[data_Neg][2] : ~TYP[7]; -begin - ~IF ~ISSYNC[3] ~THEN - -- sync - ------------- - ~GENSYM[~COMPNAME_ddrOut_pos][5] : process(~ARG[4]) - begin - if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[1] <= ~ARG[7]; - els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI - ~SYM[1] <= ~ARG[8]; - end if; - end if; - end process; - - ~GENSYM[~COMPNAME_ddrOut_neg][6] : process(~ARG[4]) - begin - if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[2] <= ~ARG[7]; - els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI - ~SYM[2] <= ~ARG[9]; - end if; - end if; - end process; - ~ELSE - -- async - -------------- - ~SYM[5] : process(~ARG[4],~ARG[5]~VARS[8]) - begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[1] <= ~ARG[7]; - elsif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - ~SYM[1] <= ~ARG[8]; - end if; - end process; - - ~SYM[6] : process(~ARG[4],~ARG[5]~VARS[9]) - begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[2] <= ~ARG[7]; - elsif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then - ~SYM[2] <= ~ARG[9]; - end if; - end process; - ~FI - ~RESULT <= ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI when (~ARG[4] = '1' ~IF ~ISACTIVEENABLE[6] ~THEN and ~ARG[6] ~ELSE ~FI) else ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; -end block; --- ddrOut end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_DDR.primitives b/prims/vhdl/Clash_Explicit_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_DDR.primitives @@ -0,0 +1,166 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrIn#" + , "kind" : "Declaration" + , "type" : +"ddrIn# :: forall a slow fast n pFast enabled synchronous. + ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> a -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> Signal fast a -- ARG[10] + -> Signal slow (a,a)" + , "template" : +"-- ddrIn begin +~GENSYM[~COMPNAME_ddrIn][0] : block + signal ~GENSYM[data_Pos][1] : ~TYP[9]; + signal ~GENSYM[data_Neg][2] : ~TYP[9]; + signal ~GENSYM[data_Neg_Latch][3] : ~TYP[9]; +begin + ~IF ~ISSYNC[3] ~THEN + -- sync + ------------- + ~GENSYM[~COMPNAME_ddrIn_pos][6] : process(~ARG[4]) + begin + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[8]; + els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI + ~SYM[1] <= ~ARG[10]; + end if; + end if; + end process; + + ~GENSYM[~COMPNAME_ddrIn_neg][7] : process(~ARG[4]) + begin + if ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[4]) then + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[9]; + els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI + ~SYM[2] <= ~ARG[10]; + end if; + end if; + end process; + + ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] : process(~ARG[4]) + begin + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[3] <= ~ARG[7]; + els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI + ~SYM[3] <= ~SYM[2]; + end if; + end if; + end process; + ~ELSE + -- async + -------------- + ~SYM[6] : process(~ARG[4],~ARG[5]~VARS[9]) + begin + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[8]; + elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + ~SYM[1] <= ~ARG[10]; + end if; + end process; + + ~SYM[7] : process(~ARG[4],~ARG[5]~VARS[9]) + begin + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[9]; + elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[4]) then + ~SYM[2] <= ~ARG[10]; + end if; + end process; + + ~SYM[8] : process(~ARG[4],~ARG[5],~SYM[2]) + begin + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[3] <= ~ARG[7]; + elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + ~SYM[3] <= ~SYM[2]; + end if; + end process; + ~FI + ~RESULT <= (~SYM[3], ~SYM[1]); +end block; +-- ddrIn end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.DDR.ddrOut#" + , "kind" : "Declaration" + , "type" : +"ddrOut# :: ( HasCallStack -- ARG[0] + , Undefined a -- ARG[1] + , KnownConfi~ fast domf -- ARG[2] + , KnownConfi~ slow doms -- ARG[3] + => Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> a -- ARG[7] + -> Signal slow a -- ARG[8] + -> Signal slow a -- ARG[9] + -> Signal fast a" + , "template" : +"-- ddrOut begin +~GENSYM[~COMPNAME_ddrIn][0] : block + signal ~GENSYM[data_Pos][1] : ~TYP[7]; + signal ~GENSYM[data_Neg][2] : ~TYP[7]; +begin + ~IF ~ISSYNC[3] ~THEN + -- sync + ------------- + ~GENSYM[~COMPNAME_ddrOut_pos][5] : process(~ARG[4]) + begin + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[7]; + els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI + ~SYM[1] <= ~ARG[8]; + end if; + end if; + end process; + + ~GENSYM[~COMPNAME_ddrOut_neg][6] : process(~ARG[4]) + begin + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[7]; + els~IF ~ISACTIVEENABLE[6] ~THENif ~ARG[6] then~ELSEe~FI + ~SYM[2] <= ~ARG[9]; + end if; + end if; + end process; + ~ELSE + -- async + -------------- + ~SYM[5] : process(~ARG[4],~ARG[5]~VARS[8]) + begin + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[7]; + elsif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + ~SYM[1] <= ~ARG[8]; + end if; + end process; + + ~SYM[6] : process(~ARG[4],~ARG[5]~VARS[9]) + begin + if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[7]; + elsif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + ~SYM[2] <= ~ARG[9]; + end if; + end process; + ~FI + ~RESULT <= ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI when (~ARG[4] = '1' ~IF ~ISACTIVEENABLE[6] ~THEN and ~ARG[6] ~ELSE ~FI) else ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; +end block; +-- ddrOut end" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_RAM.json b/prims/vhdl/Clash_Explicit_RAM.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_RAM.json +++ /dev/null @@ -1,54 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.RAM.asyncRam#" - , "kind" : "Declaration" - , "type" : -"asyncRam# - :: ( HasCallStack -- ARG[0] - , KnownDomain wdom wconf -- ARG[1] - , KnownDomain rdom rconf ) -- ARG[2] - => Clock wdom -- ^ wclk, ARG[3] - -> Clock rdom -- ^ rclk, ARG[4] - -> Enable wdom -- ^ wen, ARG[5] - -> SNat n -- ^ sz, ARG[6] - -> Signal rdom Int -- ^ rd, ARG[7] - -> Signal wdom Bool -- ^ en, ARG[8] - -> Signal wdom Int -- ^ wr, ARG[9] - -> Signal wdom a -- ^ din, ARG[10] - -> Signal rdom a" - , "template" : -"-- asyncRam begin -~GENSYM[~COMPNAME_asyncRam][0] : block~IF ~VIVADO ~THEN - type ~GENSYM[RamType][4] is array(natural range <>) of std_logic_vector(~SIZE[~TYP[10]]-1 downto 0);~ELSE - type ~SYM[4] is array(natural range <>) of ~TYP[10];~FI - signal ~GENSYM[RAM][1] : ~SYM[4](0 to ~LIT[6]-1); - signal ~GENSYM[rd][2] : integer range 0 to ~LIT[6] - 1; - signal ~GENSYM[wr][3] : integer range 0 to ~LIT[6] - 1; -begin - ~SYM[2] <= to_integer(~ARG[7]) - -- pragma translate_off - mod ~LIT[6] - -- pragma translate_on - ; - - ~SYM[3] <= to_integer(~ARG[9]) - -- pragma translate_off - mod ~LIT[6] - -- pragma translate_on - ; - ~GENSYM[asyncRam_sync][7] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if (~ARG[8] ~IF ~ISACTIVEENABLE[5] ~THEN and ~ARG[5] ~ELSE ~FI) then~IF ~VIVADO ~THEN - ~SYM[1](~SYM[3]) <= ~TOBV[~ARG[10]][~TYP[10]];~ELSE - ~SYM[1](~SYM[3]) <= ~ARG[10];~FI - end if; - end if; - end process; - ~IF ~VIVADO ~THEN - ~RESULT <= ~FROMBV[~SYM[1](~SYM[2])][~TYP[10]];~ELSE - ~RESULT <= ~SYM[1](~SYM[2]);~FI -end block; --- asyncRam end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_RAM.primitives b/prims/vhdl/Clash_Explicit_RAM.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_RAM.primitives @@ -0,0 +1,54 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.RAM.asyncRam#" + , "kind" : "Declaration" + , "type" : +"asyncRam# + :: ( HasCallStack -- ARG[0] + , KnownDomain wdom wconf -- ARG[1] + , KnownDomain rdom rconf ) -- ARG[2] + => Clock wdom -- ^ wclk, ARG[3] + -> Clock rdom -- ^ rclk, ARG[4] + -> Enable wdom -- ^ wen, ARG[5] + -> SNat n -- ^ sz, ARG[6] + -> Signal rdom Int -- ^ rd, ARG[7] + -> Signal wdom Bool -- ^ en, ARG[8] + -> Signal wdom Int -- ^ wr, ARG[9] + -> Signal wdom a -- ^ din, ARG[10] + -> Signal rdom a" + , "template" : +"-- asyncRam begin +~GENSYM[~COMPNAME_asyncRam][0] : block~IF ~VIVADO ~THEN + type ~GENSYM[RamType][4] is array(natural range <>) of std_logic_vector(~SIZE[~TYP[10]]-1 downto 0);~ELSE + type ~SYM[4] is array(natural range <>) of ~TYP[10];~FI + signal ~GENSYM[RAM][1] : ~SYM[4](0 to ~LIT[6]-1); + signal ~GENSYM[rd][2] : integer range 0 to ~LIT[6] - 1; + signal ~GENSYM[wr][3] : integer range 0 to ~LIT[6] - 1; +begin + ~SYM[2] <= to_integer(~ARG[7]) + -- pragma translate_off + mod ~LIT[6] + -- pragma translate_on + ; + + ~SYM[3] <= to_integer(~ARG[9]) + -- pragma translate_off + mod ~LIT[6] + -- pragma translate_on + ; + ~GENSYM[asyncRam_sync][7] : process(~ARG[3]) + begin + if ~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if (~ARG[8] ~IF ~ISACTIVEENABLE[5] ~THEN and ~ARG[5] ~ELSE ~FI) then~IF ~VIVADO ~THEN + ~SYM[1](~SYM[3]) <= ~TOBV[~ARG[10]][~TYP[10]];~ELSE + ~SYM[1](~SYM[3]) <= ~ARG[10];~FI + end if; + end if; + end process; + ~IF ~VIVADO ~THEN + ~RESULT <= ~FROMBV[~SYM[1](~SYM[2])][~TYP[10]];~ELSE + ~RESULT <= ~SYM[1](~SYM[2]);~FI +end block; +-- asyncRam end" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_ROM.json b/prims/vhdl/Clash_Explicit_ROM.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_ROM.json +++ /dev/null @@ -1,37 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.rom#" - , "kind" : "Declaration" - , "type" : -"rom# :: ( KnownDomain dom ARG[0] - , KnownNat n -- ARG[1] - , Undefined a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom a" - , "template" : -"-- rom begin -~GENSYM[~COMPNAME_rom][1] : block - signal ~GENSYM[ROM][2] : ~TYP[5]; - signal ~GENSYM[rd][3] : integer range 0 to ~LIT[1]-1; -begin - ~SYM[2] <= ~LIT[5]; - - ~SYM[3] <= to_integer(~ARG[6]) - -- pragma translate_off - mod ~LIT[1] - -- pragma translate_on - ; - ~GENSYM[romSync][6] : process (~ARG[3]) - begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI) then~IF ~VIVADO ~THEN - ~RESULT <= ~FROMBV[~SYM[2](~SYM[3])][~TYPO];~ELSE - ~RESULT <= ~SYM[2](~SYM[3]);~FI - end if; - end process; -end block; --- rom end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_ROM.primitives b/prims/vhdl/Clash_Explicit_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_ROM.primitives @@ -0,0 +1,37 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.rom#" + , "kind" : "Declaration" + , "type" : +"rom# :: ( KnownDomain dom ARG[0] + , KnownNat n -- ARG[1] + , Undefined a ) -- ARG[2] + => Clock dom -- clk, ARG[3] + -> Enable dom -- en, ARG[4] + -> Vec n a -- init, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom a" + , "template" : +"-- rom begin +~GENSYM[~COMPNAME_rom][1] : block + signal ~GENSYM[ROM][2] : ~TYP[5]; + signal ~GENSYM[rd][3] : integer range 0 to ~LIT[1]-1; +begin + ~SYM[2] <= ~LIT[5]; + + ~SYM[3] <= to_integer(~ARG[6]) + -- pragma translate_off + mod ~LIT[1] + -- pragma translate_on + ; + ~GENSYM[romSync][6] : process (~ARG[3]) + begin + if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI) then~IF ~VIVADO ~THEN + ~RESULT <= ~FROMBV[~SYM[2](~SYM[3])][~TYPO];~ELSE + ~RESULT <= ~SYM[2](~SYM[3]);~FI + end if; + end process; +end block; +-- rom end" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_ROM_File.json b/prims/vhdl/Clash_Explicit_ROM_File.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_ROM_File.json +++ /dev/null @@ -1,57 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.ROM.File.romFile#" - , "kind" : "Declaration" - , "type" : -"romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom -- ARG[1] - => Clock dom -- clk, ARG[2] - -> Enable dom -- en, ARG[3] - -> SNat n -- sz, ARG[4] - -> FilePath -- file, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom (BitVector m)" - , "template" : -"-- romFile begin -~GENSYM[~COMPNAME_romFile][0] : block - type ~GENSYM[RomType][4] is array(natural range <>) of bit_vector(~LIT[0]-1 downto 0); - - impure function ~GENSYM[InitRomFromFile][1] (RomFileName : in string) return ~SYM[4] is - FILE RomFile : text open read_mode is RomFileName; - variable RomFileLine : line; - variable ROM : ~SYM[4](0 to ~LIT[4]-1); - begin - for i in ROM'range loop - readline(RomFile,RomFileLine); - read(RomFileLine,ROM(i)); - end loop; - return ROM; - end function; - - signal ~GENSYM[ROM][2] : ~SYM[4](0 to ~LIT[4]-1) := ~SYM[1](~FILE[~LIT[5]]); - signal ~GENSYM[rd][3] : integer range 0 to ~LIT[4]-1; -begin - ~SYM[3] <= to_integer(~ARG[6]) - -- pragma translate_off - mod ~LIT[4] - -- pragma translate_on - ; - ~IF ~ISACTIVEENABLE[3] ~THEN - ~GENSYM[romFileSync][7] : process (~ARG[2]) - begin - if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then - if ~ARG[3] then - ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); - end if; - end if; - end process;~ELSE - ~SYM[7] : process (~ARG[2]) - begin - if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then - ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); - end if; - end process;~FI -end block; --- romFile end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_ROM_File.primitives b/prims/vhdl/Clash_Explicit_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_ROM_File.primitives @@ -0,0 +1,57 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.ROM.File.romFile#" + , "kind" : "Declaration" + , "type" : +"romFile# :: ( KnownNat m -- ARG[0] + , KnownDomain dom -- ARG[1] + => Clock dom -- clk, ARG[2] + -> Enable dom -- en, ARG[3] + -> SNat n -- sz, ARG[4] + -> FilePath -- file, ARG[5] + -> Signal dom Int -- rd, ARG[6] + -> Signal dom (BitVector m)" + , "template" : +"-- romFile begin +~GENSYM[~COMPNAME_romFile][0] : block + type ~GENSYM[RomType][4] is array(natural range <>) of bit_vector(~LIT[0]-1 downto 0); + + impure function ~GENSYM[InitRomFromFile][1] (RomFileName : in string) return ~SYM[4] is + FILE RomFile : text open read_mode is RomFileName; + variable RomFileLine : line; + variable ROM : ~SYM[4](0 to ~LIT[4]-1); + begin + for i in ROM'range loop + readline(RomFile,RomFileLine); + read(RomFileLine,ROM(i)); + end loop; + return ROM; + end function; + + signal ~GENSYM[ROM][2] : ~SYM[4](0 to ~LIT[4]-1) := ~SYM[1](~FILE[~LIT[5]]); + signal ~GENSYM[rd][3] : integer range 0 to ~LIT[4]-1; +begin + ~SYM[3] <= to_integer(~ARG[6]) + -- pragma translate_off + mod ~LIT[4] + -- pragma translate_on + ; + ~IF ~ISACTIVEENABLE[3] ~THEN + ~GENSYM[romFileSync][7] : process (~ARG[2]) + begin + if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + if ~ARG[3] then + ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); + end if; + end if; + end process;~ELSE + ~SYM[7] : process (~ARG[2]) + begin + if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); + end if; + end process;~FI +end block; +-- romFile end" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_SimIO.json b/prims/vhdl/Clash_Explicit_SimIO.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_SimIO.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "Primitive" : - { "name" : "Clash.Explicit.SimIO.mealyIO" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.fmapSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.pureSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.apSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.bindSimIO#" - , "primType" : "Function" - } - } -, { "Primitive" : - { "name" : "Clash.Explicit.SimIO.unSimIO#" - , "primType" : "Function" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_SimIO.primitives b/prims/vhdl/Clash_Explicit_SimIO.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_SimIO.primitives @@ -0,0 +1,31 @@ +[ { "Primitive" : + { "name" : "Clash.Explicit.SimIO.mealyIO" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.fmapSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.pureSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.apSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.bindSimIO#" + , "primType" : "Function" + } + } +, { "Primitive" : + { "name" : "Clash.Explicit.SimIO.unSimIO#" + , "primType" : "Function" + } + } +] diff --git a/prims/vhdl/Clash_Explicit_Testbench.json b/prims/vhdl/Clash_Explicit_Testbench.json deleted file mode 100644 --- a/prims/vhdl/Clash_Explicit_Testbench.json +++ /dev/null @@ -1,157 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assert" - , "kind" : "Declaration" - , "type" : -"assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0],ARG[1],ARG[2]) - => Clock dom -- ARG[3] - -> Reset dom -- ARG[4] - -> String -- ARG[5] - -> Signal dom a -- Checked value (ARG[6]) - -> Signal dom a -- Expected value (ARG[7]) - -> Signal dom b -- Return valued (ARG[8]) - -> Signal dom b" - , "imports": ["~INCLUDENAME[0].all"] - , "includes" : - [ { "name" : "slv2string" - , "extension" : "vhdl" - , "template" : -"-- helper function of Clash.Explicit.Testbench.assert -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; - -package ~INCLUDENAME[0] is - function slv2string (slv : std_logic_vector) return STRING; -end; - -package body ~INCLUDENAME[0] is - function slv2string (slv : std_logic_vector) return STRING is - variable result : string (1 to slv'length); - variable res_l : string (1 to 3); - variable r : integer; - begin - r := 1; - for i in slv'range loop - res_l := std_logic'image(slv(i)); - result(r) := res_l(2); - r := r + 1; - end loop; - return result; - end slv2string; -end;" - } - ] - , "template" : -"-- assert begin -~GENSYM[assert][0] : block - -- pragma translate_off - signal ~GENSYM[actual][2] : ~TYP[6]; - signal ~GENSYM[expected][3] : ~TYP[7]; - -- pragma translate_on -begin - -- pragma translate_off - ~SYM[2] <= ~ARG[6]; - ~SYM[3] <= ~ARG[7]; - process(~ARG[3]) is - begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])) then - assert (toSLV(~SYM[2]) = toSLV(~SYM[3])) report (~LIT[5] & \", expected: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & \", actual: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; - end if; - end process; - -- pragma translate_on - ~RESULT <= ~ARG[8]; -end block; --- assert end" - } - } -,{ "BlackBox" : - { "name" : "Clash.Explicit.Testbench.assertBitVector" - , "kind" : "Declaration" - , "type" : -"assertBitVector - :: ( KnownDomain dom -- ARG[0] - , KnownNat n ) -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> String -- ARG[4] - -> Signal dom (BitVector n) -- Checked value (ARG[5]) - -> Signal dom (BitVector n) -- Expected value (ARG[6]) - -> Signal dom b -- Return valued (ARG[7]) - -> Signal dom b" - , "imports" : ["~INCLUDENAME[0].all"] - , "includes" : - [{ "name" : "assertBitVector" - , "extension" : "vhdl" - , "template" : -"-- helper functions of Clash.Explicit.Testbench.assertBitVector -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; - -package ~INCLUDENAME[0] is - function non_std_match (l, r : std_logic_vector) return boolean; - function slv2string (slv : std_logic_vector) return STRING; -end; - -package body ~INCLUDENAME[0] is - type match_table_type is array (std_ulogic, std_ulogic) of boolean; - constant match_table: match_table_type := - ('0' | 'L' => ('0' | 'L' | '-' => true, others => false), - '1' | 'H' => ('1' | 'H' | '-' => true, others => false), - '-' => ('-' => true, others => false), - others => ('-' => true, others => false) - ); - -- non_std_match is like std_match - -- But only accepts '-' as don't care in its the second argument r. - function non_std_match (l, r : std_logic_vector) return boolean is - alias la : std_logic_vector (l'length downto 1) is l; - alias ra : std_logic_vector (r'length downto 1) is r; - begin - for i in l'range loop - if not match_table (l (i), r (i)) then - return false; - end if; - end loop; - return true; - end non_std_match; - - function slv2string (slv : std_logic_vector) return STRING is - variable result : string (1 to slv'length); - variable res_l : string (1 to 3); - variable r : integer; - begin - r := 1; - for i in slv'range loop - res_l := std_logic'image(slv(i)); - result(r) := res_l(2); - r := r + 1; - end loop; - return result; - end slv2string; - -end; -" - }] - , "template" : -"-- assertBitVector begin -~GENSYM[assert][0] : block - -- pragma translate_off - signal ~GENSYM[actual][2] : ~TYP[5]; - signal ~GENSYM[expected][3] : ~TYP[6]; - -- pragma translate_on -begin - -- pragma translate_off - ~SYM[2] <= ~ARG[5]; - ~SYM[3] <= ~ARG[6]; - process(~ARG[2]) is - begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then - assert (~INCLUDENAME[0].non_std_match(toSLV(~SYM[2]),toSLV(~SYM[3]))) report (~LIT[4] & \", expected: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & \", actual: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; - end if; - end process; - -- pragma translate_on - ~RESULT <= ~ARG[7]; -end block; --- assertBitVector end" - } - } -] diff --git a/prims/vhdl/Clash_Explicit_Testbench.primitives b/prims/vhdl/Clash_Explicit_Testbench.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Explicit_Testbench.primitives @@ -0,0 +1,157 @@ +[ { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assert" + , "kind" : "Declaration" + , "type" : +"assert + :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0],ARG[1],ARG[2]) + => Clock dom -- ARG[3] + -> Reset dom -- ARG[4] + -> String -- ARG[5] + -> Signal dom a -- Checked value (ARG[6]) + -> Signal dom a -- Expected value (ARG[7]) + -> Signal dom b -- Return valued (ARG[8]) + -> Signal dom b" + , "imports": ["~INCLUDENAME[0].all"] + , "includes" : + [ { "name" : "slv2string" + , "extension" : "vhdl" + , "template" : +"-- helper function of Clash.Explicit.Testbench.assert +library IEEE; +use IEEE.STD_LOGIC_1164.ALL; + +package ~INCLUDENAME[0] is + function slv2string (slv : std_logic_vector) return STRING; +end; + +package body ~INCLUDENAME[0] is + function slv2string (slv : std_logic_vector) return STRING is + variable result : string (1 to slv'length); + variable res_l : string (1 to 3); + variable r : integer; + begin + r := 1; + for i in slv'range loop + res_l := std_logic'image(slv(i)); + result(r) := res_l(2); + r := r + 1; + end loop; + return result; + end slv2string; +end;" + } + ] + , "template" : +"-- assert begin +~GENSYM[assert][0] : block + -- pragma translate_off + signal ~GENSYM[actual][2] : ~TYP[6]; + signal ~GENSYM[expected][3] : ~TYP[7]; + -- pragma translate_on +begin + -- pragma translate_off + ~SYM[2] <= ~ARG[6]; + ~SYM[3] <= ~ARG[7]; + process(~ARG[3]) is + begin + if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])) then + assert (toSLV(~SYM[2]) = toSLV(~SYM[3])) report (~LIT[5] & \", expected: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & \", actual: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; + end if; + end process; + -- pragma translate_on + ~RESULT <= ~ARG[8]; +end block; +-- assert end" + } + } +,{ "BlackBox" : + { "name" : "Clash.Explicit.Testbench.assertBitVector" + , "kind" : "Declaration" + , "type" : +"assertBitVector + :: ( KnownDomain dom -- ARG[0] + , KnownNat n ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> String -- ARG[4] + -> Signal dom (BitVector n) -- Checked value (ARG[5]) + -> Signal dom (BitVector n) -- Expected value (ARG[6]) + -> Signal dom b -- Return valued (ARG[7]) + -> Signal dom b" + , "imports" : ["~INCLUDENAME[0].all"] + , "includes" : + [{ "name" : "assertBitVector" + , "extension" : "vhdl" + , "template" : +"-- helper functions of Clash.Explicit.Testbench.assertBitVector +library IEEE; +use IEEE.STD_LOGIC_1164.ALL; + +package ~INCLUDENAME[0] is + function non_std_match (l, r : std_logic_vector) return boolean; + function slv2string (slv : std_logic_vector) return STRING; +end; + +package body ~INCLUDENAME[0] is + type match_table_type is array (std_ulogic, std_ulogic) of boolean; + constant match_table: match_table_type := + ('0' | 'L' => ('0' | 'L' | '-' => true, others => false), + '1' | 'H' => ('1' | 'H' | '-' => true, others => false), + '-' => ('-' => true, others => false), + others => ('-' => true, others => false) + ); + -- non_std_match is like std_match + -- But only accepts '-' as don't care in its the second argument r. + function non_std_match (l, r : std_logic_vector) return boolean is + alias la : std_logic_vector (l'length downto 1) is l; + alias ra : std_logic_vector (r'length downto 1) is r; + begin + for i in l'range loop + if not match_table (l (i), r (i)) then + return false; + end if; + end loop; + return true; + end non_std_match; + + function slv2string (slv : std_logic_vector) return STRING is + variable result : string (1 to slv'length); + variable res_l : string (1 to 3); + variable r : integer; + begin + r := 1; + for i in slv'range loop + res_l := std_logic'image(slv(i)); + result(r) := res_l(2); + r := r + 1; + end loop; + return result; + end slv2string; + +end; +" + }] + , "template" : +"-- assertBitVector begin +~GENSYM[assert][0] : block + -- pragma translate_off + signal ~GENSYM[actual][2] : ~TYP[5]; + signal ~GENSYM[expected][3] : ~TYP[6]; + -- pragma translate_on +begin + -- pragma translate_off + ~SYM[2] <= ~ARG[5]; + ~SYM[3] <= ~ARG[6]; + process(~ARG[2]) is + begin + if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + assert (~INCLUDENAME[0].non_std_match(toSLV(~SYM[2]),toSLV(~SYM[3]))) report (~LIT[4] & \", expected: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & \", actual: \" & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; + end if; + end process; + -- pragma translate_on + ~RESULT <= ~ARG[7]; +end block; +-- assertBitVector end" + } + } +] diff --git a/prims/vhdl/Clash_Intel_DDR.json b/prims/vhdl/Clash_Intel_DDR.json deleted file mode 100644 --- a/prims/vhdl/Clash_Intel_DDR.json +++ /dev/null @@ -1,97 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Intel.DDR.altddioIn" - , "kind" : "Declaration" - , "type" : -"altddioIn - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - => SSymbol deviceFamily -- ARG[4] - -> Clock slow -- ARG[5] - -> Reset slow -- ARG[6] - -> Enable slow -- ARG[7] - -> Signal fast (BitVector m) -- ARG[8] - -> Signal slow (BitVector m,BitVector m)" - , "libraries" : ["altera_mf"] - , "imports" : ["altera_mf.altera_mf_components.all"] - , "template" : -"-- altddioIn begin -~GENSYM[~COMPNAME_ALTDDIO_IN][0] : block - signal ~GENSYM[dataout_l][1] : ~TYP[8]; - signal ~GENSYM[dataout_h][2] : ~TYP[8];~IF ~ISACTIVEENABLE[7] ~THEN - signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI -begin~IF ~ISACTIVEENABLE[5] ~THEN - ~SYM[4] <= '1' when (~ARG[7]) else '0';~ELSE ~FI - ~GENSYM[~COMPNAME_ALTDDIO_IN][7] : ALTDDIO_IN - GENERIC MAP ( - intended_device_family => ~LIT[4], - invert_input_clocks => \"OFF\", - lpm_hint => \"UNUSED\", - lpm_type => \"altddio_in\", - power_up_high => \"OFF\", - width => ~SIZE[~TYP[8]] - ) - PORT MAP (~IF ~ISSYNC[6] ~THEN - sclr => ~ARG[6],~ELSE - aclr => ~ARG[6],~FI - datain => ~ARG[8],~IF ~ISACTIVEENABLE[5] ~THEN - inclocken => ~SYM[4],~ELSE ~FI - inclock => ~ARG[5], - dataout_h => ~SYM[2], - dataout_l => ~SYM[1] - ); - ~RESULT <= (~SYM[1],~SYM[2]); -end block; --- altddioIn end" - } - } -, { "BlackBox" : - { "name" : "Clash.Intel.DDR.altddioOut#" - , "kind" : "Declaration" - , "type" : -"altddioOut# - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - => SSymbol deviceFamily -- ARG[4] - -> Clock slow -- ARG[5] - -> Reset slow -- ARG[6] - -> Enable slow -- ARG[7] - -> Signal slow (BitVector m) -- ARG[8] - -> Signal slow (BitVector m) -- ARG[9] - -> Signal fast (BitVector m)" - , "libraries" : ["altera_mf"] - , "imports" : ["altera_mf.altera_mf_components.all"] - , "template" : -"-- altddioOut begin -~GENSYM[~COMPNAME_ALTDDIO_OUT][0] : block ~IF ~ISACTIVEENABLE[7] ~THEN - signal ~GENSYM[ce_logic][1] : std_logic; ~ELSE ~FI -begin~IF ~ISACTIVEENABLE[7] ~THEN - ~SYM[3] <= '1' when (~ARG[7]) else '0'; ~ELSE ~FI - ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] : ALTDDIO_OUT - GENERIC MAP ( - extend_oe_disable => \"OFF\", - intended_device_family => ~LIT[4], - invert_output => \"OFF\", - lpm_hint => \"UNUSED\", - lpm_type => \"altddio_out\", - oe_reg => \"UNREGISTERED\", - power_up_high => \"OFF\", - width => ~SIZE[~TYPO] - ) - PORT MAP (~IF ~ISSYNC[2] ~THEN - sclr => ~ARG[6],~ELSE - aclr => ~ARG[6],~FI ~IF ~ISACTIVEENABLE[7] ~THEN - outclocken => ~SYM[1],~ELSE ~FI - outclock => ~ARG[5], - datain_h => ~ARG[7], - datain_l => ~ARG[8], - dataout => ~RESULT - ); -end block; --- altddioOut end" - } - } -] diff --git a/prims/vhdl/Clash_Intel_DDR.primitives b/prims/vhdl/Clash_Intel_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Intel_DDR.primitives @@ -0,0 +1,97 @@ +[ { "BlackBox" : + { "name" : "Clash.Intel.DDR.altddioIn" + , "kind" : "Declaration" + , "type" : +"altddioIn + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + => SSymbol deviceFamily -- ARG[4] + -> Clock slow -- ARG[5] + -> Reset slow -- ARG[6] + -> Enable slow -- ARG[7] + -> Signal fast (BitVector m) -- ARG[8] + -> Signal slow (BitVector m,BitVector m)" + , "libraries" : ["altera_mf"] + , "imports" : ["altera_mf.altera_mf_components.all"] + , "template" : +"-- altddioIn begin +~GENSYM[~COMPNAME_ALTDDIO_IN][0] : block + signal ~GENSYM[dataout_l][1] : ~TYP[8]; + signal ~GENSYM[dataout_h][2] : ~TYP[8];~IF ~ISACTIVEENABLE[7] ~THEN + signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI +begin~IF ~ISACTIVEENABLE[5] ~THEN + ~SYM[4] <= '1' when (~ARG[7]) else '0';~ELSE ~FI + ~GENSYM[~COMPNAME_ALTDDIO_IN][7] : ALTDDIO_IN + GENERIC MAP ( + intended_device_family => ~LIT[4], + invert_input_clocks => \"OFF\", + lpm_hint => \"UNUSED\", + lpm_type => \"altddio_in\", + power_up_high => \"OFF\", + width => ~SIZE[~TYP[8]] + ) + PORT MAP (~IF ~ISSYNC[6] ~THEN + sclr => ~ARG[6],~ELSE + aclr => ~ARG[6],~FI + datain => ~ARG[8],~IF ~ISACTIVEENABLE[5] ~THEN + inclocken => ~SYM[4],~ELSE ~FI + inclock => ~ARG[5], + dataout_h => ~SYM[2], + dataout_l => ~SYM[1] + ); + ~RESULT <= (~SYM[1],~SYM[2]); +end block; +-- altddioIn end" + } + } +, { "BlackBox" : + { "name" : "Clash.Intel.DDR.altddioOut#" + , "kind" : "Declaration" + , "type" : +"altddioOut# + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + => SSymbol deviceFamily -- ARG[4] + -> Clock slow -- ARG[5] + -> Reset slow -- ARG[6] + -> Enable slow -- ARG[7] + -> Signal slow (BitVector m) -- ARG[8] + -> Signal slow (BitVector m) -- ARG[9] + -> Signal fast (BitVector m)" + , "libraries" : ["altera_mf"] + , "imports" : ["altera_mf.altera_mf_components.all"] + , "template" : +"-- altddioOut begin +~GENSYM[~COMPNAME_ALTDDIO_OUT][0] : block ~IF ~ISACTIVEENABLE[7] ~THEN + signal ~GENSYM[ce_logic][1] : std_logic; ~ELSE ~FI +begin~IF ~ISACTIVEENABLE[7] ~THEN + ~SYM[3] <= '1' when (~ARG[7]) else '0'; ~ELSE ~FI + ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] : ALTDDIO_OUT + GENERIC MAP ( + extend_oe_disable => \"OFF\", + intended_device_family => ~LIT[4], + invert_output => \"OFF\", + lpm_hint => \"UNUSED\", + lpm_type => \"altddio_out\", + oe_reg => \"UNREGISTERED\", + power_up_high => \"OFF\", + width => ~SIZE[~TYPO] + ) + PORT MAP (~IF ~ISSYNC[2] ~THEN + sclr => ~ARG[6],~ELSE + aclr => ~ARG[6],~FI ~IF ~ISACTIVEENABLE[7] ~THEN + outclocken => ~SYM[1],~ELSE ~FI + outclock => ~ARG[5], + datain_h => ~ARG[7], + datain_l => ~ARG[8], + dataout => ~RESULT + ); +end block; +-- altddioOut end" + } + } +] diff --git a/prims/vhdl/Clash_Magic.primitives b/prims/vhdl/Clash_Magic.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Magic.primitives @@ -0,0 +1,13 @@ +[ { "BlackBox" : + { "name" : "Clash.Magic.nameHint" + , "kind" : "Declaration" + , "type" : +"nameHint + :: SSymbol sym -- ARG[0] + -> a -- ARG[1] + -> a" + , "resultName" : { "template" : "~NAME[0]" } + , "template" : "~RESULT <= ~ARG[1];" + } + } +] diff --git a/prims/vhdl/Clash_Prelude_ROM.json b/prims/vhdl/Clash_Prelude_ROM.json deleted file mode 100644 --- a/prims/vhdl/Clash_Prelude_ROM.json +++ /dev/null @@ -1,28 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.asyncRom#" - , "kind" : "Declaration" - , "type" : -"asyncRom# :: KnownNat n -- ^ ARG[0] - => Vec n a -- ^ ARG[1] - -> Int -- ^ ARG[2] - -> a" - , "template" : -"-- asyncRom begin -~GENSYM[asyncRom][0] : block - signal ~GENSYM[ROM][1] : ~TYP[1]; - signal ~GENSYM[rd][2] : integer range 0 to ~LIT[0]-1; -begin - ~SYM[1] <= ~LIT[1]; - - ~SYM[2] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~LIT[0] - -- pragma translate_on - ;~IF ~VIVADO ~THEN - ~RESULT <= ~FROMBV[~SYM[1](~SYM[2])][~TYPO];~ELSE - ~RESULT <= ~SYM[1](~SYM[2]);~FI -end block; --- asyncRom end" - } - } -] diff --git a/prims/vhdl/Clash_Prelude_ROM.primitives b/prims/vhdl/Clash_Prelude_ROM.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Prelude_ROM.primitives @@ -0,0 +1,28 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.asyncRom#" + , "kind" : "Declaration" + , "type" : +"asyncRom# :: KnownNat n -- ^ ARG[0] + => Vec n a -- ^ ARG[1] + -> Int -- ^ ARG[2] + -> a" + , "template" : +"-- asyncRom begin +~GENSYM[asyncRom][0] : block + signal ~GENSYM[ROM][1] : ~TYP[1]; + signal ~GENSYM[rd][2] : integer range 0 to ~LIT[0]-1; +begin + ~SYM[1] <= ~LIT[1]; + + ~SYM[2] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~LIT[0] + -- pragma translate_on + ;~IF ~VIVADO ~THEN + ~RESULT <= ~FROMBV[~SYM[1](~SYM[2])][~TYPO];~ELSE + ~RESULT <= ~SYM[1](~SYM[2]);~FI +end block; +-- asyncRom end" + } + } +] diff --git a/prims/vhdl/Clash_Prelude_ROM_File.json b/prims/vhdl/Clash_Prelude_ROM_File.json deleted file mode 100644 --- a/prims/vhdl/Clash_Prelude_ROM_File.json +++ /dev/null @@ -1,41 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" - , "kind" : "Declaration" - , "type" : -"asyncRomFile# :: KnownNat m -- ARG[0] - => SNat n -- sz, ARG[1] - -> FilePath -- file, ARG[2] - -> Int -- rd, ARG[3] - -> BitVector m" - , "template" : -"-- asyncRomFile begin -~GENSYM[asyncROMFile][0] : block - type ~GENSYM[RomType][4] is array(natural range <>) of bit_vector(~LIT[0]-1 downto 0); - - impure function ~GENSYM[InitRomFromFile][1] (RomFileName : in string) return ~SYM[4] is - FILE RomFile : text open read_mode is RomFileName; - variable RomFileLine : line; - variable ROM : ~SYM[4](0 to ~LIT[1]-1); - begin - for i in ROM'range loop - readline(RomFile,RomFileLine); - read(RomFileLine,ROM(i)); - end loop; - return ROM; - end function; - - signal ~GENSYM[ROM][2] : ~SYM[4](0 to ~LIT[1]-1) := ~SYM[1](~FILE[~LIT[2]]); - signal ~GENSYM[rd][3] : integer range 0 to ~LIT[1]-1; -begin - ~SYM[3] <= to_integer(~ARG[3]) - -- pragma translate_off - mod ~LIT[1] - -- pragma translate_on - ; - - ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); -end block; --- asyncRomFile end" - } - } -] diff --git a/prims/vhdl/Clash_Prelude_ROM_File.primitives b/prims/vhdl/Clash_Prelude_ROM_File.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Prelude_ROM_File.primitives @@ -0,0 +1,41 @@ +[ { "BlackBox" : + { "name" : "Clash.Prelude.ROM.File.asyncRomFile#" + , "kind" : "Declaration" + , "type" : +"asyncRomFile# :: KnownNat m -- ARG[0] + => SNat n -- sz, ARG[1] + -> FilePath -- file, ARG[2] + -> Int -- rd, ARG[3] + -> BitVector m" + , "template" : +"-- asyncRomFile begin +~GENSYM[asyncROMFile][0] : block + type ~GENSYM[RomType][4] is array(natural range <>) of bit_vector(~LIT[0]-1 downto 0); + + impure function ~GENSYM[InitRomFromFile][1] (RomFileName : in string) return ~SYM[4] is + FILE RomFile : text open read_mode is RomFileName; + variable RomFileLine : line; + variable ROM : ~SYM[4](0 to ~LIT[1]-1); + begin + for i in ROM'range loop + readline(RomFile,RomFileLine); + read(RomFileLine,ROM(i)); + end loop; + return ROM; + end function; + + signal ~GENSYM[ROM][2] : ~SYM[4](0 to ~LIT[1]-1) := ~SYM[1](~FILE[~LIT[2]]); + signal ~GENSYM[rd][3] : integer range 0 to ~LIT[1]-1; +begin + ~SYM[3] <= to_integer(~ARG[3]) + -- pragma translate_off + mod ~LIT[1] + -- pragma translate_on + ; + + ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); +end block; +-- asyncRomFile end" + } + } +] diff --git a/prims/vhdl/Clash_Promoted_Nat.json b/prims/vhdl/Clash_Promoted_Nat.json deleted file mode 100644 --- a/prims/vhdl/Clash_Promoted_Nat.json +++ /dev/null @@ -1,34 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Promoted.Nat.flogBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.flogBaseSNat :: (2 <= base, 1 <= x) - => SNat base -- ARG[2] - -> SNat x -- ARG[3] - -> SNat (FLog base x)" - , "template" : "integer(floor(log(real(~LIT[3]),real(~LIT[2]))))" - } - } -, { "BlackBox" : - { "name" : "Clash.Promoted.Nat.clogBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.clogBaseSNat :: (2 <= base, 1 <= x) - => SNat base -- ARG[2] - -> SNat x -- ARG[3] - -> SNat (CLog base x)" - , "template" : "integer(ceiling(log(real(~LIT[3]),real(~LIT[2]))))" - } - } -, { "BlackBox" : - { "name" : "Clash.Promoted.Nat.logBaseSNat" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Clash.Promoted.Nat.logBaseSNat :: (FLog base x ~ CLog base x) - => SNat base -- ARG[1] - -> SNat x -- ARG[2] - -> SNat (Log base x)" - , "template" : "integer(ceiling(log(real(~LIT[2]),real(~LIT[1]))))" - } - } -] diff --git a/prims/vhdl/Clash_Promoted_Nat.primitives b/prims/vhdl/Clash_Promoted_Nat.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Promoted_Nat.primitives @@ -0,0 +1,34 @@ +[ { "BlackBox" : + { "name" : "Clash.Promoted.Nat.flogBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.flogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (FLog base x)" + , "template" : "integer(floor(log(real(~LIT[3]),real(~LIT[2]))))" + } + } +, { "BlackBox" : + { "name" : "Clash.Promoted.Nat.clogBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.clogBaseSNat :: (2 <= base, 1 <= x) + => SNat base -- ARG[2] + -> SNat x -- ARG[3] + -> SNat (CLog base x)" + , "template" : "integer(ceiling(log(real(~LIT[3]),real(~LIT[2]))))" + } + } +, { "BlackBox" : + { "name" : "Clash.Promoted.Nat.logBaseSNat" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Clash.Promoted.Nat.logBaseSNat :: (FLog base x ~ CLog base x) + => SNat base -- ARG[1] + -> SNat x -- ARG[2] + -> SNat (Log base x)" + , "template" : "integer(ceiling(log(real(~LIT[2]),real(~LIT[1]))))" + } + } +] diff --git a/prims/vhdl/Clash_Signal_BiSignal.json b/prims/vhdl/Clash_Signal_BiSignal.json deleted file mode 100644 --- a/prims/vhdl/Clash_Signal_BiSignal.json +++ /dev/null @@ -1,35 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", - "kind" : "Declaration", - "renderVoid": "RenderVoid", - "type" : -"writeToBiSignal# - :: HasCallStack -- ARG[0] - => BiSignalIn ds d n -- ARG[1] - -> Signal d (Maybe (BitVector n)) -- ARG[2] - -> Signal d Bool -- ARG[3] - -> Signal d (BitVector n) -- ARG[4] - -> BiSignalOut ds d n", - "template": -"-- writeToBiSignal# begin -~ARG[1] <= ~ARG[4] when ~ARG[3] else (~SIZE[~TYP[1]]-1 downto 0 => 'Z'); --- writeToBiSignal# end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"readFromBiSignal# - :: ( HasCallStack -- ARG[0] - , KnownNat n) -- ARG[1] - => BiSignalIn ds d n -- ARG[2] - -> Signal d (BitVector n)" - , "template" : -"-- readFromBiSignal begin -~RESULT <= ~ARG[2]; --- readFromBiSignal end" - } - } -] diff --git a/prims/vhdl/Clash_Signal_BiSignal.primitives b/prims/vhdl/Clash_Signal_BiSignal.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Signal_BiSignal.primitives @@ -0,0 +1,35 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.writeToBiSignal#", + "kind" : "Declaration", + "renderVoid": "RenderVoid", + "type" : +"writeToBiSignal# + :: HasCallStack -- ARG[0] + => BiSignalIn ds d n -- ARG[1] + -> Signal d (Maybe (BitVector n)) -- ARG[2] + -> Signal d Bool -- ARG[3] + -> Signal d (BitVector n) -- ARG[4] + -> BiSignalOut ds d n", + "template": +"-- writeToBiSignal# begin +~ARG[1] <= ~ARG[4] when ~ARG[3] else (~SIZE[~TYP[1]]-1 downto 0 => 'Z'); +-- writeToBiSignal# end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.BiSignal.readFromBiSignal#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"readFromBiSignal# + :: ( HasCallStack -- ARG[0] + , KnownNat n) -- ARG[1] + => BiSignalIn ds d n -- ARG[2] + -> Signal d (BitVector n)" + , "template" : +"-- readFromBiSignal begin +~RESULT <= ~ARG[2]; +-- readFromBiSignal end" + } + } +] diff --git a/prims/vhdl/Clash_Signal_Internal.json b/prims/vhdl/Clash_Signal_Internal.json deleted file mode 100644 --- a/prims/vhdl/Clash_Signal_Internal.json +++ /dev/null @@ -1,197 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Signal.Internal.delay#" - , "kind" : "Declaration" - , "type" : -"delay# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Enable dom -- ARG[3] - -> a -- ARG[4] - -> Signal clk a -- ARG[5] - -> Signal clk a" - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } - , "template" : -"-- delay begin~IF ~ISACTIVEENABLE[3] ~THEN -~GENSYM[~RESULT_delay][4] : process(~ARG[2]) -begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - if ~ARG[3] then - ~RESULT <= ~ARG[5]; - end if; - end if; -end process;~ELSE -~SYM[4] : process(~ARG[2]) -begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - ~RESULT <= ~ARG[5]; - end if; -end process;~FI --- delay end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.register#" - , "kind" : "Declaration" - , "type" : -"register# - :: ( KnownDomain dom -- ARG[0] - , Undefined a ) -- ARG[1] - => Clock dom -- ARG[2] - -> Reset dom -- ARG[3] - -> Enable dom -- ARG[4] - -> a -- ARG[5] (powerup value) - -> a -- ARG[6] (reset value) - -> Signal clk a -- ARG[7] - -> Signal clk a" - , "resultName" : { "template" : "~CTXNAME" } - , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } - , "template" : -"-- register begin~IF ~ISACTIVEENABLE[4] ~THEN ~IF ~ISSYNC[0] ~THEN -~GENSYM[~RESULT_register][2] : process(~ARG[2]) -begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - if ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then - ~RESULT <= ~CONST[6]; - elsif ~ARG[4] then - ~RESULT <= ~ARG[7]; - end if; - end if; -end process;~ELSE -~SYM[2] : process(~ARG[2],~ARG[3]) -begin - if ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then - ~RESULT <= ~CONST[6]; - elsif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - if ~ARG[4] then - ~RESULT <= ~ARG[7]; - end if; - end if; -end process;~FI~ELSE ~IF ~ISSYNC[0] ~THEN -~SYM[2] : process(~ARG[2]) -begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - if ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then - ~RESULT <= ~CONST[6]; - else - ~RESULT <= ~ARG[7]; - end if; - end if; -end process;~ELSE -~SYM[2] : process(~ARG[2],~ARG[3]) -begin - if ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then - ~RESULT <= ~CONST[6]; - elsif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - ~RESULT <= ~ARG[7]; - end if; -end process;~FI~FI --- register end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.clockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" - , "type" : -"clockGen - :: KnownDomain dom -- ARG[0] - => Clock dom" - , "comment" : - "ModelSim and Vivado seem to round time values to an integer number of picoseconds. - Use two half periods to prevent rounding errors from affecting the full period." - , "template" : -"-- clockGen begin --- pragma translate_off -~GENSYM[clkGen][0] : process is - constant ~GENSYM[half_periodH][1] : time := ~PERIOD[0]000 fs / 2; - constant ~GENSYM[half_periodL][2] : time := ~PERIOD[0]000 fs - ~SYM[1]; -begin - ~RESULT <= ~IF~ACTIVEEDGE[Rising][0]~THEN'0'~ELSE'1'~FI; - wait for 3000 ps; - loop - ~RESULT <= not ~RESULT; - wait for ~SYM[1]; - ~RESULT <= not ~RESULT; - wait for ~SYM[2]; - end loop; - wait; -end process; --- pragma translate_on --- clockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.tbClockGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" - , "type" : -"tbClockGen - :: KnownDomain dom -- ARG[0] - => Signal dom Bool -- ARG[1] - -> Clock dom" - , "template" : -"-- tbClockGen begin --- pragma translate_off -~GENSYM[clkGen][0] : process is - constant ~GENSYM[half_periodH][1] : time := ~PERIOD[0]000 fs / 2; - constant ~GENSYM[half_periodL][2] : time := ~PERIOD[0]000 fs - ~SYM[1]; -begin - ~RESULT <= ~IF~ACTIVEEDGE[Rising][0]~THEN'0'~ELSE'1'~FI; - wait for 3000 ps; - while ~ARG[1] loop - ~RESULT <= not ~RESULT; - wait for ~SYM[1]; - ~RESULT <= not ~RESULT; - wait for ~SYM[2]; - end loop; - wait; -end process; --- pragma translate_on --- tbClockGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.resetGenN" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" - , "template" : -"-- resetGen begin --- pragma translate_off -~RESULT <= ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI, - ~IF ~ISACTIVEHIGH[0] ~THEN '0' ~ELSE '1' ~FI after ~IF~ISSYNC[0]~THEN(2999 ps + (integer'(~LIT[2]) * ~PERIOD[0] ps))~ELSE(3001 ps + integer'(~LIT[2] - 1) * ~PERIOD[0] ps)~FI; --- pragma translate_on --- resetGen end" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.unsafeFromReset" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"unsafeFromReset :: Reset dom -> Signal dom Bool" - , "template" : "~RESULT <= true when ~ARG[0] = '1' else false;" - } - } -, { "BlackBox" : - { "name" : "Clash.Signal.Internal.unsafeToReset" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"unsafeToReset :: Signal dom Bool -> Reset dom" - , "template" : "~RESULT <= '1' when ~ARG[0] = true else '0';" - } - } -, { "BlackBox" : - { "name" : "Clash.Explicit.Testbench.tbEnableGen" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : "tbEnableGen :: Enable dom" - , "template" : "~RESULT <= true;" - } - } -] diff --git a/prims/vhdl/Clash_Signal_Internal.primitives b/prims/vhdl/Clash_Signal_Internal.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Signal_Internal.primitives @@ -0,0 +1,232 @@ +[ { "BlackBox" : + { "name" : "Clash.Signal.Internal.delay#" + , "kind" : "Declaration" + , "type" : +"delay# + :: ( KnownDomain dom -- ARG[0] + , Undefined a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Enable dom -- ARG[3] + -> a -- ARG[4] + -> Signal clk a -- ARG[5] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI" } + , "template" : +"-- delay begin~IF ~ISACTIVEENABLE[3] ~THEN +~GENSYM[~RESULT_delay][4] : process(~ARG[2]) +begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~ARG[3] then + ~RESULT <= ~ARG[5]; + end if; + end if; +end process;~ELSE +~SYM[4] : process(~ARG[2]) +begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~RESULT <= ~ARG[5]; + end if; +end process;~FI +-- delay end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.asyncRegister#" + , "kind" : "Declaration" + , "type" : +"asyncRegister# + :: ( KnownDomain dom -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"-- async register begin +~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) +begin + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~RESULT <= ~CONST[6]; + els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~IF ~ISACTIVEENABLE[4] ~THEN + if ~ARG[4] then + ~RESULT <= ~ARG[7]; + end if; + ~ELSE + ~RESULT <= ~ARG[7]; + ~FI + end if; +end process; +-- async register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.register#" + , "kind" : "Declaration" + , "type" : +"register# + :: ( KnownDomain dom -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- ARG[2] + -> Reset dom -- ARG[3] + -> Enable dom -- ARG[4] + -> a -- ARG[5] (powerup value) + -> a -- ARG[6] (reset value) + -> Signal clk a -- ARG[7] + -> Signal clk a" + , "resultName" : { "template" : "~CTXNAME" } + , "resultInit" : { "template" : "~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI" } + , "template" : +"-- register begin~IF ~ISACTIVEENABLE[4] ~THEN ~IF ~ISSYNC[0] ~THEN +~GENSYM[~RESULT_register][2] : process(~ARG[2]) +begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~RESULT <= ~CONST[6]; + els~FIif ~ARG[4] then + ~RESULT <= ~ARG[7]; + end if; + end if; +end process;~ELSE +~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) +begin + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~RESULT <= ~CONST[6]; + els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~ARG[4] then + ~RESULT <= ~ARG[7]; + end if; + end if; +end process;~FI~ELSE ~IF ~ISSYNC[0] ~THEN +~SYM[2] : process(~ARG[2]) +begin + if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~RESULT <= ~CONST[6]; + else + ~FI~RESULT <= ~ARG[7]; + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEend if;~FI + end if; +end process;~ELSE +~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) +begin + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~RESULT <= ~CONST[6]; + els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~RESULT <= ~ARG[7]; + end if; +end process;~FI~FI +-- register end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.clockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.clockGen is not synthesizable!" + , "type" : +"clockGen + :: KnownDomain dom -- ARG[0] + => Clock dom" + , "comment" : + "ModelSim and Vivado seem to round time values to an integer number of picoseconds. + Use two half periods to prevent rounding errors from affecting the full period." + , "template" : +"-- clockGen begin +-- pragma translate_off +~GENSYM[clkGen][0] : process is + constant ~GENSYM[half_periodH][1] : time := ~PERIOD[0]000 fs / 2; + constant ~GENSYM[half_periodL][2] : time := ~PERIOD[0]000 fs - ~SYM[1]; +begin + ~RESULT <= ~IF~ACTIVEEDGE[Rising][0]~THEN'0'~ELSE'1'~FI; + wait for 3000 ps; + loop + ~RESULT <= not ~RESULT; + wait for ~SYM[1]; + ~RESULT <= not ~RESULT; + wait for ~SYM[2]; + end loop; + wait; +end process; +-- pragma translate_on +-- clockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.tbClockGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "warning" : "Clash.Signal.Internal.tbClockGen is not synthesizable!" + , "type" : +"tbClockGen + :: KnownDomain dom -- ARG[0] + => Signal dom Bool -- ARG[1] + -> Clock dom" + , "template" : +"-- tbClockGen begin +-- pragma translate_off +~GENSYM[clkGen][0] : process is + constant ~GENSYM[half_periodH][1] : time := ~PERIOD[0]000 fs / 2; + constant ~GENSYM[half_periodL][2] : time := ~PERIOD[0]000 fs - ~SYM[1]; +begin + ~RESULT <= ~IF~ACTIVEEDGE[Rising][0]~THEN'0'~ELSE'1'~FI; + wait for 3000 ps; + while ~ARG[1] loop + ~RESULT <= not ~RESULT; + wait for ~SYM[1]; + ~RESULT <= not ~RESULT; + wait for ~SYM[2]; + end loop; + wait; +end process; +-- pragma translate_on +-- tbClockGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.resetGenN" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : "resetGenN :: (KnownDomain dom, 1 <= n) => SNat n -> Reset dom" + , "template" : +"-- resetGen begin +-- pragma translate_off +~RESULT <= ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI, + ~IF ~ISACTIVEHIGH[0] ~THEN '0' ~ELSE '1' ~FI after ~IF~ISSYNC[0]~THEN(2999 ps + (integer'(~LIT[2]) * ~PERIOD[0] ps))~ELSE(3001 ps + integer'(~LIT[2] - 1) * ~PERIOD[0] ps)~FI; +-- pragma translate_on +-- resetGen end" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.unsafeFromReset" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"unsafeFromReset :: Reset dom -> Signal dom Bool" + , "template" : "~RESULT <= true when ~ARG[0] = '1' else false;" + } + } +, { "BlackBox" : + { "name" : "Clash.Signal.Internal.unsafeToReset" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"unsafeToReset :: Signal dom Bool -> Reset dom" + , "template" : "~RESULT <= '1' when ~ARG[0] = true else '0';" + } + } +, { "BlackBox" : + { "name" : "Clash.Explicit.Testbench.tbEnableGen" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : "tbEnableGen :: Enable dom" + , "template" : "~RESULT <= true;" + } + } +] diff --git a/prims/vhdl/Clash_Sized_Internal_BitVector.json b/prims/vhdl/Clash_Sized_Internal_BitVector.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_Internal_BitVector.json +++ /dev/null @@ -1,565 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.BV" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "BV :: Integer -> Integer -> BitVector n" - , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BITVECTOR INTERNALS" - , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.Bit" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Bit :: Integer -> Integer -> BitVector n" - , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BIT INTERNALS" - , "template" : "~VAR[i][1][0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => BitVector n -> Int" - , "template" : "to_signed(~SIZE[~TYP[1]],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.maxIndex#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxIndex# :: KnownNat n => BitVector n -> Int" - , "template" : "to_signed(~SIZE[~TYP[1]] - 1,~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.high" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "high :: Bit" - , "template" : "'1'" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.low" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "low :: Bit" - , "template" : "'0'" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Bit -> BitVector 1" - , "template" : "std_logic_vector'(0 => ~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: BitVector 1 -> Bit" - , "template" : "~VAR[bv][0](0)" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.eq##" - , "kind" : "Expression" - , "type" : "eq## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.neq##" - , "kind" : "Expression" - , "type" : "neq## :: Bit -> Bit -> Bool" - , "template" : "~ARG[0] /= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.fromInteger##" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger## :: Integer -> Integer -> Bit" - , "template" : "~IF~LIT[0]~THEN'U'~ELSE~ARG[1](0)~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.and##" - , "kind" : "Expression" - , "type" : "and## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.or##" - , "kind" : "Expression" - , "type" : "or## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.xor##" - , "kind" : "Expression" - , "type" : "xor## :: Bit -> Bit -> Bit" - , "template" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.complement##" - , "kind" : "Expression" - , "type" : "complement## :: Bit -> Bit" - , "template" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.++#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)" - , "template" : "~IF~AND[~SIZE[~TYP[1]],~SIZE[~TYP[2]]]~THENstd_logic_vector'(std_logic_vector'(~ARG[1]) & std_logic_vector'(~ARG[2]))~ELSE~IF~SIZE[~TYP[1]]~THENstd_logic_vector'(~ARG[1])~ELSEstd_logic_vector'(~ARG[2])~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceAnd#" - , "kind" : "Declaration" - , "type" : "reduceAnd# :: KnownNat n => BitVector n -> Bit" - , "template" : -"-- reduceAnd begin, -~IF~SIZE[~TYP[1]]~THEN -~GENSYM[reduceAnd][0] : block - function and_reduce (arg : std_logic_vector) return std_logic is - variable upper, lower : std_logic; - variable half : integer; - variable argi : std_logic_vector (arg'length - 1 downto 0); - variable result : std_logic; - begin - if (arg'length < 1) then - result := '1'; - else - argi := arg; - if (argi'length = 1) then - result := argi(argi'left); - else - half := (argi'length + 1) / 2; -- lsb-biased tree - upper := and_reduce (argi (argi'left downto half)); - lower := and_reduce (argi (half - 1 downto argi'right)); - result := upper and lower; - end if; - end if; - return result; - end; -begin - ~RESULT <= and_reduce(~ARG[1]); -end block;~ELSE -~RESULT <= '1';~FI --- reduceAnd end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceOr#" - , "kind" : "Declaration" - , "type" : "reduceOr# :: KnownNat n => BitVector n -> Bit" - , "template" : -"-- reduceOr begin ~IF~SIZE[~TYP[1]]~THEN -~GENSYM[reduceOr][0] : block - function or_reduce (arg : std_logic_vector) return std_logic is - variable upper, lower : std_logic; - variable half : integer; - variable argi : std_logic_vector (arg'length - 1 downto 0); - variable result : std_logic; - begin - if (arg'length < 1) then - result := '0'; - else - argi := arg; - if (argi'length = 1) then - result := argi(argi'left); - else - half := (argi'length + 1) / 2; -- lsb-biased tree - upper := or_reduce (argi (argi'left downto half)); - lower := or_reduce (argi (half - 1 downto argi'right)); - result := upper or lower; - end if; - end if; - return result; - end; -begin - ~RESULT <= or_reduce(~ARG[1]); -end block;~ELSE -~RESULT <= '0'; ~FI --- reduceOr end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.reduceXor#" - , "kind" : "Declaration" - , "type" : "reduceXor# :: KnownNat n => BitVector n -> Bit" - , "template" : -"-- reduceXor begin ~IF~SIZE[~TYP[1]]~THEN -~GENSYM[reduceXor][0] : block - function xor_reduce (arg : std_logic_vector) return std_logic is - variable upper, lower : std_logic; - variable half : integer; - variable argi : std_logic_vector (arg'length - 1 downto 0); - variable result : std_logic; - begin - if (arg'length < 1) then - result := '0'; - else - argi := arg; - if (argi'length = 1) then - result := argi(argi'left); - else - half := (argi'length + 1) / 2; -- lsb-biased tree - upper := xor_reduce (argi (argi'left downto half)); - lower := xor_reduce (argi (half - 1 downto argi'right)); - result := upper xor lower; - end if; - end if; - return result; - end; -begin - ~RESULT <= xor_reduce(~ARG[1]); -end block;~ELSE -~RESULT <= '0';~FI --- reduceXor end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.index#" - , "kind" : "Declaration" - , "type" : -"index# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Int -- ARG[2] - -> Bit" - , "template" : -"-- indexBitVector begin ~IF~SIZE[~TYP[1]]~THEN~IF ~ISVAR[1] ~THEN -~GENSYM[indexBitVector][0] : block - signal ~GENSYM[vec_index][1] : integer range 0 to ~SIZE[~TYP[1]]-1; -begin - ~SYM[1] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~SIZE[~TYP[1]] - -- pragma translate_on - ; - - ~RESULT <= ~ARG[1](~SYM[1]); -end block;~ELSE -~SYM[0] : block - signal ~SYM[1] : integer range 0 to ~SIZE[~TYP[1]]-1; -begin - ~SYM[1] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~SIZE[~TYP[1]] - -- pragma translate_on - ; - - ~RESULT <= ~VAR[bv][1](~SYM[1]); -end block;~FI~ELSE -~RESULT <= ~ERRORO;~FI --- indexBitVector end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" - , "kind" : "Declaration" - , "type" : -"replaceBit# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Int -- ARG[2] - -> Bit -- ARG[3] - -> BitVector n" - , "template" : -"-- replaceBit begin ~IF~SIZE[~TYP[1]]~THEN -~GENSYM[replaceBit][0] : block - signal ~GENSYM[vec_index][1] : integer range 0 to ~SIZE[~TYP[1]]-1; -begin - ~SYM[1] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~SIZE[~TYP[1]] - -- pragma translate_on - ; - - process(~SYM[1],~VAR[b][3]~VARS[1]) - variable ~GENSYM[ivec][2] : ~TYP[1]; - begin - ~SYM[2] := ~ARG[1]; - ~SYM[2](~SYM[1]) := ~ARG[3]; - ~RESULT <= ~SYM[2]; - end process; -end block; ~ELSE -~RESULT <= ~ERRORO;~FI --- replaceBit end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.setSlice#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"setSlice# :: SNat (m + 1 + i) - => BitVector (m + 1 + i) -- ARG[1] - -> SNat m -- ARG[2] - -> SNat n -- ARG[3] - -> BitVector (m + 1 - n) -- ARG[4] - -> BitVector (m + 1 + i)" - , "template" : -"-- setSlice begin -~GENSYM[setSlice][0] : process(~VAR[bv][0]~VARS[4]) - variable ~GENSYM[ivec][1] : ~TYP[0]; -begin - ~SYM[1] := ~ARG[1]; - ~SYM[1](~LIT[2] downto ~LIT[3]) := ~VAR[bv][4]; - ~RESULT <= ~SYM[1]; -end process; --- setSlice end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.slice#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"slice# :: BitVector (m + 1 + i) -- ARG[0] - -> SNat m -- ARG[1] - -> SNat n -- ARG[2] - -> BitVector (m + 1 - n)" - , "template" : "~VAR[bv][0](~LIT[1] downto ~LIT[2])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.split#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"split# :: KnownNat n -- ARG[0] - => BitVector (m + n) -- ARG[1] - -> (BitVector m, BitVector n)" - , "template" : "(~VAR[bv][1](~VAR[bv][1]'high downto ~LIT[0]),~VAR[bv][1](~LIT[0]-1 downto 0))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.msb#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"msb# :: KnownNat n -- ARG[0] - => BitVector n -- ARG[1] - -> Bit" - , "template" : "~IF ~SIZE[~TYP[1]] ~THEN ~VAR[bv][1](~VAR[bv][1]'high) ~ELSE \"0\" ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.lsb#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : -"lsb# :: BitVector n -- ARG[0] - -> Bit" - , "template" : "~IF ~SIZE[~TYP[0]] ~THEN ~VAR[bv][0](0) ~ELSE \"0\" ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.eq#" - , "kind" : "Expression" - , "type" : "eq# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] = ~ARG[2]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.neq#" - , "kind" : "Expression" - , "type" : "neq# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] /= ~ARG[2]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.lt#" - , "kind" : "Expression" - , "type" : "lt# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] < ~ARG[2]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.ge#" - , "kind" : "Expression" - , "type" : "ge# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] >= ~ARG[2]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.gt#" - , "kind" : "Expression" - , "type" : "gt# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] > ~ARG[2]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.le#" - , "kind" : "Expression" - , "type" : "le# :: KnownNat n => BitVector n -> BitVector n -> Bool" - , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] <= ~ARG[2]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: BitVector n" - , "template" : "~IF~SIZE[~TYPO]~THENstd_logic_vector'(~SIZE[~TYPO]-1 downto 0 => '0')~ELSEstd_logic_vector'(0 downto 1 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => BitVector n" - , "template" : "~IF~SIZE[~TYPO]~THENstd_logic_vector'(~SIZE[~TYPO]-1 downto 0 => '1')~ELSEstd_logic_vector'(0 downto 1 => '1')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "std_logic_vector(unsigned(~ARG[1]) + unsigned(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "std_logic_vector(unsigned(~ARG[1]) - unsigned(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "std_logic_vector(resize(unsigned(~ARG[1]) * unsigned(~ARG[2]), ~SIZE[~TYP[1]]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => BitVector n -> BitVector n" - , "template" : "std_logic_vector(-(signed(~ARG[1])))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Integer -> BitVector n" - , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[2])),~SIZE[~TYPO]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.plus#" - , "kind" : "Expression" - , "type" : "plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]) + resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~ELSE~IF~SIZE[~TYP[2]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]))~ELSEstd_logic_vector(resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.minus#" - , "kind" : "Expression" - , "type" : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" - , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]) - resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~ELSE~IF~SIZE[~TYP[2]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]))~ELSEstd_logic_vector(-resize(signed(~ARG[3]),~SIZE[~TYPO]))~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.times#" - , "kind" : "Expression" - , "type" : "times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n)" - , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(unsigned(~ARG[2]) * unsigned(~ARG[3]))~ELSE(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.quot#" - , "kind" : "Expression" - , "type" : "quot# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "std_logic_vector(unsigned(~ARG[1]) / unsigned(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rem#" - , "kind" : "Expression" - , "type" : "rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "std_logic_vector(unsigned(~ARG[1]) rem unsigned(~ARG[2]))" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.BitVector.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.bvToIntegerVHDL" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.and#" - , "kind" : "Expression" - , "type" : "and# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] and ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.or#" - , "kind" : "Expression" - , "type" : "or# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] or ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.xor#" - , "kind" : "Expression" - , "type" : "xor# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" - , "template" : "~ARG[1] xor ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => BitVector n -> BitVector n" - , "template" : "not ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "std_logic_vector(shift_left(unsigned(~ARG[1]),to_integer(~ARG[2])))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "std_logic_vector(shift_right(unsigned(~ARG[1]),to_integer(~ARG[2])))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateL#" - , "kind" : "Expression" - , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "std_logic_vector(rotate_left(unsigned(~ARG[1]),to_integer(~ARG[2])))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.rotateR#" - , "kind" : "Expression" - , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" - , "template" : "std_logic_vector(rotate_right(unsigned(~ARG[1]),to_integer(~ARG[2])))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.BitVector.truncateB#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "truncateB# :: forall a b . KnownNat a => BitVector (a + b) -> BitVector a" - , "template" : "std_logic_vector(resize(unsigned(~ARG[1]),~SIZE[~TYPO]))" - } - } -] diff --git a/prims/vhdl/Clash_Sized_Internal_BitVector.primitives b/prims/vhdl/Clash_Sized_Internal_BitVector.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_Internal_BitVector.primitives @@ -0,0 +1,565 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.BV" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "BV :: Integer -> Integer -> BitVector n" + , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BITVECTOR INTERNALS" + , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.Bit" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Bit :: Integer -> Integer -> BitVector n" + , "comment" : "THIS IS ONLY USED WHEN WW EXPOSES BIT INTERNALS" + , "template" : "~VAR[i][1][0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => BitVector n -> Int" + , "template" : "to_signed(~SIZE[~TYP[1]],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.maxIndex#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxIndex# :: KnownNat n => BitVector n -> Int" + , "template" : "to_signed(~SIZE[~TYP[1]] - 1,~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.high" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "high :: Bit" + , "template" : "'1'" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.low" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "low :: Bit" + , "template" : "'0'" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Bit -> BitVector 1" + , "template" : "std_logic_vector'(0 => ~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: BitVector 1 -> Bit" + , "template" : "~VAR[bv][0](0)" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.eq##" + , "kind" : "Expression" + , "type" : "eq## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.neq##" + , "kind" : "Expression" + , "type" : "neq## :: Bit -> Bit -> Bool" + , "template" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromInteger##" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger## :: Integer -> Integer -> Bit" + , "template" : "~IF~LIT[0]~THEN'U'~ELSE~ARG[1](0)~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.and##" + , "kind" : "Expression" + , "type" : "and## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.or##" + , "kind" : "Expression" + , "type" : "or## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.xor##" + , "kind" : "Expression" + , "type" : "xor## :: Bit -> Bit -> Bit" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.complement##" + , "kind" : "Expression" + , "type" : "complement## :: Bit -> Bit" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.++#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)" + , "template" : "~IF~AND[~SIZE[~TYP[1]],~SIZE[~TYP[2]]]~THENstd_logic_vector'(std_logic_vector'(~ARG[1]) & std_logic_vector'(~ARG[2]))~ELSE~IF~SIZE[~TYP[1]]~THENstd_logic_vector'(~ARG[1])~ELSEstd_logic_vector'(~ARG[2])~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceAnd#" + , "kind" : "Declaration" + , "type" : "reduceAnd# :: KnownNat n => BitVector n -> Bit" + , "template" : +"-- reduceAnd begin, +~IF~SIZE[~TYP[1]]~THEN +~GENSYM[reduceAnd][0] : block + function and_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '1'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := and_reduce (argi (argi'left downto half)); + lower := and_reduce (argi (half - 1 downto argi'right)); + result := upper and lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= and_reduce(~ARG[1]); +end block;~ELSE +~RESULT <= '1';~FI +-- reduceAnd end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceOr#" + , "kind" : "Declaration" + , "type" : "reduceOr# :: KnownNat n => BitVector n -> Bit" + , "template" : +"-- reduceOr begin ~IF~SIZE[~TYP[1]]~THEN +~GENSYM[reduceOr][0] : block + function or_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '0'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := or_reduce (argi (argi'left downto half)); + lower := or_reduce (argi (half - 1 downto argi'right)); + result := upper or lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= or_reduce(~ARG[1]); +end block;~ELSE +~RESULT <= '0'; ~FI +-- reduceOr end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.reduceXor#" + , "kind" : "Declaration" + , "type" : "reduceXor# :: KnownNat n => BitVector n -> Bit" + , "template" : +"-- reduceXor begin ~IF~SIZE[~TYP[1]]~THEN +~GENSYM[reduceXor][0] : block + function xor_reduce (arg : std_logic_vector) return std_logic is + variable upper, lower : std_logic; + variable half : integer; + variable argi : std_logic_vector (arg'length - 1 downto 0); + variable result : std_logic; + begin + if (arg'length < 1) then + result := '0'; + else + argi := arg; + if (argi'length = 1) then + result := argi(argi'left); + else + half := (argi'length + 1) / 2; -- lsb-biased tree + upper := xor_reduce (argi (argi'left downto half)); + lower := xor_reduce (argi (half - 1 downto argi'right)); + result := upper xor lower; + end if; + end if; + return result; + end; +begin + ~RESULT <= xor_reduce(~ARG[1]); +end block;~ELSE +~RESULT <= '0';~FI +-- reduceXor end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.index#" + , "kind" : "Declaration" + , "type" : +"index# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit" + , "template" : +"-- indexBitVector begin ~IF~SIZE[~TYP[1]]~THEN~IF ~ISVAR[1] ~THEN +~GENSYM[indexBitVector][0] : block + signal ~GENSYM[vec_index][1] : integer range 0 to ~SIZE[~TYP[1]]-1; +begin + ~SYM[1] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~SIZE[~TYP[1]] + -- pragma translate_on + ; + + ~RESULT <= ~ARG[1](~SYM[1]); +end block;~ELSE +~SYM[0] : block + signal ~SYM[1] : integer range 0 to ~SIZE[~TYP[1]]-1; +begin + ~SYM[1] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~SIZE[~TYP[1]] + -- pragma translate_on + ; + + ~RESULT <= ~VAR[bv][1](~SYM[1]); +end block;~FI~ELSE +~RESULT <= ~ERRORO;~FI +-- indexBitVector end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.replaceBit#" + , "kind" : "Declaration" + , "type" : +"replaceBit# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Int -- ARG[2] + -> Bit -- ARG[3] + -> BitVector n" + , "template" : +"-- replaceBit begin ~IF~SIZE[~TYP[1]]~THEN +~GENSYM[replaceBit][0] : block + signal ~GENSYM[vec_index][1] : integer range 0 to ~SIZE[~TYP[1]]-1; +begin + ~SYM[1] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~SIZE[~TYP[1]] + -- pragma translate_on + ; + + process(~SYM[1],~VAR[b][3]~VARS[1]) + variable ~GENSYM[ivec][2] : ~TYP[1]; + begin + ~SYM[2] := ~ARG[1]; + ~SYM[2](~SYM[1]) := ~ARG[3]; + ~RESULT <= ~SYM[2]; + end process; +end block; ~ELSE +~RESULT <= ~ERRORO;~FI +-- replaceBit end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.setSlice#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"setSlice# :: SNat (m + 1 + i) + => BitVector (m + 1 + i) -- ARG[1] + -> SNat m -- ARG[2] + -> SNat n -- ARG[3] + -> BitVector (m + 1 - n) -- ARG[4] + -> BitVector (m + 1 + i)" + , "template" : +"-- setSlice begin +~GENSYM[setSlice][0] : process(~VAR[bv][0]~VARS[4]) + variable ~GENSYM[ivec][1] : ~TYP[0]; +begin + ~SYM[1] := ~ARG[1]; + ~SYM[1](~LIT[2] downto ~LIT[3]) := ~VAR[bv][4]; + ~RESULT <= ~SYM[1]; +end process; +-- setSlice end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.slice#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"slice# :: BitVector (m + 1 + i) -- ARG[0] + -> SNat m -- ARG[1] + -> SNat n -- ARG[2] + -> BitVector (m + 1 - n)" + , "template" : "~VAR[bv][0](~LIT[1] downto ~LIT[2])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.split#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"split# :: KnownNat n -- ARG[0] + => BitVector (m + n) -- ARG[1] + -> (BitVector m, BitVector n)" + , "template" : "(~VAR[bv][1](~VAR[bv][1]'high downto ~LIT[0]),~VAR[bv][1](~LIT[0]-1 downto 0))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.msb#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"msb# :: KnownNat n -- ARG[0] + => BitVector n -- ARG[1] + -> Bit" + , "template" : "~IF ~SIZE[~TYP[1]] ~THEN ~VAR[bv][1](~VAR[bv][1]'high) ~ELSE \"0\" ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.lsb#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : +"lsb# :: BitVector n -- ARG[0] + -> Bit" + , "template" : "~IF ~SIZE[~TYP[0]] ~THEN ~VAR[bv][0](0) ~ELSE \"0\" ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.eq#" + , "kind" : "Expression" + , "type" : "eq# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] = ~ARG[2]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.neq#" + , "kind" : "Expression" + , "type" : "neq# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] /= ~ARG[2]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.lt#" + , "kind" : "Expression" + , "type" : "lt# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] < ~ARG[2]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.ge#" + , "kind" : "Expression" + , "type" : "ge# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] >= ~ARG[2]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.gt#" + , "kind" : "Expression" + , "type" : "gt# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] > ~ARG[2]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.le#" + , "kind" : "Expression" + , "type" : "le# :: KnownNat n => BitVector n -> BitVector n -> Bool" + , "template" : "~IF~SIZE[~TYP[1]]~THEN~ARG[1] <= ~ARG[2]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: BitVector n" + , "template" : "~IF~SIZE[~TYPO]~THENstd_logic_vector'(~SIZE[~TYPO]-1 downto 0 => '0')~ELSEstd_logic_vector'(0 downto 1 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => BitVector n" + , "template" : "~IF~SIZE[~TYPO]~THENstd_logic_vector'(~SIZE[~TYPO]-1 downto 0 => '1')~ELSEstd_logic_vector'(0 downto 1 => '1')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "std_logic_vector(unsigned(~ARG[1]) + unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "std_logic_vector(unsigned(~ARG[1]) - unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "std_logic_vector(resize(unsigned(~ARG[1]) * unsigned(~ARG[2]), ~SIZE[~TYP[1]]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => BitVector n -> BitVector n" + , "template" : "std_logic_vector(-(signed(~ARG[1])))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Integer -> BitVector n" + , "template" : "std_logic_vector(resize(unsigned(std_logic_vector(~ARG[2])),~SIZE[~TYPO]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.plus#" + , "kind" : "Expression" + , "type" : "plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]) + resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~ELSE~IF~SIZE[~TYP[2]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]))~ELSEstd_logic_vector(resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.minus#" + , "kind" : "Expression" + , "type" : "minus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)" + , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]) - resize(unsigned(~ARG[3]),~SIZE[~TYPO]))~ELSE~IF~SIZE[~TYP[2]]~THENstd_logic_vector(resize(unsigned(~ARG[2]),~SIZE[~TYPO]))~ELSEstd_logic_vector(-resize(signed(~ARG[3]),~SIZE[~TYPO]))~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.times#" + , "kind" : "Expression" + , "type" : "times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n)" + , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENstd_logic_vector(unsigned(~ARG[2]) * unsigned(~ARG[3]))~ELSE(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.quot#" + , "kind" : "Expression" + , "type" : "quot# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "std_logic_vector(unsigned(~ARG[1]) / unsigned(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rem#" + , "kind" : "Expression" + , "type" : "rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "std_logic_vector(unsigned(~ARG[1]) rem unsigned(~ARG[2]))" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.BitVector.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.bvToIntegerVHDL" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.and#" + , "kind" : "Expression" + , "type" : "and# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] and ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.or#" + , "kind" : "Expression" + , "type" : "or# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] or ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.xor#" + , "kind" : "Expression" + , "type" : "xor# :: KnownNat n => BitVector n -> BitVector n -> BitVector n" + , "template" : "~ARG[1] xor ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => BitVector n -> BitVector n" + , "template" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "std_logic_vector(shift_left(unsigned(~ARG[1]),to_integer(~ARG[2])))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "std_logic_vector(shift_right(unsigned(~ARG[1]),to_integer(~ARG[2])))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateL#" + , "kind" : "Expression" + , "type" : "rotateL# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "std_logic_vector(rotate_left(unsigned(~ARG[1]),to_integer(~ARG[2])))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.rotateR#" + , "kind" : "Expression" + , "type" : "rotateR# :: KnownNat n => BitVector n -> Int -> BitVector n" + , "template" : "std_logic_vector(rotate_right(unsigned(~ARG[1]),to_integer(~ARG[2])))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.BitVector.truncateB#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "truncateB# :: forall a b . KnownNat a => BitVector (a + b) -> BitVector a" + , "template" : "std_logic_vector(resize(unsigned(~ARG[1]),~SIZE[~TYPO]))" + } + } +] diff --git a/prims/vhdl/Clash_Sized_Internal_Index.json b/prims/vhdl/Clash_Sized_Internal_Index.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_Internal_Index.json +++ /dev/null @@ -1,138 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Index n -> BitVector (CLog 2 n)" - , "template" : "std_logic_vector(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n" - , "template" : "unsigned(~ARG[2])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.le#" - , "kind" : "Expression" - , "type" : "le# :: Index n -> Index n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Index n" - , "template" : "to_unsigned(~LIT[0]-1,~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.+#" - , "kind" : "Expression" - , "type" : "(+#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "~ARG[1] + ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.-#" - , "kind" : "Expression" - , "type" : "(-#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "~ARG[1] - ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Index n -> Index n -> Index n" - , "template" : "resize(~ARG[1] * ~ARG[2], ~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Index n" - , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.plus#" - , "kind" : "Expression" - , "type" : "Index m -> Index n -> Index (m + n - 1)" - , "template" : "resize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.minus#" - , "kind" : "Expression" - , "type" : "Index m -> Index n -> Index (m + n - 1)" - , "template" : "resize(~ARG[0],~SIZE[~TYPO]) - resize(~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.times#" - , "kind" : "Expression" - , "type" : "Index m -> Index n -> Index (((m-1) * (n-1)) + 1)" - , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Index n -> Index n -> Index n" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Index.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.indexToIntegerVHDL" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Index.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: KnownNat m => Index n -> Index m" - , "template" : "~IF~SIZE[~TYP[1]]~THENresize(~ARG[1],~SIZE[~TYPO])~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -] diff --git a/prims/vhdl/Clash_Sized_Internal_Index.primitives b/prims/vhdl/Clash_Sized_Internal_Index.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_Internal_Index.primitives @@ -0,0 +1,138 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Index n -> BitVector (CLog 2 n)" + , "template" : "std_logic_vector(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n" + , "template" : "unsigned(~ARG[2])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.le#" + , "kind" : "Expression" + , "type" : "le# :: Index n -> Index n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Index n" + , "template" : "to_unsigned(~LIT[0]-1,~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.+#" + , "kind" : "Expression" + , "type" : "(+#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "~ARG[1] + ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.-#" + , "kind" : "Expression" + , "type" : "(-#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "~ARG[1] - ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Index n -> Index n -> Index n" + , "template" : "resize(~ARG[1] * ~ARG[2], ~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Index n" + , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.plus#" + , "kind" : "Expression" + , "type" : "Index m -> Index n -> Index (m + n - 1)" + , "template" : "resize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.minus#" + , "kind" : "Expression" + , "type" : "Index m -> Index n -> Index (m + n - 1)" + , "template" : "resize(~ARG[0],~SIZE[~TYPO]) - resize(~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.times#" + , "kind" : "Expression" + , "type" : "Index m -> Index n -> Index (((m-1) * (n-1)) + 1)" + , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Index n -> Index n -> Index n" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Index.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.indexToIntegerVHDL" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Index.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: KnownNat m => Index n -> Index m" + , "template" : "~IF~SIZE[~TYP[1]]~THENresize(~ARG[1],~SIZE[~TYPO])~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +] diff --git a/prims/vhdl/Clash_Sized_Internal_Signed.json b/prims/vhdl/Clash_Sized_Internal_Signed.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_Internal_Signed.json +++ /dev/null @@ -1,250 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => Signed n -> Int" - , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: KnownNat n => Signed n -> BitVector n" - , "template" : "std_logic_vector(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: KnownNat n => BitVector n -> Signed n" - , "template" : "signed(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.le#" - , "kind" : "Expression" - , "type" : "le# :: Signed n -> Signed n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: KnownNat n => Signed n" - , "comment" : "the quantification with signed gives the array an ascending index" - , "template" : "~IF~SIZE[~TYPO]~THENsigned'(0 => '1', 1 to ~LIT[0]-1 => '0')~ELSEsigned'(1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Signed n" - , "comment" : "the quantification with signed gives the array an ascending index" - , "template" : "~IF~SIZE[~TYPO]~THENsigned'(0 => '0', 1 to ~LIT[0]-1 => '1')~ELSEsigned'(1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => Signed n -> Signed n" - , "template" : "-~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.abs#" - , "kind" : "Expression" - , "type" : "abs# :: KnownNat n => Signed n -> Signed n" - , "template" : "abs ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)" - , "template" : "resize(~ARG[1],~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.plus#" - , "kind" : "Expression" - , "type" : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)" - , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(~ARG[1],~SIZE[~TYPO])~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.minus#" - , "kind" : "Expression" - , "type" : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)" - , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) - resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(- ~ARG[1],~SIZE[~TYPO])~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.times#" - , "kind" : "Expression" - , "type" : "times# :: Signed m -> Signed n -> Signed (m + n)" - , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSEsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Signed n -> Signed n -> Signed n" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.div#" - , "kind" : "Declaration" - , "type" : "div# :: Signed n -> Signed n -> Signed n" - , "template" : -"-- divSigned begin -~GENSYM[divSigned][0] : block - signal ~GENSYM[resultPos][1] : boolean; - signal ~GENSYM[dividerNeg][2] : boolean; - signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); - signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); -begin - ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); - ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; - ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); - ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; - ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); -end block; --- divSigned end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.mod#" - , "kind" : "Expression" - , "type" : "mod# :: Signed n -> Signed n -> Signed n" - , "template" : "~ARG[0] mod ~ARG[1]" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Signed.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.signedToIntegerVHDL" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.and#" - , "kind" : "Expression" - , "type" : "and# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] and ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.or#" - , "kind" : "Expression" - , "type" : "or# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] or ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.xor#" - , "kind" : "Expression" - , "type" : "xor# :: KnownNat n => Signed n -> Signed n -> Signed n" - , "template" : "~ARG[1] xor ~ARG[2]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => Signed n -> Signed n" - , "template" : "not ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "shift_left(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "shift_right(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateL#" - , "kind" : "Expression" - , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "rotate_left(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.rotateR#" - , "kind" : "Expression" - , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" - , "template" : "rotate_right(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m" - , "template" : "~IF~SIZE[~TYP[2]]~THENresize(~ARG[2],~LIT[1])~ELSEsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Signed.truncateB#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "truncateB# :: KnownNat m => Signed (n + m) -> Signed m" - , "template" : "~IF~SIZE[~TYPO]~THEN~VAR[s][1](~LIT[0]-1 downto 0)~ELSEsigned'(0 downto 1 => '0')~FI" - } - } -] diff --git a/prims/vhdl/Clash_Sized_Internal_Signed.primitives b/prims/vhdl/Clash_Sized_Internal_Signed.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_Internal_Signed.primitives @@ -0,0 +1,250 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => Signed n -> Int" + , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: KnownNat n => Signed n -> BitVector n" + , "template" : "std_logic_vector(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: KnownNat n => BitVector n -> Signed n" + , "template" : "signed(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.le#" + , "kind" : "Expression" + , "type" : "le# :: Signed n -> Signed n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: KnownNat n => Signed n" + , "comment" : "the quantification with signed gives the array an ascending index" + , "template" : "~IF~SIZE[~TYPO]~THENsigned'(0 => '1', 1 to ~LIT[0]-1 => '0')~ELSEsigned'(1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Signed n" + , "comment" : "the quantification with signed gives the array an ascending index" + , "template" : "~IF~SIZE[~TYPO]~THENsigned'(0 => '0', 1 to ~LIT[0]-1 => '1')~ELSEsigned'(1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => Signed n -> Signed n" + , "template" : "-~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.abs#" + , "kind" : "Expression" + , "type" : "abs# :: KnownNat n => Signed n -> Signed n" + , "template" : "abs ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)" + , "template" : "resize(~ARG[1],~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.plus#" + , "kind" : "Expression" + , "type" : "plus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(~ARG[1],~SIZE[~TYPO])~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.minus#" + , "kind" : "Expression" + , "type" : "minus# :: Signed m -> Signed n -> Signed (1 + Max m n)" + , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) - resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(- ~ARG[1],~SIZE[~TYPO])~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.times#" + , "kind" : "Expression" + , "type" : "times# :: Signed m -> Signed n -> Signed (m + n)" + , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSEsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Signed n -> Signed n -> Signed n" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.div#" + , "kind" : "Declaration" + , "type" : "div# :: Signed n -> Signed n -> Signed n" + , "template" : +"-- divSigned begin +~GENSYM[divSigned][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); +end block; +-- divSigned end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.mod#" + , "kind" : "Expression" + , "type" : "mod# :: Signed n -> Signed n -> Signed n" + , "template" : "~ARG[0] mod ~ARG[1]" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Signed.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.signedToIntegerVHDL" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.and#" + , "kind" : "Expression" + , "type" : "and# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] and ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.or#" + , "kind" : "Expression" + , "type" : "or# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] or ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.xor#" + , "kind" : "Expression" + , "type" : "xor# :: KnownNat n => Signed n -> Signed n -> Signed n" + , "template" : "~ARG[1] xor ~ARG[2]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => Signed n -> Signed n" + , "template" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "shift_left(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "shift_right(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateL#" + , "kind" : "Expression" + , "type" : "rotateL# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "rotate_left(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.rotateR#" + , "kind" : "Expression" + , "type" : "rotateR# :: KnownNat n => Signed n -> Int -> Signed n" + , "template" : "rotate_right(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m" + , "template" : "~IF~SIZE[~TYP[2]]~THENresize(~ARG[2],~LIT[1])~ELSEsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Signed.truncateB#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "truncateB# :: KnownNat m => Signed (n + m) -> Signed m" + , "template" : "~IF~SIZE[~TYPO]~THEN~VAR[s][1](~LIT[0]-1 downto 0)~ELSEsigned'(0 downto 1 => '0')~FI" + } + } +] diff --git a/prims/vhdl/Clash_Sized_Internal_Unsigned.json b/prims/vhdl/Clash_Sized_Internal_Unsigned.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_Internal_Unsigned.json +++ /dev/null @@ -1,203 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.size#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "size# :: KnownNat n => Unsigned n -> Int" - , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.pack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "pack# :: Unsigned n -> BitVector n" - , "template" : "std_logic_vector(~ARG[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.unpack#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "unpack# :: KnownNat n => BitVector n -> Unsigned n" - , "template" : "unsigned(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.eq#" - , "kind" : "Expression" - , "type" : "eq# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.neq#" - , "kind" : "Expression" - , "type" : "neq# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.lt#" - , "kind" : "Expression" - , "type" : "lt# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.ge#" - , "kind" : "Expression" - , "type" : "ge# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.gt#" - , "kind" : "Expression" - , "type" : "gt# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.le#" - , "kind" : "Expression" - , "type" : "le# :: Unsigned n -> Unsigned n -> Bool" - , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.minBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "minBound# :: Unsigned n" - , "template" : "~IF~SIZE[~TYPO]~THENunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~ELSEunsigned'(0 downto 1 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.maxBound#" - , "workInfo" : "Constant" - , "kind" : "Expression" - , "type" : "maxBound# :: KnownNat n => Unsigned n" - , "template" : "~IF~SIZE[~TYPO]~THENunsigned'(~LIT[0]-1 downto 0 => '1')~ELSEunsigned'(0 downto 1 => '1')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.*#" - , "kind" : "Expression" - , "type" : "(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.negate#" - , "kind" : "Expression" - , "type" : "negate# :: KnownNat n => Unsigned n -> Unsigned n" - , "template" : "unsigned(std_logic_vector(-(signed(std_logic_vector(~ARG[1])))))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.fromInteger#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "fromInteger# :: KnownNat n => Integer -> Unsigned n" - , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~LIT[0])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.plus#" - , "kind" : "Expression" - , "type" : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(~ARG[1],~SIZE[~TYPO])~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.minus#" - , "kind" : "Expression" - , "type" : "minus# :: (KnownNat m,KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" - , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENresize(~ARG[2],~SIZE[~TYPO]) - resize(~ARG[3],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[2]]~THENresize(~ARG[2],~SIZE[~TYPO])~ELSEresize(~ARG[3],~SIZE[~TYPO])~FI~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.times#" - , "kind" : "Expression" - , "type" : "times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)" - , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rem#" - , "kind" : "Expression" - , "type" : "rem# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBoxHaskell" : - { "name" : "Clash.Sized.Internal.Unsigned.toInteger#" - , "workInfo" : "Never" - , "templateFunction" : "Clash.Primitives.Sized.ToInteger.unsignedToIntegerVHDL" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.and#" - , "kind" : "Expression" - , "type" : "and# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.or#" - , "kind" : "Expression" - , "type" : "or# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.xor#" - , "kind" : "Expression" - , "type" : "xor# :: Unsigned n -> Unsigned n -> Unsigned n" - , "template" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.complement#" - , "kind" : "Expression" - , "type" : "complement# :: KnownNat n => Unsigned n -> Unsigned n" - , "template" : "not ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.shiftL#" - , "kind" : "Expression" - , "type" : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "shift_left(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.shiftR#" - , "kind" : "Expression" - , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "shift_right(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" - , "kind" : "Expression" - , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "rotate_left(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" - , "kind" : "Expression" - , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" - , "template" : "rotate_right(~ARG[1],to_integer(~ARG[2]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Internal.Unsigned.resize#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "resize# :: KnownNat m => Unsigned n -> Unsigned m" - , "template" : "~IF~SIZE[~TYP[1]]~THENresize(~ARG[1],~LIT[0])~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" - } - } -] diff --git a/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives b/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_Internal_Unsigned.primitives @@ -0,0 +1,203 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.size#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "size# :: KnownNat n => Unsigned n -> Int" + , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.pack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "pack# :: Unsigned n -> BitVector n" + , "template" : "std_logic_vector(~ARG[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.unpack#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "unpack# :: KnownNat n => BitVector n -> Unsigned n" + , "template" : "unsigned(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.eq#" + , "kind" : "Expression" + , "type" : "eq# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] = ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.neq#" + , "kind" : "Expression" + , "type" : "neq# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] /= ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.lt#" + , "kind" : "Expression" + , "type" : "lt# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] < ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.ge#" + , "kind" : "Expression" + , "type" : "ge# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] >= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.gt#" + , "kind" : "Expression" + , "type" : "gt# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] > ~ARG[1]~ELSEfalse~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.le#" + , "kind" : "Expression" + , "type" : "le# :: Unsigned n -> Unsigned n -> Bool" + , "template" : "~IF~SIZE[~TYP[0]]~THEN~ARG[0] <= ~ARG[1]~ELSEtrue~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.minBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "minBound# :: Unsigned n" + , "template" : "~IF~SIZE[~TYPO]~THENunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~ELSEunsigned'(0 downto 1 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.maxBound#" + , "workInfo" : "Constant" + , "kind" : "Expression" + , "type" : "maxBound# :: KnownNat n => Unsigned n" + , "template" : "~IF~SIZE[~TYPO]~THENunsigned'(~LIT[0]-1 downto 0 => '1')~ELSEunsigned'(0 downto 1 => '1')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.*#" + , "kind" : "Expression" + , "type" : "(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.negate#" + , "kind" : "Expression" + , "type" : "negate# :: KnownNat n => Unsigned n -> Unsigned n" + , "template" : "unsigned(std_logic_vector(-(signed(std_logic_vector(~ARG[1])))))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.fromInteger#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "fromInteger# :: KnownNat n => Integer -> Unsigned n" + , "template" : "resize(unsigned(std_logic_vector(~ARG[1])),~LIT[0])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.plus#" + , "kind" : "Expression" + , "type" : "plus# :: Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THENresize(~ARG[0],~SIZE[~TYPO]) + resize(~ARG[1],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[0]]~THENresize(~ARG[0],~SIZE[~TYPO])~ELSEresize(~ARG[1],~SIZE[~TYPO])~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.minus#" + , "kind" : "Expression" + , "type" : "minus# :: (KnownNat m,KnownNat n) => Unsigned m -> Unsigned n -> Unsigned (1 + Max m n)" + , "template" : "~IF~AND[~SIZE[~TYP[2]],~SIZE[~TYP[3]]]~THENresize(~ARG[2],~SIZE[~TYPO]) - resize(~ARG[3],~SIZE[~TYPO])~ELSE~IF~SIZE[~TYP[2]]~THENresize(~ARG[2],~SIZE[~TYPO])~ELSEresize(~ARG[3],~SIZE[~TYPO])~FI~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.times#" + , "kind" : "Expression" + , "type" : "times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)" + , "template" : "~IF~AND[~SIZE[~TYP[0]],~SIZE[~TYP[1]]]~THEN~ARG[0] * ~ARG[1]~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rem#" + , "kind" : "Expression" + , "type" : "rem# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBoxHaskell" : + { "name" : "Clash.Sized.Internal.Unsigned.toInteger#" + , "workInfo" : "Never" + , "templateFunction" : "Clash.Primitives.Sized.ToInteger.unsignedToIntegerVHDL" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.and#" + , "kind" : "Expression" + , "type" : "and# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.or#" + , "kind" : "Expression" + , "type" : "or# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.xor#" + , "kind" : "Expression" + , "type" : "xor# :: Unsigned n -> Unsigned n -> Unsigned n" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.complement#" + , "kind" : "Expression" + , "type" : "complement# :: KnownNat n => Unsigned n -> Unsigned n" + , "template" : "not ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.shiftL#" + , "kind" : "Expression" + , "type" : "shiftL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "shift_left(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.shiftR#" + , "kind" : "Expression" + , "type" : "shiftR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "shift_right(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateL#" + , "kind" : "Expression" + , "type" : "rotateL# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "rotate_left(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.rotateR#" + , "kind" : "Expression" + , "type" : "rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n" + , "template" : "rotate_right(~ARG[1],to_integer(~ARG[2]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Internal.Unsigned.resize#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "resize# :: KnownNat m => Unsigned n -> Unsigned m" + , "template" : "~IF~SIZE[~TYP[1]]~THENresize(~ARG[1],~LIT[0])~ELSEunsigned'(~SIZE[~TYPO]-1 downto 0 => '0')~FI" + } + } +] diff --git a/prims/vhdl/Clash_Sized_RTree.json b/prims/vhdl/Clash_Sized_RTree.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_RTree.json +++ /dev/null @@ -1,25 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.RTree.treplicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat n -> a -> RTree d a" - , "template" : "~TYPMO'(0 to (2**~LIT[0])-1 => ~IF~VIVADO~THEN~TOBV[~ARG[1]][~TYP[1]]~ELSE~ARG[1]~FI)" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.textract" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "textract :: RTree 0 a -> a" - , "template" : "~IF ~VIVADO ~THEN ~FROMBV[~VAR[t][0](0)][~TYPO] ~ELSE ~VAR[t][0](0) ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.RTree.tsplit" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" - , "template" : "(~VAR[t][0](0 to (2**(~DEPTH[~TYP[0]]-1))-1) ,~VAR[t][0](2**(~DEPTH[~TYP[0]]-1) to (2**~DEPTH[~TYP[0]])-1))" - } - } -] diff --git a/prims/vhdl/Clash_Sized_RTree.primitives b/prims/vhdl/Clash_Sized_RTree.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_RTree.primitives @@ -0,0 +1,25 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.RTree.treplicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat n -> a -> RTree d a" + , "template" : "~TYPMO'(0 to (2**~LIT[0])-1 => ~IF~VIVADO~THEN~TOBV[~ARG[1]][~TYP[1]]~ELSE~ARG[1]~FI)" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.textract" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "textract :: RTree 0 a -> a" + , "template" : "~IF ~VIVADO ~THEN ~FROMBV[~VAR[t][0](0)][~TYPO] ~ELSE ~VAR[t][0](0) ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.RTree.tsplit" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tsplit:: RTree (d+1) a -> (RTree d a,RTree d a)" + , "template" : "(~VAR[t][0](0 to (2**(~DEPTH[~TYP[0]]-1))-1) ,~VAR[t][0](2**(~DEPTH[~TYP[0]]-1) to (2**~DEPTH[~TYP[0]])-1))" + } + } +] diff --git a/prims/vhdl/Clash_Sized_Vector.json b/prims/vhdl/Clash_Sized_Vector.json deleted file mode 100644 --- a/prims/vhdl/Clash_Sized_Vector.json +++ /dev/null @@ -1,444 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Sized.Vector.head" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "head :: Vec (n + 1) a -> a" - , "template" : "~IF ~VIVADO ~THEN ~TYPMO'(fromSLV(~VAR[vec][0](0))) ~ELSE ~VAR[vec][0](0) ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.tail" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "tail :: Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0](1 to ~VAR[vec][0]'high)" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.last" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> a" - , "template" : "~IF ~VIVADO ~THEN ~TYPMO'(fromSLV(~VAR[vec][0](~VAR[vec][0]'high))) ~ELSE ~VAR[vec][0](~VAR[vec][0]'high) ~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.init" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "Vec (n + 1) a -> Vec n a" - , "template" : "~VAR[vec][0](0 to ~VAR[vec][0]'high - 1)" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.select" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] - => SNat f -- ARG[1] - -> SNat s -- ARG[2] - -> SNat n -- ARG[3] - -> Vec i a -- ARG[4] - -> Vec n a" - , "template" : -"-- select begin -~GENSYM[select][0] : for ~GENSYM[i][1] in ~RESULT'range generate - ~RESULT(~SYM[1]) <= ~VAR[vec][4](~LIT[1]+(~LIT[2]*~SYM[1])); -end generate; --- select end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.++" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" - , "template" : "~TYPMO'(~TYPM[0]'(~ARG[0]) & ~TYPM[1]'(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concat" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" - , "template" : -"-- concat begin -~GENSYM[concat][0] : for ~GENSYM[i][1] in 0 to (~LENGTH[~TYP[0]] - 1) generate -begin~IF ~VIVADO ~THEN -~RESULT(~SYM[1] * ~LENGTH[~TYPEL[~TYP[0]]] to ((~SYM[1]+1) * ~LENGTH[~TYPEL[~TYP[0]]]) - 1) <= fromSLV(~VAR[vec][0](~SYM[1]));~ELSE -~RESULT(~SYM[1] * ~LENGTH[~TYPEL[~TYP[0]]] to ((~SYM[1]+1) * ~LENGTH[~TYPEL[~TYP[0]]]) - 1) <= ~VAR[vec][0](~SYM[1]);~FI -end generate; --- concat end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.splitAt" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" - , "template" : "~IF~LENGTH[~TYPO]~THEN~ARG[1]~ELSE(~VAR[vec][1](0 to ~LIT[0]-1),~VAR[vec][1](~LIT[0] to ~VAR[vec][1]'high))~FI" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcat" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"unconcat :: KnownNat n -- ARG[0] - => SNat m -- ARG[1] - -> Vec (n * m) a -- ARG[2] - -> Vec n (Vec m a)" - , "template" : -"-- unconcat begin~DEVNULL[~ARG[0]] -~GENSYM[unconcat][0] : for ~GENSYM[i][2] in ~RESULT'range generate -begin~IF ~VIVADO ~THEN - ~RESULT(~SYM[2]) <= ~TOBV[~VAR[vec][2]((~SYM[2] * ~LIT[1]) to ((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1))][~TYPEL[~TYPO]];~ELSE - ~RESULT(~SYM[2]) <= ~VAR[vec][2]((~SYM[2] * ~LIT[1]) to ((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1));~FI -end generate; --- unconcat end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.map" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" - , "template" : -"-- map begin -~GENSYM[map][0] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[1]]~THEN - signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[1]];~ELSE ~FI - signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; -begin~IF~SIZE[~TYP[1]]~THEN - ~SYM[2] <= fromSLV(~VAR[vec][1](~SYM[1]));~ELSE ~FI - ~INST 0 - ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[1]]~ - ~INST - ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; -end generate;~ELSE -begin - ~INST 0 - ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~VAR[vec][1](~SYM[1])~ ~TYPEL[~TYP[1]]~ - ~INST -end generate;~FI --- map end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" - , "template" : -"-- imap begin -~GENSYM[imap][0] : block - function ~GENSYM[max][6] (l,r : in natural) return natural is - begin - if l > r then return l; - else return r; - end if; - end function; -begin - ~GENSYM[imap][5] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN - signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[2]];~ELSE ~FI - signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; - begin~IF~SIZE[~TYP[2]]~THEN - ~SYM[2] <= fromSLV(~VAR[vec][2](~SYM[1]));~ELSE ~FI - ~INST 1 - ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ - ~INPUT <= to_unsigned(~SYM[1],~SYM[6](1,integer(ceil(log2(real(~LIT[0]))))))~ ~INDEXTYPE[~LIT[0]]~ - ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[2]]~ - ~INST - ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; - end generate;~ELSE - begin - ~INST 1 - ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ - ~INPUT <= to_unsigned(~SYM[1],~SYM[6](1,integer(ceil(log2(real(~LIT[0]))))))~ ~INDEXTYPE[~LIT[0]]~ - ~INPUT <= ~VAR[vec][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ - ~INST - end generate;~FI -end block; --- imap end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.imap_go" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "imap_go :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" - , "template" : -"-- imap_go begin -~GENSYM[imap][5] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN - signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[2]];~ELSE ~FI - signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; - signal ~GENSYM[i2][4] : ~TYP[0]; -begin~IF~SIZE[~TYP[2]]~THEN - ~SYM[2] <= fromSLV(~VAR[vec][2](~SYM[1]));~ELSE ~FI - ~SYM[4] <= ~ARG[0] + to_unsigned(~SYM[1],~SIZE[~TYP[0]]); - ~INST 1 - ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[4]~ ~TYP[0]~ - ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[2]]~ - ~INST - ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; -end generate;~ELSE - signal ~SYM[4] : ~TYP[0]; -begin - ~SYM[4] <= ~ARG[0] + to_unsigned(~SYM[1],~SIZE[~TYP[0]]); - ~INST 1 - ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[4]~ ~TYP[0]~ - ~INPUT <= ~VAR[vec][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ - ~INST -end generate;~FI --- imap_go end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.zipWith" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" - , "template" : -"-- zipWith begin -~GENSYM[zipWith][0] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[1]]~THEN - signal ~GENSYM[zipWith_in1][2] : ~TYPEL[~TYP[1]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN - signal ~GENSYM[zipWith_in2][6] : ~TYPEL[~TYP[2]];~ELSE ~FI - signal ~GENSYM[zipWith_out][3] : ~TYPEL[~TYPO]; -begin~IF~SIZE[~TYP[1]]~THEN - ~SYM[2] <= fromSLV(~VAR[vec1][1](~SYM[1]));~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN - ~SYM[6] <= fromSLV(~VAR[vec2][2](~SYM[1]));~ELSE ~FI - ~INST 0 - ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ - ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~SYM[6]~ ~TYPEL[~TYP[2]]~ - ~INST - ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; -end generate;~ELSE -begin - ~INST 0 - ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ - ~INPUT <= ~VAR[vec1][1](~SYM[1])~ ~TYPEL[~TYP[1]]~ - ~INPUT <= ~VAR[vec2][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ - ~INST -end generate;~FI --- zipWith end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.foldr" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" - , "template" : -"-- foldr begin~IF ~LENGTH[~TYP[2]] ~THEN -~GENSYM[foldr][0] : block - type ~GENSYM[foldr_res_type][1] is array (natural range <>) of ~TYP[1]; - signal ~GENSYM[intermediate][2] : ~SYM[1] (0 to ~LENGTH[~TYP[2]]); -begin - ~SYM[2](~LENGTH[~TYP[2]]) <= ~ARG[1]; - - foldr_loop : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[2]] - 1) generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN - signal ~GENSYM[foldr_in][4] : ~TYPEL[~TYP[2]];~ELSE ~FI - begin~IF~SIZE[~TYP[2]]~THEN - ~SYM[4] <= fromSLV(~VAR[vec][2](~SYM[3]));~ELSE ~FI - ~INST 0 - ~OUTPUT <= ~SYM[2](~SYM[3])~ ~TYP[1]~ - ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[2](~SYM[3]+1)~ ~TYP[1]~ - ~INST - end generate;~ELSE - begin - ~INST 0 - ~OUTPUT <= ~SYM[2](~SYM[3])~ ~TYP[1]~ - ~INPUT <= ~VAR[vec][2](~SYM[3])~ ~TYPEL[~TYP[2]]~ - ~INPUT <= ~SYM[2](~SYM[3]+1)~ ~TYP[1]~ - ~INST - end generate;~FI - - ~RESULT <= ~SYM[2](0); -end block;~ELSE -~RESULT <= ~ARG[1];~FI --- foldr end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.index_int" - , "kind" : "Declaration" - , "type" : "index_int :: KnownNat n => Vec n a -> Int -> a" - , "template" : -"-- index begin -~IF~SIZE[~TYP[1]]~THEN~GENSYM[indexVec][0] : block - signal ~GENSYM[vec_index][1] : integer range 0 to ~LIT[0]-1; -begin - ~SYM[1] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~LIT[0] - -- pragma translate_on - ;~IF ~VIVADO ~THEN - ~RESULT <= fromSLV(~VAR[vec][1](~SYM[1]));~ELSE - ~RESULT <= ~VAR[vec][1](~SYM[1]);~FI -end block;~ELSE~RESULT <= ~ERRORO;~FI --- index end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replace_int" - , "kind" : "Declaration" - , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" - , "template" : -"-- replace begin -~GENSYM[replaceVec][0] : block - signal ~GENSYM[vec_index][1] : integer range 0 to ~LIT[0]-1; -begin - ~SYM[1] <= to_integer(~ARG[2]) - -- pragma translate_off - mod ~LIT[0] - -- pragma translate_on - ; - - process(~SYM[1]~VARS[1]~VARS[3]) - variable ~GENSYM[ivec][2] : ~TYP[1]; - begin - ~SYM[2] := ~ARG[1];~IF ~VIVADO ~THEN - ~SYM[2](~SYM[1]) := ~TOBV[~ARG[3]][~TYP[3]];~ELSE - ~SYM[2](~SYM[1]) := ~ARG[3];~FI - ~RESULT <= ~SYM[2]; - end process; -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" - , "kind" : "Expression" - , "type" : "length :: KnownNat n => Vec n a -> Int" - , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.replicate" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "replicate :: SNat n -> a -> Vec n a" - , "template" : "~TYPMO'(0 to ~LIT[0]-1 => ~IF ~VIVADO ~THEN ~TOBV[~ARG[1]][~TYP[1]] ~ELSE ~ARG[1] ~FI)" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.transpose" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" - , "template" : -"-- transpose begin -~GENSYM[transpose_outer][2] : for ~GENSYM[row_index][3] in 0 to (~LENGTH[~TYP[1]] - 1) generate - ~GENSYM[transpose_inner][4] : for ~GENSYM[col_index][5] in ~RESULT'range generate~IF ~VIVADO ~THEN - ~RESULT(~SYM[5])((~LENGTH[~TYP[1]]-~SYM[3])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 downto (~LENGTH[~TYP[1]]-~SYM[3]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]) <= ~VAR[vec][1](~SYM[3])((~RESULT'length-~SYM[5])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 downto (~RESULT'length-~SYM[5]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]);~ELSE - ~RESULT(~SYM[5])(~SYM[3]) <= ~VAR[matrix][1](~SYM[3])(~SYM[5]);~FI - end generate; -end generate; --- transpose end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.reverse" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "reverse :: Vec n a -> Vec n a" - , "template" : -"-- reverse begin -~GENSYM[reverse_loop][2] : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[0]] - 1) generate - ~RESULT(~VAR[vec][0]'high - ~SYM[3]) <= ~VAR[vec][0](~SYM[3]); -end generate; --- reverse end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.concatBitVector#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"concatBitVector# :: (KnownNat n,KnownNat m) -- (ARG[0],ARG[1]) - => Vec n (BitVector m) -- ARG[2] - -> BitVector (n * m)" - , "template" : -"-- concatBitVector begin -~GENSYM[concatBitVectorIter_loop][2] : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[2]] - 1) generate - ~RESULT(((~SYM[3] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[3] * ~LIT[1])) <= ~TYPMO'(~VAR[vec][2](~VAR[vec][2]'high - ~SYM[3])); -end generate; --- concatBitVector end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.unconcatBitVector#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : -"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) - => BitVector (n * m) -- ARG[2] - -> Vec n (BitVector m)" - , "template" : -"-- unconcatBitVector begin -~GENSYM[unconcatBitVectorIter_loop][2] : for ~GENSYM[i][3] in ~RESULT'range generate - ~RESULT(~RESULT'high - ~SYM[3]) <= ~VAR[vec][2](((~SYM[3] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[3] * ~LIT[1])); -end generate; --- unconcatBitVector end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateLeftS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"-- rotateLeftS begin -~GENSYM[rotateLeftS][0] : block - constant ~GENSYM[shift_amount][2] : natural := ~LIT[2] mod ~LIT[0]; -begin - ~GENSYM[no_shift][3] : if ~SYM[2] = 0 generate - ~RESULT <= ~VAR[vec][1]; - end generate; - - ~GENSYM[do_shift][4] : if ~SYM[2] /= 0 generate - ~RESULT <= ~VAR[vec][1](~SYM[2] to ~LIT[0]-1) & - ~VAR[vec][1](0 to ~SYM[2]-1); - end generate; -end block; --- rotateLeftS end" - } - } -, { "BlackBox" : - { "name" : "Clash.Sized.Vector.rotateRightS" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" - , "template" : -"-- rotateRightS begin -~GENSYM[rotateLeftS][0] : block - constant ~GENSYM[shift_amount][2] : natural := ~LIT[2] mod ~LIT[0]; -begin - ~GENSYM[no_shift][3] : if ~SYM[2] = 0 generate - ~RESULT <= ~VAR[vec][1]; - end generate; - - ~GENSYM[do_shift][4] : if ~SYM[2] /= 0 generate - ~RESULT <= ~VAR[vec][1](~LIT[0]-~SYM[2] to ~LIT[0]-1) & - ~VAR[vec][1](0 to ~LIT[0]-~SYM[2]-1); - end generate; -end block; --- rotateRightS end" - } - } -] diff --git a/prims/vhdl/Clash_Sized_Vector.primitives b/prims/vhdl/Clash_Sized_Vector.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Sized_Vector.primitives @@ -0,0 +1,444 @@ +[ { "BlackBox" : + { "name" : "Clash.Sized.Vector.head" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "head :: Vec (n + 1) a -> a" + , "template" : "~IF ~VIVADO ~THEN ~TYPMO'(fromSLV(~VAR[vec][0](0))) ~ELSE ~VAR[vec][0](0) ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.tail" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "tail :: Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0](1 to ~VAR[vec][0]'high)" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.last" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> a" + , "template" : "~IF ~VIVADO ~THEN ~TYPMO'(fromSLV(~VAR[vec][0](~VAR[vec][0]'high))) ~ELSE ~VAR[vec][0](~VAR[vec][0]'high) ~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.init" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "Vec (n + 1) a -> Vec n a" + , "template" : "~VAR[vec][0](0 to ~VAR[vec][0]'high - 1)" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.select" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"select :: (CmpNat (i + s) (s * n) ~ GT) -- ARG[0] + => SNat f -- ARG[1] + -> SNat s -- ARG[2] + -> SNat n -- ARG[3] + -> Vec i a -- ARG[4] + -> Vec n a" + , "template" : +"-- select begin +~GENSYM[select][0] : for ~GENSYM[i][1] in ~RESULT'range generate + ~RESULT(~SYM[1]) <= ~VAR[vec][4](~LIT[1]+(~LIT[2]*~SYM[1])); +end generate; +-- select end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.++" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "(++) :: Vec n a -> Vec m a -> Vec (n + m) a" + , "template" : "~TYPMO'(~TYPM[0]'(~ARG[0]) & ~TYPM[1]'(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concat" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "concat :: Vec n (Vec m a) -> Vec (n * m) a" + , "template" : +"-- concat begin +~GENSYM[concat][0] : for ~GENSYM[i][1] in 0 to (~LENGTH[~TYP[0]] - 1) generate +begin~IF ~VIVADO ~THEN +~RESULT(~SYM[1] * ~LENGTH[~TYPEL[~TYP[0]]] to ((~SYM[1]+1) * ~LENGTH[~TYPEL[~TYP[0]]]) - 1) <= fromSLV(~VAR[vec][0](~SYM[1]));~ELSE +~RESULT(~SYM[1] * ~LENGTH[~TYPEL[~TYP[0]]] to ((~SYM[1]+1) * ~LENGTH[~TYPEL[~TYP[0]]]) - 1) <= ~VAR[vec][0](~SYM[1]);~FI +end generate; +-- concat end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.splitAt" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)" + , "template" : "~IF~LENGTH[~TYPO]~THEN~ARG[1]~ELSE(~VAR[vec][1](0 to ~LIT[0]-1),~VAR[vec][1](~LIT[0] to ~VAR[vec][1]'high))~FI" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcat" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"unconcat :: KnownNat n -- ARG[0] + => SNat m -- ARG[1] + -> Vec (n * m) a -- ARG[2] + -> Vec n (Vec m a)" + , "template" : +"-- unconcat begin~DEVNULL[~ARG[0]] +~GENSYM[unconcat][0] : for ~GENSYM[i][2] in ~RESULT'range generate +begin~IF ~VIVADO ~THEN + ~RESULT(~SYM[2]) <= ~TOBV[~VAR[vec][2]((~SYM[2] * ~LIT[1]) to ((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1))][~TYPEL[~TYPO]];~ELSE + ~RESULT(~SYM[2]) <= ~VAR[vec][2]((~SYM[2] * ~LIT[1]) to ((~SYM[2] * ~LIT[1]) + ~LIT[1] - 1));~FI +end generate; +-- unconcat end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.map" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "map :: (a -> b) -> Vec n a -> Vec n b" + , "template" : +"-- map begin +~GENSYM[map][0] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[1]]~THEN + signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[1]];~ELSE ~FI + signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; +begin~IF~SIZE[~TYP[1]]~THEN + ~SYM[2] <= fromSLV(~VAR[vec][1](~SYM[1]));~ELSE ~FI + ~INST 0 + ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[1]]~ + ~INST + ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; +end generate;~ELSE +begin + ~INST 0 + ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ + ~INPUT <= ~VAR[vec][1](~SYM[1])~ ~TYPEL[~TYP[1]]~ + ~INST +end generate;~FI +-- map end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap :: KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b" + , "template" : +"-- imap begin +~GENSYM[imap][0] : block + function ~GENSYM[max][6] (l,r : in natural) return natural is + begin + if l > r then return l; + else return r; + end if; + end function; +begin + ~GENSYM[imap][5] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN + signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[2]];~ELSE ~FI + signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; + begin~IF~SIZE[~TYP[2]]~THEN + ~SYM[2] <= fromSLV(~VAR[vec][2](~SYM[1]));~ELSE ~FI + ~INST 1 + ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ + ~INPUT <= to_unsigned(~SYM[1],~SYM[6](1,integer(ceil(log2(real(~LIT[0]))))))~ ~INDEXTYPE[~LIT[0]]~ + ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[2]]~ + ~INST + ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; + end generate;~ELSE + begin + ~INST 1 + ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ + ~INPUT <= to_unsigned(~SYM[1],~SYM[6](1,integer(ceil(log2(real(~LIT[0]))))))~ ~INDEXTYPE[~LIT[0]]~ + ~INPUT <= ~VAR[vec][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ + ~INST + end generate;~FI +end block; +-- imap end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.imap_go" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "imap_go :: Index n -> (Index n -> a -> b) -> Vec m a -> Vec m b" + , "template" : +"-- imap_go begin +~GENSYM[imap][5] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN + signal ~GENSYM[map_in][2] : ~TYPEL[~TYP[2]];~ELSE ~FI + signal ~GENSYM[map_out][3] : ~TYPEL[~TYPO]; + signal ~GENSYM[i2][4] : ~TYP[0]; +begin~IF~SIZE[~TYP[2]]~THEN + ~SYM[2] <= fromSLV(~VAR[vec][2](~SYM[1]));~ELSE ~FI + ~SYM[4] <= ~ARG[0] + to_unsigned(~SYM[1],~SIZE[~TYP[0]]); + ~INST 1 + ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[4]~ ~TYP[0]~ + ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[2]]~ + ~INST + ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; +end generate;~ELSE + signal ~SYM[4] : ~TYP[0]; +begin + ~SYM[4] <= ~ARG[0] + to_unsigned(~SYM[1],~SIZE[~TYP[0]]); + ~INST 1 + ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[4]~ ~TYP[0]~ + ~INPUT <= ~VAR[vec][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ + ~INST +end generate;~FI +-- imap_go end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.zipWith" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c" + , "template" : +"-- zipWith begin +~GENSYM[zipWith][0] : for ~GENSYM[i][1] in ~RESULT'range generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[1]]~THEN + signal ~GENSYM[zipWith_in1][2] : ~TYPEL[~TYP[1]];~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN + signal ~GENSYM[zipWith_in2][6] : ~TYPEL[~TYP[2]];~ELSE ~FI + signal ~GENSYM[zipWith_out][3] : ~TYPEL[~TYPO]; +begin~IF~SIZE[~TYP[1]]~THEN + ~SYM[2] <= fromSLV(~VAR[vec1][1](~SYM[1]));~ELSE ~FI~IF~SIZE[~TYP[2]]~THEN + ~SYM[6] <= fromSLV(~VAR[vec2][2](~SYM[1]));~ELSE ~FI + ~INST 0 + ~OUTPUT <= ~SYM[3]~ ~TYPEL[~TYPO]~ + ~INPUT <= ~SYM[2]~ ~TYPEL[~TYP[1]]~ + ~INPUT <= ~SYM[6]~ ~TYPEL[~TYP[2]]~ + ~INST + ~RESULT(~SYM[1]) <= ~TOBV[~SYM[3]][~TYPEL[~TYPO]]; +end generate;~ELSE +begin + ~INST 0 + ~OUTPUT <= ~RESULT(~SYM[1])~ ~TYPEL[~TYPO]~ + ~INPUT <= ~VAR[vec1][1](~SYM[1])~ ~TYPEL[~TYP[1]]~ + ~INPUT <= ~VAR[vec2][2](~SYM[1])~ ~TYPEL[~TYP[2]]~ + ~INST +end generate;~FI +-- zipWith end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.foldr" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "foldr :: (a -> b -> b) -> b -> Vec n a -> b" + , "template" : +"-- foldr begin~IF ~LENGTH[~TYP[2]] ~THEN +~GENSYM[foldr][0] : block + type ~GENSYM[foldr_res_type][1] is array (natural range <>) of ~TYP[1]; + signal ~GENSYM[intermediate][2] : ~SYM[1] (0 to ~LENGTH[~TYP[2]]); +begin + ~SYM[2](~LENGTH[~TYP[2]]) <= ~ARG[1]; + + foldr_loop : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[2]] - 1) generate~IF ~VIVADO ~THEN~IF~SIZE[~TYP[2]]~THEN + signal ~GENSYM[foldr_in][4] : ~TYPEL[~TYP[2]];~ELSE ~FI + begin~IF~SIZE[~TYP[2]]~THEN + ~SYM[4] <= fromSLV(~VAR[vec][2](~SYM[3]));~ELSE ~FI + ~INST 0 + ~OUTPUT <= ~SYM[2](~SYM[3])~ ~TYP[1]~ + ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[2]]~ + ~INPUT <= ~SYM[2](~SYM[3]+1)~ ~TYP[1]~ + ~INST + end generate;~ELSE + begin + ~INST 0 + ~OUTPUT <= ~SYM[2](~SYM[3])~ ~TYP[1]~ + ~INPUT <= ~VAR[vec][2](~SYM[3])~ ~TYPEL[~TYP[2]]~ + ~INPUT <= ~SYM[2](~SYM[3]+1)~ ~TYP[1]~ + ~INST + end generate;~FI + + ~RESULT <= ~SYM[2](0); +end block;~ELSE +~RESULT <= ~ARG[1];~FI +-- foldr end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.index_int" + , "kind" : "Declaration" + , "type" : "index_int :: KnownNat n => Vec n a -> Int -> a" + , "template" : +"-- index begin +~IF~SIZE[~TYP[1]]~THEN~GENSYM[indexVec][0] : block + signal ~GENSYM[vec_index][1] : integer range 0 to ~LIT[0]-1; +begin + ~SYM[1] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~LIT[0] + -- pragma translate_on + ;~IF ~VIVADO ~THEN + ~RESULT <= fromSLV(~VAR[vec][1](~SYM[1]));~ELSE + ~RESULT <= ~VAR[vec][1](~SYM[1]);~FI +end block;~ELSE~RESULT <= ~ERRORO;~FI +-- index end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replace_int" + , "kind" : "Declaration" + , "type" : "replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a" + , "template" : +"-- replace begin +~GENSYM[replaceVec][0] : block + signal ~GENSYM[vec_index][1] : integer range 0 to ~LIT[0]-1; +begin + ~SYM[1] <= to_integer(~ARG[2]) + -- pragma translate_off + mod ~LIT[0] + -- pragma translate_on + ; + + process(~SYM[1]~VARS[1]~VARS[3]) + variable ~GENSYM[ivec][2] : ~TYP[1]; + begin + ~SYM[2] := ~ARG[1];~IF ~VIVADO ~THEN + ~SYM[2](~SYM[1]) := ~TOBV[~ARG[3]][~TYP[3]];~ELSE + ~SYM[2](~SYM[1]) := ~ARG[3];~FI + ~RESULT <= ~SYM[2]; + end process; +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" + , "kind" : "Expression" + , "type" : "length :: KnownNat n => Vec n a -> Int" + , "template" : "to_signed(~LIT[0],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.replicate" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "replicate :: SNat n -> a -> Vec n a" + , "template" : "~TYPMO'(0 to ~LIT[0]-1 => ~IF ~VIVADO ~THEN ~TOBV[~ARG[1]][~TYP[1]] ~ELSE ~ARG[1] ~FI)" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.transpose" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)" + , "template" : +"-- transpose begin +~GENSYM[transpose_outer][2] : for ~GENSYM[row_index][3] in 0 to (~LENGTH[~TYP[1]] - 1) generate + ~GENSYM[transpose_inner][4] : for ~GENSYM[col_index][5] in ~RESULT'range generate~IF ~VIVADO ~THEN + ~RESULT(~SYM[5])((~LENGTH[~TYP[1]]-~SYM[3])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 downto (~LENGTH[~TYP[1]]-~SYM[3]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]) <= ~VAR[vec][1](~SYM[3])((~RESULT'length-~SYM[5])*~SIZE[~TYPEL[~TYPEL[~TYPO]]]-1 downto (~RESULT'length-~SYM[5]-1)*~SIZE[~TYPEL[~TYPEL[~TYPO]]]);~ELSE + ~RESULT(~SYM[5])(~SYM[3]) <= ~VAR[matrix][1](~SYM[3])(~SYM[5]);~FI + end generate; +end generate; +-- transpose end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.reverse" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "reverse :: Vec n a -> Vec n a" + , "template" : +"-- reverse begin +~GENSYM[reverse_loop][2] : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[0]] - 1) generate + ~RESULT(~VAR[vec][0]'high - ~SYM[3]) <= ~VAR[vec][0](~SYM[3]); +end generate; +-- reverse end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.concatBitVector#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"concatBitVector# :: (KnownNat n,KnownNat m) -- (ARG[0],ARG[1]) + => Vec n (BitVector m) -- ARG[2] + -> BitVector (n * m)" + , "template" : +"-- concatBitVector begin +~GENSYM[concatBitVectorIter_loop][2] : for ~GENSYM[i][3] in 0 to (~LENGTH[~TYP[2]] - 1) generate + ~RESULT(((~SYM[3] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[3] * ~LIT[1])) <= ~TYPMO'(~VAR[vec][2](~VAR[vec][2]'high - ~SYM[3])); +end generate; +-- concatBitVector end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.unconcatBitVector#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : +"unconcatBitVector# :: (KnownNat n, KnownNat m) -- (ARG[0],ARG[1]) + => BitVector (n * m) -- ARG[2] + -> Vec n (BitVector m)" + , "template" : +"-- unconcatBitVector begin +~GENSYM[unconcatBitVectorIter_loop][2] : for ~GENSYM[i][3] in ~RESULT'range generate + ~RESULT(~RESULT'high - ~SYM[3]) <= ~VAR[vec][2](((~SYM[3] * ~LIT[1]) + ~LIT[1] - 1) downto (~SYM[3] * ~LIT[1])); +end generate; +-- unconcatBitVector end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateLeftS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateLeftS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"-- rotateLeftS begin +~GENSYM[rotateLeftS][0] : block + constant ~GENSYM[shift_amount][2] : natural := ~LIT[2] mod ~LIT[0]; +begin + ~GENSYM[no_shift][3] : if ~SYM[2] = 0 generate + ~RESULT <= ~VAR[vec][1]; + end generate; + + ~GENSYM[do_shift][4] : if ~SYM[2] /= 0 generate + ~RESULT <= ~VAR[vec][1](~SYM[2] to ~LIT[0]-1) & + ~VAR[vec][1](0 to ~SYM[2]-1); + end generate; +end block; +-- rotateLeftS end" + } + } +, { "BlackBox" : + { "name" : "Clash.Sized.Vector.rotateRightS" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "rotateRightS :: KnownNat n => Vec n a -> SNat d -> Vec n a" + , "template" : +"-- rotateRightS begin +~GENSYM[rotateLeftS][0] : block + constant ~GENSYM[shift_amount][2] : natural := ~LIT[2] mod ~LIT[0]; +begin + ~GENSYM[no_shift][3] : if ~SYM[2] = 0 generate + ~RESULT <= ~VAR[vec][1]; + end generate; + + ~GENSYM[do_shift][4] : if ~SYM[2] /= 0 generate + ~RESULT <= ~VAR[vec][1](~LIT[0]-~SYM[2] to ~LIT[0]-1) & + ~VAR[vec][1](0 to ~LIT[0]-~SYM[2]-1); + end generate; +end block; +-- rotateRightS end" + } + } +] diff --git a/prims/vhdl/Clash_Transformations.json b/prims/vhdl/Clash_Transformations.json deleted file mode 100644 --- a/prims/vhdl/Clash_Transformations.json +++ /dev/null @@ -1,8 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Transformations.eqInt" - , "kind" : "Expression" - , "type" : "eqInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] = ~ARG[1]" - } - } -] diff --git a/prims/vhdl/Clash_Transformations.primitives b/prims/vhdl/Clash_Transformations.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Transformations.primitives @@ -0,0 +1,8 @@ +[ { "BlackBox" : + { "name" : "Clash.Transformations.eqInt" + , "kind" : "Expression" + , "type" : "eqInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] = ~ARG[1]" + } + } +] diff --git a/prims/vhdl/Clash_Xilinx_ClockGen.json b/prims/vhdl/Clash_Xilinx_ClockGen.json deleted file mode 100644 --- a/prims/vhdl/Clash_Xilinx_ClockGen.json +++ /dev/null @@ -1,70 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Xilinx.ClockGen.clockWizard" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : -"clockWizard - :: ( KnownDomain domIn confIn -- ARG[0] - , KnownDomain domOut confOut ) -- ARG[1] - => SSymbol name -- ARG[2] - -> Clock pllIn -- ARG[3] - -> Reset pllIn -- ARG[4] - -> (Clock pllOut, Enable pllOut)" - , "template" : -"-- clockWizard begin -~GENSYM[clockWizard][0] : block - signal ~GENSYM[pllOut][1] : std_logic; - signal ~GENSYM[locked][2] : std_logic; - signal ~GENSYM[pllLock][3] : boolean; - - component ~NAME[2] - port (CLK_IN1 : in std_logic; - RESET : in std_logic; - CLK_OUT1 : out std_logic; - LOCKED : out std_logic); - end component; -begin - ~GENSYM[clockWizard_inst][4] : component ~NAME[2] port map (~ARG[3],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[4] ~ELSE NOT(~ARG[4]) ~FI,~SYM[1],~SYM[2]); - ~SYM[3] <= true when ~SYM[2] = '1' else false; - ~RESULT <= (~SYM[1],~SYM[3]); -end block; --- clockWizard end" - } - } -, { "BlackBox" : - { "name" : "Clash.Xilinx.ClockGen.clockWizardDifferential" - , "workInfo" : "Always" - , "kind" : "Declaration" - , "type" : -"clockWizardDifferential - :: ( KnownDomain domIn confIn -- ARG[0] - , KnownDomain domOut confOut ) -- ARG[1] - => SSymbol name -- ARG[2] - -> Clock pllIn -- ARG[3] - -> Clock pllIn -- ARG[4] - -> Reset pllIn -- ARG[5] - -> (Clock pllOut, Enable pllOut)" - , "template" : -"-- clockWizardDifferential begin -~GENSYM[clockWizardDifferential][0] : block - signal ~GENSYM[pllOut][1] : std_logic; - signal ~GENSYM[locked][2] : std_logic; - signal ~GENSYM[pllLock][3] : boolean; - - component ~NAME[2] - port (CLK_IN1_D_clk_n : in std_logic; - CLK_IN1_D_clk_p : in std_logic; - RESET : in std_logic; - CLK_OUT1 : out std_logic; - LOCKED : out std_logic); - end component; -begin - ~GENSYM[clockWizardDifferential_inst][4] : component ~NAME[2] - port map (~ARG[3],~ARG[4],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[5] ~ELSE NOT(~ARG[5]) ~FI,~SYM[1],~SYM[2]); - ~SYM[3] <= true when ~SYM[2] = '1' else false; - ~RESULT <= (~SYM[1],~SYM[3]); -end block; --- clockWizardDifferential end" - } - } -] diff --git a/prims/vhdl/Clash_Xilinx_ClockGen.primitives b/prims/vhdl/Clash_Xilinx_ClockGen.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Xilinx_ClockGen.primitives @@ -0,0 +1,70 @@ +[ { "BlackBox" : + { "name" : "Clash.Xilinx.ClockGen.clockWizard" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : +"clockWizard + :: ( KnownDomain domIn confIn -- ARG[0] + , KnownDomain domOut confOut ) -- ARG[1] + => SSymbol name -- ARG[2] + -> Clock pllIn -- ARG[3] + -> Reset pllIn -- ARG[4] + -> (Clock pllOut, Enable pllOut)" + , "template" : +"-- clockWizard begin +~GENSYM[clockWizard][0] : block + signal ~GENSYM[pllOut][1] : std_logic; + signal ~GENSYM[locked][2] : std_logic; + signal ~GENSYM[pllLock][3] : boolean; + + component ~NAME[2] + port (CLK_IN1 : in std_logic; + RESET : in std_logic; + CLK_OUT1 : out std_logic; + LOCKED : out std_logic); + end component; +begin + ~GENSYM[clockWizard_inst][4] : component ~NAME[2] port map (~ARG[3],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[4] ~ELSE NOT(~ARG[4]) ~FI,~SYM[1],~SYM[2]); + ~SYM[3] <= true when ~SYM[2] = '1' else false; + ~RESULT <= (~SYM[1],~SYM[3]); +end block; +-- clockWizard end" + } + } +, { "BlackBox" : + { "name" : "Clash.Xilinx.ClockGen.clockWizardDifferential" + , "workInfo" : "Always" + , "kind" : "Declaration" + , "type" : +"clockWizardDifferential + :: ( KnownDomain domIn confIn -- ARG[0] + , KnownDomain domOut confOut ) -- ARG[1] + => SSymbol name -- ARG[2] + -> Clock pllIn -- ARG[3] + -> Clock pllIn -- ARG[4] + -> Reset pllIn -- ARG[5] + -> (Clock pllOut, Enable pllOut)" + , "template" : +"-- clockWizardDifferential begin +~GENSYM[clockWizardDifferential][0] : block + signal ~GENSYM[pllOut][1] : std_logic; + signal ~GENSYM[locked][2] : std_logic; + signal ~GENSYM[pllLock][3] : boolean; + + component ~NAME[2] + port (CLK_IN1_D_clk_n : in std_logic; + CLK_IN1_D_clk_p : in std_logic; + RESET : in std_logic; + CLK_OUT1 : out std_logic; + LOCKED : out std_logic); + end component; +begin + ~GENSYM[clockWizardDifferential_inst][4] : component ~NAME[2] + port map (~ARG[3],~ARG[4],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[5] ~ELSE NOT(~ARG[5]) ~FI,~SYM[1],~SYM[2]); + ~SYM[3] <= true when ~SYM[2] = '1' else false; + ~RESULT <= (~SYM[1],~SYM[3]); +end block; +-- clockWizardDifferential end" + } + } +] diff --git a/prims/vhdl/Clash_Xilinx_DDR.json b/prims/vhdl/Clash_Xilinx_DDR.json deleted file mode 100644 --- a/prims/vhdl/Clash_Xilinx_DDR.json +++ /dev/null @@ -1,103 +0,0 @@ -[ { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.iddr" - , "kind" : "Declaration" - , "type" : -"iddr - :: ( HasCallStack -- ARG[0] - , KnownConfi~ fast domf -- ARG[1] - , KnownConfi~ slow doms -- ARG[2] - , KnownNat m ) -- ARG[3] - -> Clock slow -- ARG[4] - -> Reset slow -- ARG[5] - -> Enable slow -- ARG[6] - -> Signal fast (BitVector m) -- ARG[7] - -> Signal slow (BitVector m,BitVector m)" - , "libraries" : ["UNISIM"] - , "imports" : ["UNISIM.vcomponents.all"] - , "template" : -"-- iddr begin -~GENSYM[~COMPNAME_IDDR][0] : block - signal ~GENSYM[dataout_l][1] : ~TYP[7]; - signal ~GENSYM[dataout_h][2] : ~TYP[7]; - signal ~GENSYM[d][3] : ~TYP[7];~IF ~ISACTIVEENABLE[4] ~THEN - signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI -begin~IF ~ISACTIVEENABLE[4] ~THEN - ~SYM[4] <= '1' when (~ARG[6]) else '0';~ELSE ~FI - ~SYM[3] <= ~ARG[7]; - - ~GENSYM[gen_iddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate - begin - ~GENSYM[~COMPNAME_IDDR_inst][9] : IDDR - generic map ( - DDR_CLK_EDGE => \"SAME_EDGE\", - INIT_Q1 => '0', - INIT_Q2 => '0', - SRTYPE => ~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - port map ( - Q1 => ~SYM[1](~SYM[8]), -- 1-bit output for positive edge of clock - Q2 => ~SYM[2](~SYM[8]), -- 1-bit output for negative edge of clock - C => ~ARG[4], -- 1-bit clock input - CE => ~IF ~ISACTIVEENABLE[6] ~THEN ~SYM[4] ~ELSE '1' ~FI, -- 1-bit clock enable input - D => ~SYM[3](~SYM[8]), -- 1-bit DDR data input - R => ~ARG[5], -- 1-bit reset - S => '0' -- 1-bit set - ); - end generate; - - ~RESULT <= (~SYM[2], ~SYM[1]); -end block; --- iddr# end" - } - } -, { "BlackBox" : - { "name" : "Clash.Xilinx.DDR.oddr#" - , "kind" : "Declaration" - , "type" : -"oddr# - :: ( KnownConfi~ fast domf -- ARG[0] - , KnownConfi~ slow doms -- ARG[1] - , KnownNat m ) -- ARG[2] - => Clock slow -- ARG[3] - -> Reset slow -- ARG[4] - -> Enable slow -- ARG[5] - -> Signal slow (BitVector m) -- ARG[6] - -> Signal slow (BitVector m) -- ARG[7] - -> Signal fast (BitVector m)" - , "libraries" : ["UNISIM"] - , "imports" : ["UNISIM.vcomponents.all"] - , "template" : -"-- oddr begin -~GENSYM[~COMPNAME_ODDR][0] : block - signal ~GENSYM[dataout_l][1] : ~TYPO; - signal ~GENSYM[dataout_h][2] : ~TYPO; - signal ~GENSYM[q][3] : ~TYPO;~IF ~ISACTIVEENABLE[5] ~THEN - signal ~GENSYM[ce_logic][4] : std_logic;~ELSE ~FI -begin~IF ~ISACTIVEENABLE[5] ~THEN - ~SYM[4] <= '1' when (~ARG[5]) else '0';~ELSE ~FI - ~SYM[1] <= ~ARG[6]; - ~SYM[2] <= ~ARG[7]; - - ~GENSYM[gen_iddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate - begin - ~GENSYM[~COMPNAME_ODDR_inst][9] : ODDR - generic map( - DDR_CLK_EDGE => \"SAME_EDGE\", - INIT => '0', - SRTYPE => ~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) - port map ( - Q => ~SYM[3](~SYM[8]), -- 1-bit DDR output - C => ~ARG[3], -- 1-bit clock input - CE => ~IF ~ISACTIVEENABLE[5] ~THEN ~SYM[4] ~ELSE '1' ~FI, -- 1-bit clock enable input - D1 => ~SYM[1](~SYM[8]), -- 1-bit data input (positive edge) - D2 => ~SYM[2](~SYM[8]), -- 1-bit data input (negative edge) - R => ~ARG[4], -- 1-bit reset input - S => '0' -- 1-bit set input - ); - end generate; - - ~RESULT <= ~SYM[3]; -end block; --- oddr end" - } - } -] diff --git a/prims/vhdl/Clash_Xilinx_DDR.primitives b/prims/vhdl/Clash_Xilinx_DDR.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/Clash_Xilinx_DDR.primitives @@ -0,0 +1,103 @@ +[ { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.iddr" + , "kind" : "Declaration" + , "type" : +"iddr + :: ( HasCallStack -- ARG[0] + , KnownConfi~ fast domf -- ARG[1] + , KnownConfi~ slow doms -- ARG[2] + , KnownNat m ) -- ARG[3] + -> Clock slow -- ARG[4] + -> Reset slow -- ARG[5] + -> Enable slow -- ARG[6] + -> Signal fast (BitVector m) -- ARG[7] + -> Signal slow (BitVector m,BitVector m)" + , "libraries" : ["UNISIM"] + , "imports" : ["UNISIM.vcomponents.all"] + , "template" : +"-- iddr begin +~GENSYM[~COMPNAME_IDDR][0] : block + signal ~GENSYM[dataout_l][1] : ~TYP[7]; + signal ~GENSYM[dataout_h][2] : ~TYP[7]; + signal ~GENSYM[d][3] : ~TYP[7];~IF ~ISACTIVEENABLE[4] ~THEN + signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI +begin~IF ~ISACTIVEENABLE[4] ~THEN + ~SYM[4] <= '1' when (~ARG[6]) else '0';~ELSE ~FI + ~SYM[3] <= ~ARG[7]; + + ~GENSYM[gen_iddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate + begin + ~GENSYM[~COMPNAME_IDDR_inst][9] : IDDR + generic map ( + DDR_CLK_EDGE => \"SAME_EDGE\", + INIT_Q1 => '0', + INIT_Q2 => '0', + SRTYPE => ~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + port map ( + Q1 => ~SYM[1](~SYM[8]), -- 1-bit output for positive edge of clock + Q2 => ~SYM[2](~SYM[8]), -- 1-bit output for negative edge of clock + C => ~ARG[4], -- 1-bit clock input + CE => ~IF ~ISACTIVEENABLE[6] ~THEN ~SYM[4] ~ELSE '1' ~FI, -- 1-bit clock enable input + D => ~SYM[3](~SYM[8]), -- 1-bit DDR data input + R => ~ARG[5], -- 1-bit reset + S => '0' -- 1-bit set + ); + end generate; + + ~RESULT <= (~SYM[2], ~SYM[1]); +end block; +-- iddr# end" + } + } +, { "BlackBox" : + { "name" : "Clash.Xilinx.DDR.oddr#" + , "kind" : "Declaration" + , "type" : +"oddr# + :: ( KnownConfi~ fast domf -- ARG[0] + , KnownConfi~ slow doms -- ARG[1] + , KnownNat m ) -- ARG[2] + => Clock slow -- ARG[3] + -> Reset slow -- ARG[4] + -> Enable slow -- ARG[5] + -> Signal slow (BitVector m) -- ARG[6] + -> Signal slow (BitVector m) -- ARG[7] + -> Signal fast (BitVector m)" + , "libraries" : ["UNISIM"] + , "imports" : ["UNISIM.vcomponents.all"] + , "template" : +"-- oddr begin +~GENSYM[~COMPNAME_ODDR][0] : block + signal ~GENSYM[dataout_l][1] : ~TYPO; + signal ~GENSYM[dataout_h][2] : ~TYPO; + signal ~GENSYM[q][3] : ~TYPO;~IF ~ISACTIVEENABLE[5] ~THEN + signal ~GENSYM[ce_logic][4] : std_logic;~ELSE ~FI +begin~IF ~ISACTIVEENABLE[5] ~THEN + ~SYM[4] <= '1' when (~ARG[5]) else '0';~ELSE ~FI + ~SYM[1] <= ~ARG[6]; + ~SYM[2] <= ~ARG[7]; + + ~GENSYM[gen_iddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate + begin + ~GENSYM[~COMPNAME_ODDR_inst][9] : ODDR + generic map( + DDR_CLK_EDGE => \"SAME_EDGE\", + INIT => '0', + SRTYPE => ~IF ~ISSYNC[2] ~THEN \"SYNC\" ~ELSE \"ASYNC\" ~FI) + port map ( + Q => ~SYM[3](~SYM[8]), -- 1-bit DDR output + C => ~ARG[3], -- 1-bit clock input + CE => ~IF ~ISACTIVEENABLE[5] ~THEN ~SYM[4] ~ELSE '1' ~FI, -- 1-bit clock enable input + D1 => ~SYM[1](~SYM[8]), -- 1-bit data input (positive edge) + D2 => ~SYM[2](~SYM[8]), -- 1-bit data input (negative edge) + R => ~ARG[4], -- 1-bit reset input + S => '0' -- 1-bit set input + ); + end generate; + + ~RESULT <= ~SYM[3]; +end block; +-- oddr end" + } + } +] diff --git a/prims/vhdl/GHC_Base.json b/prims/vhdl/GHC_Base.json deleted file mode 100644 --- a/prims/vhdl/GHC_Base.json +++ /dev/null @@ -1,31 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Base.remInt" - , "kind" : "Expression" - , "type" : "remInt :: Int -> Int -> Int" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.divInt" - , "kind" : "Declaration" - , "type" : "divInt :: Int -> Int -> Int" - , "template" : -"-- divInt begin -~GENSYM[divInt][0] : block - signal ~GENSYM[quot_res][1] : ~TYP[1]; -begin - ~SYM[1] <= ~ARG[0] / ~ARG[1]; - ~RESULT <= ~SYM[1] - 1 when ((~ARG[0] = abs ~ARG[0]) /= (~ARG[1] = abs ~ARG[1])) else - ~SYM[1]; -end block; --- divInt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Base.modInt" - , "kind" : "Expression" - , "type" : "modInt :: Int -> Int -> Int" - , "template" : "~ARG[0] mod ~ARG[1]" - } - } -] diff --git a/prims/vhdl/GHC_Base.primitives b/prims/vhdl/GHC_Base.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Base.primitives @@ -0,0 +1,31 @@ +[ { "BlackBox" : + { "name" : "GHC.Base.remInt" + , "kind" : "Expression" + , "type" : "remInt :: Int -> Int -> Int" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.divInt" + , "kind" : "Declaration" + , "type" : "divInt :: Int -> Int -> Int" + , "template" : +"-- divInt begin +~GENSYM[divInt][0] : block + signal ~GENSYM[quot_res][1] : ~TYP[1]; +begin + ~SYM[1] <= ~ARG[0] / ~ARG[1]; + ~RESULT <= ~SYM[1] - 1 when ((~ARG[0] = abs ~ARG[0]) /= (~ARG[1] = abs ~ARG[1])) else + ~SYM[1]; +end block; +-- divInt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Base.modInt" + , "kind" : "Expression" + , "type" : "modInt :: Int -> Int -> Int" + , "template" : "~ARG[0] mod ~ARG[1]" + } + } +] diff --git a/prims/vhdl/GHC_Classes.json b/prims/vhdl/GHC_Classes.json deleted file mode 100644 --- a/prims/vhdl/GHC_Classes.json +++ /dev/null @@ -1,66 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Classes.eqInt" - , "kind" : "Expression" - , "type" : "eqInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.neInt" - , "kind" : "Expression" - , "type" : "neInt :: Int -> Int -> Bool" - , "template" : "~ARG[0] /= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.&&" - , "kind" : "Expression" - , "type" : "(&&) :: Bool -> Bool -> Bool" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.||" - , "kind" : "Expression" - , "type" : "(::) :: Bool -> Bool -> Bool" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.not" - , "kind" : "Expression" - , "type" : "not :: Bool -> Bool" - , "template" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.divInt#" - , "kind" : "Declaration" - , "type" : "divInt# :: Int# -> Int# -> Int#" - , "template" : -"-- divInt# begin -~GENSYM[divInt][0] : block - signal ~GENSYM[resultPos][1] : boolean; - signal ~GENSYM[dividerNeg][2] : boolean; - signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); - signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); -begin - ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); - ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; - ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); - ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; - ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); -end block; --- divInt# end" - } - } -, { "BlackBox" : - { "name" : "GHC.Classes.modInt#" - , "kind" : "Expression" - , "type" : "modInt# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] mod ~ARG[1]" - } - } -] diff --git a/prims/vhdl/GHC_Classes.primitives b/prims/vhdl/GHC_Classes.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Classes.primitives @@ -0,0 +1,66 @@ +[ { "BlackBox" : + { "name" : "GHC.Classes.eqInt" + , "kind" : "Expression" + , "type" : "eqInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.neInt" + , "kind" : "Expression" + , "type" : "neInt :: Int -> Int -> Bool" + , "template" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.&&" + , "kind" : "Expression" + , "type" : "(&&) :: Bool -> Bool -> Bool" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.||" + , "kind" : "Expression" + , "type" : "(::) :: Bool -> Bool -> Bool" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.not" + , "kind" : "Expression" + , "type" : "not :: Bool -> Bool" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.divInt#" + , "kind" : "Declaration" + , "type" : "divInt# :: Int# -> Int# -> Int#" + , "template" : +"-- divInt# begin +~GENSYM[divInt][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); +end block; +-- divInt# end" + } + } +, { "BlackBox" : + { "name" : "GHC.Classes.modInt#" + , "kind" : "Expression" + , "type" : "modInt# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] mod ~ARG[1]" + } + } +] diff --git a/prims/vhdl/GHC_Int.json b/prims/vhdl/GHC_Int.json deleted file mode 100644 --- a/prims/vhdl/GHC_Int.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Int.I8#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I8# :: Int# -> Int8" - , "template" : "resize(~ARG[0],8)" - } - } -, { "BlackBox" : - { "name" : "GHC.Int.I16#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I16# :: Int# -> Int16" - , "template" : "resize(~ARG[0],16)" - } - } -, { "BlackBox" : - { "name" : "GHC.Int.I32#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I32# :: Int# -> Int32" - , "template" : "resize(~ARG[0],32)" - } - } -, { "BlackBox" : - { "name" : "GHC.Int.I64#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "I64# :: Int# -> Int64" - , "template" : "resize(~ARG[0],64)" - } - } -] diff --git a/prims/vhdl/GHC_Int.primitives b/prims/vhdl/GHC_Int.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Int.primitives @@ -0,0 +1,33 @@ +[ { "BlackBox" : + { "name" : "GHC.Int.I8#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I8# :: Int# -> Int8" + , "template" : "resize(~ARG[0],8)" + } + } +, { "BlackBox" : + { "name" : "GHC.Int.I16#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I16# :: Int# -> Int16" + , "template" : "resize(~ARG[0],16)" + } + } +, { "BlackBox" : + { "name" : "GHC.Int.I32#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I32# :: Int# -> Int32" + , "template" : "resize(~ARG[0],32)" + } + } +, { "BlackBox" : + { "name" : "GHC.Int.I64#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "I64# :: Int# -> Int64" + , "template" : "resize(~ARG[0],64)" + } + } +] diff --git a/prims/vhdl/GHC_Integer_Logarithms.json b/prims/vhdl/GHC_Integer_Logarithms.json deleted file mode 100644 --- a/prims/vhdl/GHC_Integer_Logarithms.json +++ /dev/null @@ -1,8 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Logarithms.integerLogBase#" - , "kind" : "Expression" - , "type" : "integerLogBase# :: Integer -> Integer -> Int#" - , "template" : "integer(floor(log(real(~ARG[1]),real(~ARG[0]))))" - } - } -] diff --git a/prims/vhdl/GHC_Integer_Logarithms.primitives b/prims/vhdl/GHC_Integer_Logarithms.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Integer_Logarithms.primitives @@ -0,0 +1,8 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Logarithms.integerLogBase#" + , "kind" : "Expression" + , "type" : "integerLogBase# :: Integer -> Integer -> Int#" + , "template" : "integer(floor(log(real(~ARG[1]),real(~ARG[0]))))" + } + } +] diff --git a/prims/vhdl/GHC_Integer_Type.json b/prims/vhdl/GHC_Integer_Type.json deleted file mode 100644 --- a/prims/vhdl/GHC_Integer_Type.json +++ /dev/null @@ -1,257 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Integer.Type.smallInteger" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "smallInteger :: Int# -> Integer" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToInt" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "integerToInt :: Integer -> Int#" - , "template" : "~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.timesInteger" - , "kind" : "Expression" - , "type" : "timesInteger :: Integer -> Integer -> Integer" - , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.negateInteger" - , "kind" : "Expression" - , "type" : "negateInteger :: Integer -> Integer" - , "template" : "-~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.absInteger" - , "kind" : "Expression" - , "type" : "absInteger :: Integer -> Integer" - , "template" : "abs ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.divInteger" - , "kind" : "Declaration" - , "type" : "divInteger :: Integer -> Integer -> Integer" - , "template" : -"-- divInteger begin -~GENSYM[divInteger][0] : block - signal ~GENSYM[resultPos][1] : boolean; - signal ~GENSYM[dividerNeg][2] : boolean; - signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); - signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); -begin - ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); - ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; - ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else - (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); - ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; - ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); -end block; --- divInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.modInteger" - , "kind" : "Expression" - , "type" : "modInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] mod ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.divModInteger" - , "kind" : "Declaration" - , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : -"-- divModInteger begin -~GENSYM[divModInteger][0] : block - signal ~GENSYM[resultPos][1] : boolean; - signal ~GENSYM[dividerNeg][2] : boolean; - signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYP[0]] downto 0); - signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYP[0]] downto 0); - signal ~GENSYM[div_res][5] : signed(~SIZE[~TYP[0]]-1 downto 0); -begin - ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); - ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; - ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) when ~SYM[1] else - (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) - 1) when ~SYM[2] else - (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) + 1); - ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; - ~SYM[5] <= signed(~SYM[4](~SIZE[~TYP[0]]-1 downto 0)); - ~RESULT <= (~SYM[5], ~VAR[dividend][0] mod ~VAR[divider][1]); -end block; --- divModInteger end" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.quotRemInteger" - , "kind" : "Expression" - , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" - , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.remInteger" - , "kind" : "Expression" - , "type" : "remInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger" - , "kind" : "Expression" - , "type" : "eqInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] = ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger" - , "kind" : "Expression" - , "type" : "neqInteger :: Integer -> Integer -> Bool" - , "template" : "~ARG[0] /= ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.eqInteger#" - , "kind" : "Declaration" - , "type" : "eqInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.neqInteger#" - , "kind" : "Declaration" - , "type" : "neqInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.leInteger#" - , "kind" : "Declaration" - , "type" : "leInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.gtInteger#" - , "kind" : "Declaration" - , "type" : "gtInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.ltInteger#" - , "kind" : "Declaration" - , "type" : "ltInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.geInteger#" - , "kind" : "Declaration" - , "type" : "geInteger# :: Integer -> Integer -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.shiftRInteger" - , "kind" : "Expression" - , "type" : "shiftRInteger :: Integer -> Int# -> Integer" - , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.shiftLInteger" - , "kind" : "Expression" - , "type" : "shiftLInteger :: Integer -> Int# -> Integer" - , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.testBitInteger" - , "kind" : "Expression" - , "type" : "testBitInteger :: Integer -> Int# -> Bool" - , "template" : "~VAR[input][0](to_integer(~ARG[1])) = '1'" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.wordToInteger" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "wordToInteger :: Word# -> Integer" - , "template" : "signed(std_logic_vector(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToWord" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "integerToWord :: Integer -> Word#" - , "template" : "unsigned(std_logic_vector(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.integerToWord64" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "integerToWord :: Integer -> Word64#" - , "comment" : "only used by 32 bit GHC" - , "template" : "unsigned(std_logic_vector(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.bitInteger" - , "kind" : "Expression" - , "type" : "bitInteger :: Int -> Integer" - , "template" : "shift_left(to_signed(1, ~SIZE[~TYPO]),to_integer(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.complementInteger" - , "kind" : "Expression" - , "type" : "complementInteger :: Integer -> Integer" - , "template" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.xorInteger" - , "kind" : "Expression" - , "type" : "xorInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.orInteger" - , "kind" : "Expression" - , "type" : "orInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.andInteger" - , "kind" : "Expression" - , "type" : "andInteger :: Integer -> Integer -> Integer" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Integer.Type.$wsignumInteger" - , "kind" : "Declaration" - , "type" : "$wsignumInteger :: Integer -> Integer" - , "template" : " --- begin signumInteger -~RESULT <= to_signed(-1, ~SIZE[~TYPO]) when ~ARG[0] < 0 - else to_signed(0, ~SIZE[~TYPO]) when ~ARG[0] = 0 - else to_signed(1, ~SIZE[~TYPO]); --- end signumInteger -" - } - } -] diff --git a/prims/vhdl/GHC_Integer_Type.primitives b/prims/vhdl/GHC_Integer_Type.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Integer_Type.primitives @@ -0,0 +1,257 @@ +[ { "BlackBox" : + { "name" : "GHC.Integer.Type.smallInteger" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "smallInteger :: Int# -> Integer" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToInt" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToInt :: Integer -> Int#" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.timesInteger" + , "kind" : "Expression" + , "type" : "timesInteger :: Integer -> Integer -> Integer" + , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.negateInteger" + , "kind" : "Expression" + , "type" : "negateInteger :: Integer -> Integer" + , "template" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.absInteger" + , "kind" : "Expression" + , "type" : "absInteger :: Integer -> Integer" + , "template" : "abs ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divInteger" + , "kind" : "Declaration" + , "type" : "divInteger :: Integer -> Integer -> Integer" + , "template" : +"-- divInteger begin +~GENSYM[divInteger][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); +end block; +-- divInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.modInteger" + , "kind" : "Expression" + , "type" : "modInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] mod ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.divModInteger" + , "kind" : "Declaration" + , "type" : "divModInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"-- divModInteger begin +~GENSYM[divModInteger][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYP[0]] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYP[0]] downto 0); + signal ~GENSYM[div_res][5] : signed(~SIZE[~TYP[0]]-1 downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~SYM[5] <= signed(~SYM[4](~SIZE[~TYP[0]]-1 downto 0)); + ~RESULT <= (~SYM[5], ~VAR[dividend][0] mod ~VAR[divider][1]); +end block; +-- divModInteger end" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.quotRemInteger" + , "kind" : "Expression" + , "type" : "quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.remInteger" + , "kind" : "Expression" + , "type" : "remInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger" + , "kind" : "Expression" + , "type" : "eqInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger" + , "kind" : "Expression" + , "type" : "neqInteger :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.eqInteger#" + , "kind" : "Declaration" + , "type" : "eqInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.neqInteger#" + , "kind" : "Declaration" + , "type" : "neqInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.leInteger#" + , "kind" : "Declaration" + , "type" : "leInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.gtInteger#" + , "kind" : "Declaration" + , "type" : "gtInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.ltInteger#" + , "kind" : "Declaration" + , "type" : "ltInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.geInteger#" + , "kind" : "Declaration" + , "type" : "geInteger# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftRInteger" + , "kind" : "Expression" + , "type" : "shiftRInteger :: Integer -> Int# -> Integer" + , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.shiftLInteger" + , "kind" : "Expression" + , "type" : "shiftLInteger :: Integer -> Int# -> Integer" + , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.testBitInteger" + , "kind" : "Expression" + , "type" : "testBitInteger :: Integer -> Int# -> Bool" + , "template" : "~VAR[input][0](to_integer(~ARG[1])) = '1'" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.wordToInteger" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "wordToInteger :: Word# -> Integer" + , "template" : "signed(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToWord" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToWord :: Integer -> Word#" + , "template" : "unsigned(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.integerToWord64" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToWord :: Integer -> Word64#" + , "comment" : "only used by 32 bit GHC" + , "template" : "unsigned(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.bitInteger" + , "kind" : "Expression" + , "type" : "bitInteger :: Int -> Integer" + , "template" : "shift_left(to_signed(1, ~SIZE[~TYPO]),to_integer(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.complementInteger" + , "kind" : "Expression" + , "type" : "complementInteger :: Integer -> Integer" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.xorInteger" + , "kind" : "Expression" + , "type" : "xorInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.orInteger" + , "kind" : "Expression" + , "type" : "orInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.andInteger" + , "kind" : "Expression" + , "type" : "andInteger :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Integer.Type.$wsignumInteger" + , "kind" : "Declaration" + , "type" : "$wsignumInteger :: Integer -> Integer" + , "template" : " +-- begin signumInteger +~RESULT <= to_signed(-1, ~SIZE[~TYPO]) when ~ARG[0] < 0 + else to_signed(0, ~SIZE[~TYPO]) when ~ARG[0] = 0 + else to_signed(1, ~SIZE[~TYPO]); +-- end signumInteger +" + } + } +] diff --git a/prims/vhdl/GHC_Natural.json b/prims/vhdl/GHC_Natural.json deleted file mode 100644 --- a/prims/vhdl/GHC_Natural.json +++ /dev/null @@ -1,32 +0,0 @@ -[ - { - "BlackBox": { - "name": "GHC.Natural.naturalFromInteger", - "workInfo" : "Never", - "kind": "Expression", - "type": "naturalFromInteger :: Integer -> Natural", - "template": "resize(unsigned(std_logic_vector(~ARG[0])),~SIZE[~TYPO])", - "warning": "GHC.Natural.naturalFromInteger: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "BlackBox": { - "name": "GHC.Natural.timesNatural", - "workInfo" : "Never", - "kind": "Expression", - "type": "timesNatural :: Natural -> Natural -> Natural", - "template": "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])", - "warning": "GHC.Natural.timesNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - }, - { - "BlackBox": { - "name": "GHC.Natural.wordToNatural#", - "workInfo" : "Never", - "kind": "Expression", - "type": "wordToNatural# :: Word# -> Natural", - "template": "unsigned(std_logic_vector(~ARG[0]))", - "warning": "GHC.Natural.wordToNatural#: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." - } - } -] diff --git a/prims/vhdl/GHC_Natural.primitives b/prims/vhdl/GHC_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Natural.primitives @@ -0,0 +1,32 @@ +[ + { + "BlackBox": { + "name": "GHC.Natural.naturalFromInteger", + "workInfo" : "Never", + "kind": "Expression", + "type": "naturalFromInteger :: Integer -> Natural", + "template": "resize(unsigned(std_logic_vector(~ARG[0])),~SIZE[~TYPO])", + "warning": "GHC.Natural.naturalFromInteger: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Natural.timesNatural", + "workInfo" : "Never", + "kind": "Expression", + "type": "timesNatural :: Natural -> Natural -> Natural", + "template": "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])", + "warning": "GHC.Natural.timesNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Natural.wordToNatural#", + "workInfo" : "Never", + "kind": "Expression", + "type": "wordToNatural# :: Word# -> Natural", + "template": "unsigned(std_logic_vector(~ARG[0]))", + "warning": "GHC.Natural.wordToNatural#: Naturals are dynamically sized in simulation, but fixed-length after synthesization. Use carefully." + } + } +] diff --git a/prims/vhdl/GHC_Num_Integer.primitives b/prims/vhdl/GHC_Num_Integer.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Num_Integer.primitives @@ -0,0 +1,317 @@ +[ { "BlackBox": + { "name": "GHC.Num.Integer.integerToNatural" + , "workInfo" : "Never" + , "kind": "Expression" + , "type": "integerToNatural :: Integer -> Natural" + , "template": "resize(unsigned(std_logic_vector(~ARG[0])),~SIZE[~TYPO])" + , "warning": "GHC.Num.Integer.integerToNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } + , { "BlackBox": + { "name": "GHC.Num.Integer.integerToNaturalThrow" + , "workInfo" : "Never" + , "kind": "Declaration" + , "type": "integerToNaturalThrow :: Integer -> Natural" + , "template": +"-- integerToNaturalThrow begin +~RESULT <= ~ERRORO when ~ARG[0] < ~SIZE[~TYP[0]]'d0 else + resize(unsigned(std_logic_vector(~ARG[0])),~SIZE[~TYPO]); +-- integerToNaturalThrow end" + , "warning": "GHC.Num.Integer.integerToNaturalThrow: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } +, { "BlackBox": + { "name": "GHC.Num.Integer.integerToNaturalClamp" + , "workInfo" : "Never" + , "kind": "Declaration" + , "type": "integerToNatural :: Integer -> Natural" + , "template": +"-- integerToNaturalClamp begin +~RESULT <= to_unsigned(0,~SIZE[~TYPO]]) when ~ARG[0] < ~SIZE[~TYP[0]]'d0 else + resize(unsigned(std_logic_vector(~ARG[0])),~SIZE[~TYPO]); +-- integerToNaturalClamp end" + , "warning": "GHC.Num.Integer.integerToNaturalClamp: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToInt#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToInt :: Integer -> Int#" + , "template" : "~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerMul" + , "kind" : "Expression" + , "type" : "integerMul :: Integer -> Integer -> Integer" + , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNegate" + , "kind" : "Expression" + , "type" : "integerNegate :: Integer -> Integer" + , "template" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerAbs" + , "kind" : "Expression" + , "type" : "integerAbs :: Integer -> Integer" + , "template" : "abs ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDiv" + , "kind" : "Declaration" + , "type" : "integerDiv :: Integer -> Integer -> Integer" + , "template" : +"-- integerDiv begin +~GENSYM[integerDiv][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYPO] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYPO] downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYPO]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYPO]+1) - resize(~VAR[divider][1],~SIZE[~TYPO]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~RESULT <= signed(~SYM[4](~SIZE[~TYPO]-1 downto 0)); +end block; +-- integerDiv end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerMod" + , "kind" : "Expression" + , "type" : "integerMod :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] mod ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerDivMod#" + , "kind" : "Declaration" + , "type" : "integerDivMod :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : +"-- integerDivMod begin +~GENSYM[integerDivMod][0] : block + signal ~GENSYM[resultPos][1] : boolean; + signal ~GENSYM[dividerNeg][2] : boolean; + signal ~GENSYM[dividend2][3] : signed(~SIZE[~TYP[0]] downto 0); + signal ~GENSYM[quot_res][4] : signed(~SIZE[~TYP[0]] downto 0); + signal ~GENSYM[div_res][5] : signed(~SIZE[~TYP[0]]-1 downto 0); +begin + ~SYM[1] <= ~VAR[dividend][0](~VAR[dividend][0]'high) = ~VAR[divider][1](~VAR[divider][1]'high); + ~SYM[2] <= ~VAR[divider][1](~VAR[divider][1]'high) = '1'; + ~SYM[3] <= resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) when ~SYM[1] else + (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) - 1) when ~SYM[2] else + (resize(~VAR[dividend][0],~SIZE[~TYP[0]]+1) - resize(~VAR[divider][1],~SIZE[~TYP[0]]+1) + 1); + ~SYM[4] <= ~SYM[3] / ~VAR[divider][1]; + ~SYM[5] <= signed(~SYM[4](~SIZE[~TYP[0]]-1 downto 0)); + ~RESULT <= (~SYM[5], ~VAR[dividend][0] mod ~VAR[divider][1]); +end block; +-- integerDivMod end" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerQuotRem#" + , "kind" : "Expression" + , "type" : "integerQuotRem :: Integer -> Integer -> (# Integer, Integer #)" + , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerRem" + , "kind" : "Expression" + , "type" : "integerRem :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerEq" + , "kind" : "Expression" + , "type" : "integerEq :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] = ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNe" + , "kind" : "Expression" + , "type" : "integerNe :: Integer -> Integer -> Bool" + , "template" : "~ARG[0] /= ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerEq#" + , "kind" : "Declaration" + , "type" : "integerEq# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerNe#" + , "kind" : "Declaration" + , "type" : "integerNe# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLe#" + , "kind" : "Declaration" + , "type" : "integerLe# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGt#" + , "kind" : "Declaration" + , "type" : "integerGt# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLt#" + , "kind" : "Declaration" + , "type" : "integerLt# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerGe#" + , "kind" : "Declaration" + , "type" : "integerGe# :: Integer -> Integer -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerShiftR#" + , "kind" : "Expression" + , "type" : "integerShiftR :: Integer -> Word# -> Integer" + , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerShiftL#" + , "kind" : "Expression" + , "type" : "integerShiftR :: Integer -> Word# -> Integer" + , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerTestBit#" + , "kind" : "Expression" + , "type" : "integerTestBit :: Integer -> Word# -> Bool" + , "template" : "~VAR[input][0](to_integer(~ARG[1])) = '1'" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerFromWord#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerFromWord :: Word# -> Integer" + , "template" : "signed(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToWord#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToWord :: Integer -> Word#" + , "template" : "unsigned(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerToWord64#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "integerToWord :: Integer -> Word64#" + , "comment" : "only used by 32 bit GHC" + , "template" : "unsigned(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerBit#" + , "kind" : "Expression" + , "type" : "integerBit :: Word# -> Integer" + , "template" : "shift_left(to_signed(1, ~SIZE[~TYPO]),to_integer(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerComplement" + , "kind" : "Expression" + , "type" : "integerComplement :: Integer -> Integer" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerXor" + , "kind" : "Expression" + , "type" : "integerXor :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerOr" + , "kind" : "Expression" + , "type" : "integerOr :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerAnd" + , "kind" : "Expression" + , "type" : "integerAnd :: Integer -> Integer -> Integer" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerSigmum" + , "kind" : "Declaration" + , "type" : "integerSigmum :: Integer -> Integer" + , "template" : " +-- begin integerSigmum +~RESULT <= to_signed(-1, ~SIZE[~TYPO]) when ~ARG[0] < 0 + else to_signed(0, ~SIZE[~TYPO]) when ~ARG[0] = 0 + else to_signed(1, ~SIZE[~TYPO]); +-- end integerSigmum +" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.$wintegerSignum" + , "kind" : "Declaration" + , "type" : "$wsignumInteger :: Integer -> Int#" + , "template" : " +-- begin signumInteger +~RESULT <= to_signed(-1, ~SIZE[~TYPO]) when ~ARG[0] < 0 + else to_signed(0, ~SIZE[~TYPO]) when ~ARG[0] = 0 + else to_signed(1, ~SIZE[~TYPO]); +-- end signumInteger +" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerLogBase#" + , "kind" : "Expression" + , "type" : "integerLogBase# :: Integer -> Integer -> Int#" + , "template" : "integer(floor(log(real(~ARG[1]),real(~ARG[0]))))" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Integer.integerCompare" + , "kind" : "Declaration" + , "type" : "integerCompare :: Integer -> Integer -> Ordering" + , "template" : " +-- begin integerCompare +~RESULT <= \"00\" when ~ARG[0] < ~ARG[1] else + \"01\" when ~ARG[0] = ~ARG[1] else + \"10\"; +-- end integerCompare +" + } + } +] diff --git a/prims/vhdl/GHC_Num_Natural.primitives b/prims/vhdl/GHC_Num_Natural.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Num_Natural.primitives @@ -0,0 +1,97 @@ +[ + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalMul", + "kind": "Expression", + "type": "timesNatural :: Natural -> Natural -> Natural", + "template": "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])", + "warning": "GHC.Num.Natural.timesNatural: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + }, + { + "BlackBox": { + "name": "GHC.Num.Natural.naturalFromWord#", + "workInfo" : "Never", + "kind": "Expression", + "type": "naturalFromWord# :: Word# -> Natural", + "template": "unsigned(std_logic_vector(~ARG[0]))", + "warning": "GHC.Num.Natural.naturalFromWord#: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } + , { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalRem" + , "kind" : "Expression" + , "type" : "naturalRem :: Natural -> Natural -> Natural" + , "template" : "~ARG[0] rem ~ARG[1]" + , "warning": "GHC.Num.Natural.naturalRem: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully." + } + } + , { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLogBase#" + , "kind" : "Expression" + , "type" : "naturalLogBase# :: Natural -> Natural -> Word#" + , "template" : "to_unsigned(integer(floor(log(real(to_integer(~ARG[1])),real(to_integer(~ARG[0]))))),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalEq#" + , "kind" : "Declaration" + , "type" : "naturalEq# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalNe#" + , "kind" : "Declaration" + , "type" : "naturalNe# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLe#" + , "kind" : "Declaration" + , "type" : "naturalLe# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalGt#" + , "kind" : "Declaration" + , "type" : "naturalGt# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalLt#" + , "kind" : "Declaration" + , "type" : "naturalLt# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalGe#" + , "kind" : "Declaration" + , "type" : "naturalGe# :: Natural -> Natural -> Int#" + , "template" : "~RESULT <= to_unsigned(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_unsigned(0,~SIZE[~TYPO]);" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalShiftL#" + , "kind" : "Expression" + , "type" : "naturalShiftL :: Natural -> Word# -> Natural" + , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" + } +} +, { "BlackBox" : + { "name" : "GHC.Num.Natural.naturalCompare" + , "kind" : "Declaration" + , "type" : "naturalCompare :: Natural -> Natural -> Ordering" + , "template" : +"-- begin naturalCompare +~RESULT <= \"00\" when ~ARG[0] < ~ARG[1] else + \"01\" when ~ARG[0] = ~ARG[1] else + \"10\"; +-- end naturalCompare" + } +} +] diff --git a/prims/vhdl/GHC_Prim.json b/prims/vhdl/GHC_Prim.json deleted file mode 100644 --- a/prims/vhdl/GHC_Prim.json +++ /dev/null @@ -1,1218 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Prim.gtChar#" - , "kind" : "Declaration" - , "type" : "gtChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.geChar#" - , "kind" : "Declaration" - , "type" : "geChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.eqChar#" - , "kind" : "Declaration" - , "type" : "eqChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.neChar#" - , "kind" : "Declaration" - , "type" : "neChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ltChar#" - , "kind" : "Declaration" - , "type" : "ltChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.leChar#" - , "kind" : "Declaration" - , "type" : "leChar# :: Char# -> Char# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ord#" - , "kind" : "Expression" - , "type" : "ord# :: Char# -> Int#" - , "template" : "signed(std_logic_vector(resize(~ARG[0],~SIZE[~TYPO])))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.*#" - , "kind" : "Expression" - , "type" : "(*#) :: Int# -> Int# -> Int#" - , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.remInt#" - , "kind" : "Expression" - , "type" : "remInt# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotRemInt#" - , "kind" : "Expression" - , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" - , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.andI#" - , "kind" : "Expression" - , "type" : "and# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.orI#" - , "kind" : "Expression" - , "type" : "or# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.xorI#" - , "kind" : "Expression" - , "type" : "xor# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.notI#" - , "kind" : "Expression" - , "type" : "not# :: Int# -> Int#" - , "template" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.negateInt#" - , "kind" : "Expression" - , "type" : "negateInt# :: Int# -> Int#" - , "template" : "-~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>#" - , "kind" : "Declaration" - , "type" : "(>#) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.>=#" - , "kind" : "Declaration" - , "type" : "(>=#) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.==#" - , "kind" : "Declaration" - , "type" : "(==) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim./=#" - , "kind" : "Declaration" - , "type" : "(/=#) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<#" - , "kind" : "Declaration" - , "type" : "(<#) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.<=#" - , "kind" : "Declaration" - , "type" : "(<=#) :: Int# -> Int# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.chr#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "ord# :: Int# -> Chr#" - , "template" : "resize(unsigned(std_logic_vector(~ARG[0])),21)" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.int2Word#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "word2Int# :: Int# -> Word#" - , "template" : "unsigned(std_logic_vector(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftL#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftL# :: Int# -> Int# -> Int#" - , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftRA#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftRA# :: Int# -> Int# -> Int#" - , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedIShiftRL#" - , "kind" : "Expression" - , "type" : "uncheckedIShiftRL# :: Int# -> Int# -> Int#" - , "template" : "~ARG[0] srl to_integer(~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.timesWord#" - , "kind" : "Expression" - , "type" : "timesWord# :: Word# -> Word# -> Word#" - , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.remWord#" - , "kind" : "Expression" - , "type" : "remWord# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] rem ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.quotRemWord#" - , "kind" : "Expression" - , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" - , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.and#" - , "kind" : "Expression" - , "type" : "and# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] and ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.or#" - , "kind" : "Expression" - , "type" : "or# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] or ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.xor#" - , "kind" : "Expression" - , "type" : "xor# :: Word# -> Word# -> Word#" - , "template" : "~ARG[0] xor ~ARG[1]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.not#" - , "kind" : "Expression" - , "type" : "not# :: Word# -> Word#" - , "template" : "not ~ARG[0]" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedShiftL#" - , "kind" : "Expression" - , "type" : "uncheckedShiftL# :: Word# -> Int# -> Word#" - , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.uncheckedShiftRL#" - , "kind" : "Expression" - , "type" : "uncheckedShiftR# :: Word# -> Int# -> Word#" - , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.word2Int#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "word2Int# :: word# -> Int#" - , "template" : "signed(std_logic_vector(~ARG[0]))" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.gtWord#" - , "kind" : "Declaration" - , "type" : "gtWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.geWord#" - , "kind" : "Declaration" - , "type" : "geWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.eqWord#" - , "kind" : "Declaration" - , "type" : "eqWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.neWord#" - , "kind" : "Declaration" - , "type" : "neWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ltWord#" - , "kind" : "Declaration" - , "type" : "ltWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.leWord#" - , "kind" : "Declaration" - , "type" : "leWord# :: Word# -> Word# -> Int#" - , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt8#" - , "kind" : "Declaration" - , "type" : "popCnt8 :: Word# -> Word#" - , "template" : -"-- popCnt8 begin -~GENSYM[popCnt8][0] : block - -- given a level and a depth, calculate the corresponding index into the - -- intermediate array - function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is - begin - return (2 ** levels - 2 ** depth); - end function; - - constant ~GENSYM[width][2] : natural := 8; - constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); - type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); - signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); -begin - -- put input into the first half of the intermediate array - ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate - ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); - end generate; - - -- Create the tree of adders - ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate - ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate - ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); - end generate; - end generate; - end generate; - - -- The last element of the intermediate array holds the result - ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); -end block; --- popCnt8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt16#" - , "kind" : "Declaration" - , "type" : "popCnt16 :: Word# -> Word#" - , "template" : -"-- popCnt16 begin -~GENSYM[popCnt16][0] : block - -- given a level and a depth, calculate the corresponding index into the - -- intermediate array - function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is - begin - return (2 ** levels - 2 ** depth); - end function; - - constant ~GENSYM[width][2] : natural := 16; - constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); - type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); - signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); -begin - -- put input into the first half of the intermediate array - ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate - ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); - end generate; - - -- Create the tree of adders - ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate - ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate - ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); - end generate; - end generate; - end generate; - - -- The last element of the intermediate array holds the result - ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); -end block; --- popCnt16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt32#" - , "kind" : "Declaration" - , "type" : "popCnt32 :: Word# -> Word#" - , "template" : -"-- popCnt32 begin -~GENSYM[popCnt32][0] : block - -- given a level and a depth, calculate the corresponding index into the - -- intermediate array - function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is - begin - return (2 ** levels - 2 ** depth); - end function; - - constant ~GENSYM[width][2] : natural := 32; - constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); - type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); - signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); -begin - -- put input into the first half of the intermediate array - ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate - ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); - end generate; - - -- Create the tree of adders - ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate - ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate - ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); - end generate; - end generate; - end generate; - - -- The last element of the intermediate array holds the result - ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); -end block; --- popCnt32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt64#" - , "kind" : "Declaration" - , "type" : "popCnt64 :: Word# -> Word#" - , "template" : -"-- popCnt64 begin -~GENSYM[popCnt64][0] : block - -- given a level and a depth, calculate the corresponding index into the - -- intermediate array - function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is - begin - return (2 ** levels - 2 ** depth); - end function; - - constant ~GENSYM[width][2] : natural := 64; - constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); - type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); - signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); -begin - -- put input into the first half of the intermediate array - ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate - ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); - end generate; - - -- Create the tree of adders - ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate - ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate - ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); - end generate; - end generate; - end generate; - - -- The last element of the intermediate array holds the result - ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); -end block; --- popCnt64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.popCnt#" - , "kind" : "Declaration" - , "type" : "popCnt :: Word# -> Word#" - , "template" : -"-- popCnt begin -~GENSYM[popCnt][0] : block - -- given a level and a depth, calculate the corresponding index into the - -- intermediate array - function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is - begin - return (2 ** levels - 2 ** depth); - end function; - - constant ~GENSYM[width][2] : natural := ~SIZE[~TYPO]; - constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); - type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); - signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); -begin - -- put input into the first half of the intermediate array - ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate - ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); - end generate; - - -- Create the tree of adders - ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate - ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate - ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + - ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); - end generate; - end generate; - end generate; - - -- The last element of the intermediate array holds the result - ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); -end block; --- popCnt end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz8#" - , "kind" : "Declaration" - , "type" : "clz8 :: Word# -> Word#" - , "template" : -"-- clz8 begin -~GENSYM[clz8][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz8][3] (constant v : unsigned(0 to 7)) return unsigned is - variable e : unsigned(0 to 7); -- 8 - variable a : unsigned(0 to 2*3-1); -- 6 - begin - for i in 0 to 3 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 1 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - return ~SYM[2](3,a(0 to 5)); - end function; -begin - ~RESULT <= resize(~SYM[3](~ARG[0](7 downto 0)),~SIZE[~TYPO]); -end block; --- clz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz16#" - , "kind" : "Declaration" - , "type" : "clz16 :: Word# -> Word#" - , "template" : -"-- clz16 begin -~GENSYM[clz16][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz16][3] (constant v : unsigned(0 to 15)) return unsigned is - variable e : unsigned(0 to 15); -- 16 - variable a : unsigned(0 to 4*3-1); -- 12 - variable b : unsigned(0 to 2*4-1); -- 8 - begin - for i in 0 to 7 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 3 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 1 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - return ~SYM[2](4,b(0 to 7)); - end function; -begin - ~RESULT <= resize(~SYM[3](~ARG[0](15 downto 0)),~SIZE[~TYPO]); -end block; --- clz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz32#" - , "kind" : "Declaration" - , "type" : "clz32 :: Word# -> Word#" - , "template" : -"-- clz32 begin -~GENSYM[clz32][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz32][3] (constant v : unsigned(0 to 31)) return unsigned is - variable e : unsigned(0 to 31); -- 32 - variable a : unsigned(0 to 8*3-1); -- 24 - variable b : unsigned(0 to 4*4-1); -- 16 - variable c : unsigned(0 to 2*5-1); -- 10 - begin - for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - return ~SYM[2](5,c(0 to 9)); - end function; -begin - ~RESULT <= resize(~SYM[3](~ARG[0](31 downto 0)),~SIZE[~TYPO]); -end block; --- clz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz64#" - , "kind" : "Declaration" - , "type" : "clz64 :: Word# -> Word#" - , "template" : -"-- clz64 begin -~GENSYM[clz64][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is - variable e : unsigned(0 to 63); -- 64 - variable a : unsigned(0 to 16*3-1); -- 48 - variable b : unsigned(0 to 8*4-1); -- 32 - variable c : unsigned(0 to 4*5-1); -- 20 - variable d : unsigned(0 to 2*6-1); -- 12 - begin - for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; - return ~SYM[2](6,d(0 to 11)); - end function; -begin - ~RESULT <= resize(~SYM[3](~ARG[0]),~SIZE[~TYPO]); -end block; --- clz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.clz#" - , "kind" : "Declaration" - , "type" : "clz :: Word# -> Word#" - , "template" : -"-- clz begin -~GENSYM[clz][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; -~IF ~IW64 ~THEN - function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is - variable e : unsigned(0 to 63); -- 64 - variable a : unsigned(0 to 16*3-1); -- 48 - variable b : unsigned(0 to 8*4-1); -- 32 - variable c : unsigned(0 to 4*5-1); -- 20 - variable d : unsigned(0 to 2*6-1); -- 12 - begin - for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; - return ~SYM[2](6,d(0 to 11)); - end function; -~ELSE - function ~GENSYM[clz32][4] (constant v : unsigned(0 to 31)) return unsigned is - variable e : unsigned(0 to 31); -- 32 - variable a : unsigned(0 to 8*3-1); -- 24 - variable b : unsigned(0 to 4*4-1); -- 16 - variable c : unsigned(0 to 2*5-1); -- 10 - begin - for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - return ~SYM[2](5,c(0 to 9)); - end function; -~FI -begin -~IF ~IW64 ~THEN - ~RESULT <= resize(~SYM[3](~ARG[0]),~SIZE[~TYPO]); -~ELSE - ~RESULT <= resize(~SYM[4](~ARG[0]),~SIZE[~TYPO]); -~FI -end block; --- clz end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz8#" - , "kind" : "Declaration" - , "type" : "ctz8 :: Word# -> Word#" - , "template" : -"-- ctz8 begin -~GENSYM[ctz8][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz8][3] (constant v : unsigned(0 to 7)) return unsigned is - variable e : unsigned(0 to 7); -- 8 - variable a : unsigned(0 to 2*3-1); -- 6 - begin - for i in 0 to 3 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 1 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - return ~SYM[2](3,a(0 to 5)); - end function; - - signal ~GENSYM[w_reversed][5] : ~TYP[0]; -begin - ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate - ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); - end generate; -~IF ~IW64 ~THEN - ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 56)),~SIZE[~TYPO]); -~ELSE - ~RESULT <= resize(~SYM[3](~SYM[5](31 downto 24)),~SIZE[~TYPO]); -~FI -end block; --- ctz8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz16#" - , "kind" : "Declaration" - , "type" : "ctz16 :: Word# -> Word#" - , "template" : -"-- ctz16 begin -~GENSYM[ctz16][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz16][3] (constant v : unsigned(0 to 15)) return unsigned is - variable e : unsigned(0 to 15); -- 16 - variable a : unsigned(0 to 4*3-1); -- 12 - variable b : unsigned(0 to 2*4-1); -- 8 - begin - for i in 0 to 7 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 3 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 1 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - return ~SYM[2](4,b(0 to 7)); - end function; - - signal ~GENSYM[w_reversed][5] : ~TYP[0]; -begin - ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate - ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); - end generate; -~IF ~IW64 ~THEN - ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 48)),~SIZE[~TYPO]); -~ELSE - ~RESULT <= resize(~SYM[3](~SYM[5](31 downto 16)),~SIZE[~TYPO]); -~FI -end block; --- ctz16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz32#" - , "kind" : "Declaration" - , "type" : "ctz32 :: Word# -> Word#" - , "template" : -"-- ctz32 begin -~GENSYM[ctz32][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz32][3] (constant v : unsigned(0 to 31)) return unsigned is - variable e : unsigned(0 to 31); -- 32 - variable a : unsigned(0 to 8*3-1); -- 24 - variable b : unsigned(0 to 4*4-1); -- 16 - variable c : unsigned(0 to 2*5-1); -- 10 - begin - for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - return ~SYM[2](5,c(0 to 9)); - end function; - - signal ~GENSYM[w_reversed][5] : ~TYP[0]; -begin - ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate - ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[3]); - end generate; -~IF ~IW64 ~THEN - ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 32)),~SIZE[~TYPO]); -~ELSE - ~RESULT <= resize(~SYM[3](~SYM[5]),~SIZE[~TYPO]); -~FI -end block; --- ctz32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz64#" - , "kind" : "Declaration" - , "type" : "ctz64 :: Word# -> Word#" - , "template" : -"-- ctz64 begin -~GENSYM[ctz64][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - - function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is - variable e : unsigned(0 to 63); -- 64 - variable a : unsigned(0 to 16*3-1); -- 48 - variable b : unsigned(0 to 8*4-1); -- 32 - variable c : unsigned(0 to 4*5-1); -- 20 - variable d : unsigned(0 to 2*6-1); -- 12 - begin - for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; - return ~SYM[2](6,d(0 to 11)); - end function; - - signal ~GENSYM[w_reversed][5] : ~TYP[0]; -begin - ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate - ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); - end generate; - - ~RESULT <= resize(~SYM[3](~SYM[5]),~SIZE[~TYPO]); -end block; --- ctz64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.ctz#" - , "kind" : "Declaration" - , "type" : "ctz :: Word# -> Word#" - , "template" : -"-- ctz begin -~GENSYM[ctz][0] : block - function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is - begin - case a is - when \"00\" => return \"10\"; - when \"01\" => return \"01\"; - when \"10\" => return \"00\"; - when others => return \"00\"; - end case; - end function; - - function ~GENSYM[clzi][2] ( - constant n : in natural; - constant i : in unsigned) return unsigned is - variable v : unsigned(i'length-1 downto 0):=i; - begin - if v(n-1+n)='0' then - return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); - else - return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); - end if; - end function; - -~IF ~IW64 ~THEN - function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is - variable e : unsigned(0 to 63); -- 64 - variable a : unsigned(0 to 16*3-1); -- 48 - variable b : unsigned(0 to 8*4-1); -- 32 - variable c : unsigned(0 to 4*5-1); -- 20 - variable d : unsigned(0 to 2*6-1); -- 12 - begin - for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; - return ~SYM[2](6,d(0 to 11)); - end function; -~ELSE - function ~GENSYM[clz32][4] (constant v : unsigned(0 to 31)) return unsigned is - variable e : unsigned(0 to 31); -- 32 - variable a : unsigned(0 to 8*3-1); -- 24 - variable b : unsigned(0 to 4*4-1); -- 16 - variable c : unsigned(0 to 2*5-1); -- 10 - begin - for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; - for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; - for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; - for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; - return ~SYM[2](5,c(0 to 9)); - end function; -~FI - - signal ~GENSYM[w_reversed][6] : ~TYP[0]; -begin - ~GENSYM[reverse_loop][7] : for ~GENSYM[n][8] in ~VAR[w][0]'range generate - ~SYM[6](~VAR[w][0]'high - ~SYM[8]) <= ~VAR[w][0](~SYM[8]); - end generate; -~IF ~IW64 ~THEN - ~RESULT <= resize(~SYM[3](~SYM[6]),~SIZE[~TYPO]); -~ELSE - ~RESULT <= resize(~SYM[4](~SYM[6]),~SIZE[~TYPO]); -~FI -end block; --- ctz end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap16#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap16# :: Word# -> Word#" - , "template" : -"-- byteSwap16 begin~IF ~IW64 ~THEN -~RESULT <= ~VAR[w][0](63 downto 16) & ~VAR[w][0](7 downto 0) & ~VAR[w][0](15 downto 8);~ELSE -~RESULT <= ~VAR[w][0](31 downto 16) & ~VAR[w][0](7 downto 0) & ~VAR[w][0](15 downto 8);~FI --- byteSwap16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap32#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap32# :: Word# -> Word#" - , "template" : -"-- byteSwap32 begin~IF ~IW64 ~THEN -~RESULT <= ~VAR[w][0](63 downto 32) & ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) - & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~ELSE -~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) - & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~FI --- byteSwap32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap64#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap64# :: Word# -> Word#" - , "template" : -"-- byteSwap64 begin -~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) - & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24) - & ~VAR[w][0](39 downto 32) & ~VAR[w][0](47 downto 40) - & ~VAR[w][0](55 downto 48) & ~VAR[w][0](63 downto 56); --- byteSwap64 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.byteSwap#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "byteSwap# :: Word# -> Word#" - , "template" : -"-- byteSwap begin ~IF ~IW64 ~THEN -~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) - & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24) - & ~VAR[w][0](39 downto 32) & ~VAR[w][0](47 downto 40) - & ~VAR[w][0](55 downto 48) & ~VAR[w][0](63 downto 56);~ELSE -~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) - & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~FI --- byteSwap end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow8Int#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow8Int# :: Int# -> Int#" - , "template" : "resize(~VAR[i][0](7 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow16Int#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow16Int# :: Int# -> Int#" - , "template" : "resize(~VAR[i][0](15 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow32Int#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow32Int# :: Int# -> Int#" - , "template" : "resize(~VAR[i][0](31 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow8Word#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow8Word# :: Word# -> Word#" - , "template" : "resize(~VAR[w][0](7 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow16Word#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow16Word# :: Word# -> Word#" - , "template" : "resize(~VAR[w][0](15 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.narrow32Word#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "narrow32Word# :: Word# -> Word#" - , "template" : "resize(~VAR[w][0](31 downto 0),~SIZE[~TYPO])" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse# :: Word# -> Word#" - , "template" : -"-- bitReverse begin -~GENSYM[bitReverse][0] : for ~GENSYM[i][1] in 0 to ~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI generate -begin -~RESULT(~SYM[1]) <= ~VAR[x][0](~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI-~SYM[1]); -end generate; --- bitReverse end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse8#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse8# :: Word# -> Word#" - , "template" : -"-- bitReverse8 begin -~GENSYM[bitReverse8][0] : for ~GENSYM[i][1] in 0 to 7 generate -begin -~RESULT(~SYM[1]) <= ~VAR[x][0](7-~SYM[1]); -end generate; --- bitReverse8 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse16#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse16# :: Word# -> Word#" - , "template" : -"-- bitReverse16 begin -~GENSYM[bitReverse16][0] : for ~GENSYM[i][1] in 0 to 15 generate -begin -~RESULT(~SYM[1]) <= ~VAR[x][0](15-~SYM[1]); -end generate; --- bitReverse16 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse32#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse32# :: Word# -> Word#" - , "template" : -"-- bitReverse32 begin -~GENSYM[bitReverse32][0] : for ~GENSYM[i][1] in 0 to 31 generate -begin -~RESULT(~SYM[1]) <= ~VAR[x][0](31-~SYM[1]); -end generate; --- bitReverse32 end" - } - } -, { "BlackBox" : - { "name" : "GHC.Prim.bitReverse64#" - , "workInfo" : "Never" - , "kind" : "Declaration" - , "type" : "bitReverse64# :: Word# -> Word#" - , "template" : -"-- bitReverse64 begin -~GENSYM[bitReverse64][0] : for ~GENSYM[i][1] in 0 to 63 generate -begin -~RESULT(~SYM[1]) <= ~VAR[x][0](63-~SYM[1]); -end generate; --- bitReverse64 end" - } - } -] diff --git a/prims/vhdl/GHC_Prim.primitives b/prims/vhdl/GHC_Prim.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Prim.primitives @@ -0,0 +1,1218 @@ +[ { "BlackBox" : + { "name" : "GHC.Prim.gtChar#" + , "kind" : "Declaration" + , "type" : "gtChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.geChar#" + , "kind" : "Declaration" + , "type" : "geChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.eqChar#" + , "kind" : "Declaration" + , "type" : "eqChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.neChar#" + , "kind" : "Declaration" + , "type" : "neChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ltChar#" + , "kind" : "Declaration" + , "type" : "ltChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.leChar#" + , "kind" : "Declaration" + , "type" : "leChar# :: Char# -> Char# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ord#" + , "kind" : "Expression" + , "type" : "ord# :: Char# -> Int#" + , "template" : "signed(std_logic_vector(resize(~ARG[0],~SIZE[~TYPO])))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.*#" + , "kind" : "Expression" + , "type" : "(*#) :: Int# -> Int# -> Int#" + , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remInt#" + , "kind" : "Expression" + , "type" : "remInt# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotRemInt#" + , "kind" : "Expression" + , "type" : "quotRemInt# :: Int# -> Int# -> (#Int#, Int##)" + , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.andI#" + , "kind" : "Expression" + , "type" : "and# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.orI#" + , "kind" : "Expression" + , "type" : "or# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.xorI#" + , "kind" : "Expression" + , "type" : "xor# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.notI#" + , "kind" : "Expression" + , "type" : "not# :: Int# -> Int#" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.negateInt#" + , "kind" : "Expression" + , "type" : "negateInt# :: Int# -> Int#" + , "template" : "-~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>#" + , "kind" : "Declaration" + , "type" : "(>#) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.>=#" + , "kind" : "Declaration" + , "type" : "(>=#) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.==#" + , "kind" : "Declaration" + , "type" : "(==) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim./=#" + , "kind" : "Declaration" + , "type" : "(/=#) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<#" + , "kind" : "Declaration" + , "type" : "(<#) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.<=#" + , "kind" : "Declaration" + , "type" : "(<=#) :: Int# -> Int# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.chr#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "ord# :: Int# -> Chr#" + , "template" : "resize(unsigned(std_logic_vector(~ARG[0])),21)" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.int2Word#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "word2Int# :: Int# -> Word#" + , "template" : "unsigned(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftL#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftL# :: Int# -> Int# -> Int#" + , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftRA#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftRA# :: Int# -> Int# -> Int#" + , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedIShiftRL#" + , "kind" : "Expression" + , "type" : "uncheckedIShiftRL# :: Int# -> Int# -> Int#" + , "template" : "~ARG[0] srl to_integer(~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.timesWord#" + , "kind" : "Expression" + , "type" : "timesWord# :: Word# -> Word# -> Word#" + , "template" : "resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.remWord#" + , "kind" : "Expression" + , "type" : "remWord# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] rem ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.quotRemWord#" + , "kind" : "Expression" + , "type" : "quotRemWord# :: Word# -> Word# -> (#Word#, Word##)" + , "template" : "(~ARG[0] / ~ARG[1], ~ARG[0] rem ~ARG[1])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.and#" + , "kind" : "Expression" + , "type" : "and# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] and ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.or#" + , "kind" : "Expression" + , "type" : "or# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] or ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.xor#" + , "kind" : "Expression" + , "type" : "xor# :: Word# -> Word# -> Word#" + , "template" : "~ARG[0] xor ~ARG[1]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.not#" + , "kind" : "Expression" + , "type" : "not# :: Word# -> Word#" + , "template" : "not ~ARG[0]" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedShiftL#" + , "kind" : "Expression" + , "type" : "uncheckedShiftL# :: Word# -> Int# -> Word#" + , "template" : "shift_left(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.uncheckedShiftRL#" + , "kind" : "Expression" + , "type" : "uncheckedShiftR# :: Word# -> Int# -> Word#" + , "template" : "shift_right(~ARG[0],to_integer(~ARG[1]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.word2Int#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "word2Int# :: word# -> Int#" + , "template" : "signed(std_logic_vector(~ARG[0]))" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.gtWord#" + , "kind" : "Declaration" + , "type" : "gtWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] > ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.geWord#" + , "kind" : "Declaration" + , "type" : "geWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] >= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.eqWord#" + , "kind" : "Declaration" + , "type" : "eqWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] = ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.neWord#" + , "kind" : "Declaration" + , "type" : "neWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] /= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ltWord#" + , "kind" : "Declaration" + , "type" : "ltWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] < ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.leWord#" + , "kind" : "Declaration" + , "type" : "leWord# :: Word# -> Word# -> Int#" + , "template" : "~RESULT <= to_signed(1,~SIZE[~TYPO]) when ~ARG[0] <= ~ARG[1] else to_signed(0,~SIZE[~TYPO]);" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt8#" + , "kind" : "Declaration" + , "type" : "popCnt8 :: Word# -> Word#" + , "template" : +"-- popCnt8 begin +~GENSYM[popCnt8][0] : block + -- given a level and a depth, calculate the corresponding index into the + -- intermediate array + function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is + begin + return (2 ** levels - 2 ** depth); + end function; + + constant ~GENSYM[width][2] : natural := 8; + constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); + type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); + signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); +begin + -- put input into the first half of the intermediate array + ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate + ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); + end generate; + + -- Create the tree of adders + ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate + ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate + ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); + end generate; + end generate; + end generate; + + -- The last element of the intermediate array holds the result + ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); +end block; +-- popCnt8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt16#" + , "kind" : "Declaration" + , "type" : "popCnt16 :: Word# -> Word#" + , "template" : +"-- popCnt16 begin +~GENSYM[popCnt16][0] : block + -- given a level and a depth, calculate the corresponding index into the + -- intermediate array + function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is + begin + return (2 ** levels - 2 ** depth); + end function; + + constant ~GENSYM[width][2] : natural := 16; + constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); + type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); + signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); +begin + -- put input into the first half of the intermediate array + ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate + ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); + end generate; + + -- Create the tree of adders + ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate + ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate + ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); + end generate; + end generate; + end generate; + + -- The last element of the intermediate array holds the result + ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); +end block; +-- popCnt16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt32#" + , "kind" : "Declaration" + , "type" : "popCnt32 :: Word# -> Word#" + , "template" : +"-- popCnt32 begin +~GENSYM[popCnt32][0] : block + -- given a level and a depth, calculate the corresponding index into the + -- intermediate array + function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is + begin + return (2 ** levels - 2 ** depth); + end function; + + constant ~GENSYM[width][2] : natural := 32; + constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); + type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); + signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); +begin + -- put input into the first half of the intermediate array + ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate + ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); + end generate; + + -- Create the tree of adders + ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate + ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate + ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); + end generate; + end generate; + end generate; + + -- The last element of the intermediate array holds the result + ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); +end block; +-- popCnt32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt64#" + , "kind" : "Declaration" + , "type" : "popCnt64 :: Word# -> Word#" + , "template" : +"-- popCnt64 begin +~GENSYM[popCnt64][0] : block + -- given a level and a depth, calculate the corresponding index into the + -- intermediate array + function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is + begin + return (2 ** levels - 2 ** depth); + end function; + + constant ~GENSYM[width][2] : natural := 64; + constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); + type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); + signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); +begin + -- put input into the first half of the intermediate array + ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate + ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); + end generate; + + -- Create the tree of adders + ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate + ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate + ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); + end generate; + end generate; + end generate; + + -- The last element of the intermediate array holds the result + ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); +end block; +-- popCnt64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.popCnt#" + , "kind" : "Declaration" + , "type" : "popCnt :: Word# -> Word#" + , "template" : +"-- popCnt begin +~GENSYM[popCnt][0] : block + -- given a level and a depth, calculate the corresponding index into the + -- intermediate array + function ~GENSYM[depth2Index][1] (levels,depth : in natural) return natural is + begin + return (2 ** levels - 2 ** depth); + end function; + + constant ~GENSYM[width][2] : natural := ~SIZE[~TYPO]; + constant ~GENSYM[levels][3] : natural := natural (ceil (log2 (real (~SYM[2])))); + type ~GENSYM[popCnt_res_vec][4] is array (natural range <>) of unsigned(~SYM[3] downto 0); + signal ~GENSYM[intermediate][5] : ~SYM[4](0 to (2*~SYM[2])-2); +begin + -- put input into the first half of the intermediate array + ~GENSYM[make_array][6]: for ~GENSYM[i][7] in 0 to (~SYM[2] - 1) generate + ~SYM[5](~SYM[7]) <= resize(~VAR[input][0](~SYM[7] downto ~SYM[7]),~SYM[3]+1); + end generate; + + -- Create the tree of adders + ~GENSYM[make_tree][8] : if ~SYM[3] /= 0 generate + ~GENSYM[tree_depth][9] : for ~GENSYM[d][10] in ~SYM[3]-1 downto 0 generate + ~GENSYM[tree_depth_loop][11] : for ~GENSYM[i][12] in 0 to (natural(2**~SYM[10]) - 1) generate + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+1)+~SYM[12]) <= + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])) + + ~SYM[5](~SYM[1](~SYM[3]+1,~SYM[10]+2)+(2*~SYM[12])+1); + end generate; + end generate; + end generate; + + -- The last element of the intermediate array holds the result + ~RESULT <= resize(~SYM[5]((2*~SYM[2])-2),~SIZE[~TYPO]); +end block; +-- popCnt end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz8#" + , "kind" : "Declaration" + , "type" : "clz8 :: Word# -> Word#" + , "template" : +"-- clz8 begin +~GENSYM[clz8][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz8][3] (constant v : unsigned(0 to 7)) return unsigned is + variable e : unsigned(0 to 7); -- 8 + variable a : unsigned(0 to 2*3-1); -- 6 + begin + for i in 0 to 3 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 1 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + return ~SYM[2](3,a(0 to 5)); + end function; +begin + ~RESULT <= resize(~SYM[3](~ARG[0](7 downto 0)),~SIZE[~TYPO]); +end block; +-- clz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz16#" + , "kind" : "Declaration" + , "type" : "clz16 :: Word# -> Word#" + , "template" : +"-- clz16 begin +~GENSYM[clz16][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz16][3] (constant v : unsigned(0 to 15)) return unsigned is + variable e : unsigned(0 to 15); -- 16 + variable a : unsigned(0 to 4*3-1); -- 12 + variable b : unsigned(0 to 2*4-1); -- 8 + begin + for i in 0 to 7 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 3 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 1 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + return ~SYM[2](4,b(0 to 7)); + end function; +begin + ~RESULT <= resize(~SYM[3](~ARG[0](15 downto 0)),~SIZE[~TYPO]); +end block; +-- clz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz32#" + , "kind" : "Declaration" + , "type" : "clz32 :: Word# -> Word#" + , "template" : +"-- clz32 begin +~GENSYM[clz32][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz32][3] (constant v : unsigned(0 to 31)) return unsigned is + variable e : unsigned(0 to 31); -- 32 + variable a : unsigned(0 to 8*3-1); -- 24 + variable b : unsigned(0 to 4*4-1); -- 16 + variable c : unsigned(0 to 2*5-1); -- 10 + begin + for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + return ~SYM[2](5,c(0 to 9)); + end function; +begin + ~RESULT <= resize(~SYM[3](~ARG[0](31 downto 0)),~SIZE[~TYPO]); +end block; +-- clz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz64#" + , "kind" : "Declaration" + , "type" : "clz64 :: Word# -> Word#" + , "template" : +"-- clz64 begin +~GENSYM[clz64][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is + variable e : unsigned(0 to 63); -- 64 + variable a : unsigned(0 to 16*3-1); -- 48 + variable b : unsigned(0 to 8*4-1); -- 32 + variable c : unsigned(0 to 4*5-1); -- 20 + variable d : unsigned(0 to 2*6-1); -- 12 + begin + for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; + return ~SYM[2](6,d(0 to 11)); + end function; +begin + ~RESULT <= resize(~SYM[3](~ARG[0]),~SIZE[~TYPO]); +end block; +-- clz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.clz#" + , "kind" : "Declaration" + , "type" : "clz :: Word# -> Word#" + , "template" : +"-- clz begin +~GENSYM[clz][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; +~IF ~IW64 ~THEN + function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is + variable e : unsigned(0 to 63); -- 64 + variable a : unsigned(0 to 16*3-1); -- 48 + variable b : unsigned(0 to 8*4-1); -- 32 + variable c : unsigned(0 to 4*5-1); -- 20 + variable d : unsigned(0 to 2*6-1); -- 12 + begin + for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; + return ~SYM[2](6,d(0 to 11)); + end function; +~ELSE + function ~GENSYM[clz32][4] (constant v : unsigned(0 to 31)) return unsigned is + variable e : unsigned(0 to 31); -- 32 + variable a : unsigned(0 to 8*3-1); -- 24 + variable b : unsigned(0 to 4*4-1); -- 16 + variable c : unsigned(0 to 2*5-1); -- 10 + begin + for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + return ~SYM[2](5,c(0 to 9)); + end function; +~FI +begin +~IF ~IW64 ~THEN + ~RESULT <= resize(~SYM[3](~ARG[0]),~SIZE[~TYPO]); +~ELSE + ~RESULT <= resize(~SYM[4](~ARG[0]),~SIZE[~TYPO]); +~FI +end block; +-- clz end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz8#" + , "kind" : "Declaration" + , "type" : "ctz8 :: Word# -> Word#" + , "template" : +"-- ctz8 begin +~GENSYM[ctz8][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz8][3] (constant v : unsigned(0 to 7)) return unsigned is + variable e : unsigned(0 to 7); -- 8 + variable a : unsigned(0 to 2*3-1); -- 6 + begin + for i in 0 to 3 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 1 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + return ~SYM[2](3,a(0 to 5)); + end function; + + signal ~GENSYM[w_reversed][5] : ~TYP[0]; +begin + ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate + ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); + end generate; +~IF ~IW64 ~THEN + ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 56)),~SIZE[~TYPO]); +~ELSE + ~RESULT <= resize(~SYM[3](~SYM[5](31 downto 24)),~SIZE[~TYPO]); +~FI +end block; +-- ctz8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz16#" + , "kind" : "Declaration" + , "type" : "ctz16 :: Word# -> Word#" + , "template" : +"-- ctz16 begin +~GENSYM[ctz16][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz16][3] (constant v : unsigned(0 to 15)) return unsigned is + variable e : unsigned(0 to 15); -- 16 + variable a : unsigned(0 to 4*3-1); -- 12 + variable b : unsigned(0 to 2*4-1); -- 8 + begin + for i in 0 to 7 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 3 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 1 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + return ~SYM[2](4,b(0 to 7)); + end function; + + signal ~GENSYM[w_reversed][5] : ~TYP[0]; +begin + ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate + ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); + end generate; +~IF ~IW64 ~THEN + ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 48)),~SIZE[~TYPO]); +~ELSE + ~RESULT <= resize(~SYM[3](~SYM[5](31 downto 16)),~SIZE[~TYPO]); +~FI +end block; +-- ctz16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz32#" + , "kind" : "Declaration" + , "type" : "ctz32 :: Word# -> Word#" + , "template" : +"-- ctz32 begin +~GENSYM[ctz32][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz32][3] (constant v : unsigned(0 to 31)) return unsigned is + variable e : unsigned(0 to 31); -- 32 + variable a : unsigned(0 to 8*3-1); -- 24 + variable b : unsigned(0 to 4*4-1); -- 16 + variable c : unsigned(0 to 2*5-1); -- 10 + begin + for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + return ~SYM[2](5,c(0 to 9)); + end function; + + signal ~GENSYM[w_reversed][5] : ~TYP[0]; +begin + ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate + ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[3]); + end generate; +~IF ~IW64 ~THEN + ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 32)),~SIZE[~TYPO]); +~ELSE + ~RESULT <= resize(~SYM[3](~SYM[5]),~SIZE[~TYPO]); +~FI +end block; +-- ctz32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz64#" + , "kind" : "Declaration" + , "type" : "ctz64 :: Word# -> Word#" + , "template" : +"-- ctz64 begin +~GENSYM[ctz64][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + + function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is + variable e : unsigned(0 to 63); -- 64 + variable a : unsigned(0 to 16*3-1); -- 48 + variable b : unsigned(0 to 8*4-1); -- 32 + variable c : unsigned(0 to 4*5-1); -- 20 + variable d : unsigned(0 to 2*6-1); -- 12 + begin + for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; + return ~SYM[2](6,d(0 to 11)); + end function; + + signal ~GENSYM[w_reversed][5] : ~TYP[0]; +begin + ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate + ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]); + end generate; + + ~RESULT <= resize(~SYM[3](~SYM[5]),~SIZE[~TYPO]); +end block; +-- ctz64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.ctz#" + , "kind" : "Declaration" + , "type" : "ctz :: Word# -> Word#" + , "template" : +"-- ctz begin +~GENSYM[ctz][0] : block + function ~GENSYM[enc][1] (constant a : unsigned(1 downto 0)) return unsigned is + begin + case a is + when \"00\" => return \"10\"; + when \"01\" => return \"01\"; + when \"10\" => return \"00\"; + when others => return \"00\"; + end case; + end function; + + function ~GENSYM[clzi][2] ( + constant n : in natural; + constant i : in unsigned) return unsigned is + variable v : unsigned(i'length-1 downto 0):=i; + begin + if v(n-1+n)='0' then + return (v(n-1+n) and v(n-1)) & '0' & v(2*n-2 downto n); + else + return (v(n-1+n) and v(n-1)) & not v(n-1) & v(n-2 downto 0); + end if; + end function; + +~IF ~IW64 ~THEN + function ~GENSYM[clz64][3] (constant v : unsigned(0 to 63)) return unsigned is + variable e : unsigned(0 to 63); -- 64 + variable a : unsigned(0 to 16*3-1); -- 48 + variable b : unsigned(0 to 8*4-1); -- 32 + variable c : unsigned(0 to 4*5-1); -- 20 + variable d : unsigned(0 to 2*6-1); -- 12 + begin + for i in 0 to 31 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 15 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 7 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 3 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + for i in 0 to 1 loop d(i*6 to i*6+5):=~SYM[2](5,c(i*10 to i*10+9)); end loop; + return ~SYM[2](6,d(0 to 11)); + end function; +~ELSE + function ~GENSYM[clz32][4] (constant v : unsigned(0 to 31)) return unsigned is + variable e : unsigned(0 to 31); -- 32 + variable a : unsigned(0 to 8*3-1); -- 24 + variable b : unsigned(0 to 4*4-1); -- 16 + variable c : unsigned(0 to 2*5-1); -- 10 + begin + for i in 0 to 15 loop e(i*2 to i*2+1):=~SYM[1](v(i*2 to i*2+1)); end loop; + for i in 0 to 7 loop a(i*3 to i*3+2):=~SYM[2](2,e(i*4 to i*4+3)); end loop; + for i in 0 to 3 loop b(i*4 to i*4+3):=~SYM[2](3,a(i*6 to i*6+5)); end loop; + for i in 0 to 1 loop c(i*5 to i*5+4):=~SYM[2](4,b(i*8 to i*8+7)); end loop; + return ~SYM[2](5,c(0 to 9)); + end function; +~FI + + signal ~GENSYM[w_reversed][6] : ~TYP[0]; +begin + ~GENSYM[reverse_loop][7] : for ~GENSYM[n][8] in ~VAR[w][0]'range generate + ~SYM[6](~VAR[w][0]'high - ~SYM[8]) <= ~VAR[w][0](~SYM[8]); + end generate; +~IF ~IW64 ~THEN + ~RESULT <= resize(~SYM[3](~SYM[6]),~SIZE[~TYPO]); +~ELSE + ~RESULT <= resize(~SYM[4](~SYM[6]),~SIZE[~TYPO]); +~FI +end block; +-- ctz end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap16#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap16# :: Word# -> Word#" + , "template" : +"-- byteSwap16 begin~IF ~IW64 ~THEN +~RESULT <= ~VAR[w][0](63 downto 16) & ~VAR[w][0](7 downto 0) & ~VAR[w][0](15 downto 8);~ELSE +~RESULT <= ~VAR[w][0](31 downto 16) & ~VAR[w][0](7 downto 0) & ~VAR[w][0](15 downto 8);~FI +-- byteSwap16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap32#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap32# :: Word# -> Word#" + , "template" : +"-- byteSwap32 begin~IF ~IW64 ~THEN +~RESULT <= ~VAR[w][0](63 downto 32) & ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) + & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~ELSE +~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) + & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~FI +-- byteSwap32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap64#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap64# :: Word# -> Word#" + , "template" : +"-- byteSwap64 begin +~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) + & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24) + & ~VAR[w][0](39 downto 32) & ~VAR[w][0](47 downto 40) + & ~VAR[w][0](55 downto 48) & ~VAR[w][0](63 downto 56); +-- byteSwap64 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.byteSwap#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "byteSwap# :: Word# -> Word#" + , "template" : +"-- byteSwap begin ~IF ~IW64 ~THEN +~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) + & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24) + & ~VAR[w][0](39 downto 32) & ~VAR[w][0](47 downto 40) + & ~VAR[w][0](55 downto 48) & ~VAR[w][0](63 downto 56);~ELSE +~RESULT <= ~VAR[w][0](7 downto 0 ) & ~VAR[w][0](15 downto 8) + & ~VAR[w][0](23 downto 16) & ~VAR[w][0](31 downto 24);~FI +-- byteSwap end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow8Int#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow8Int# :: Int# -> Int#" + , "template" : "resize(~VAR[i][0](7 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow16Int#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow16Int# :: Int# -> Int#" + , "template" : "resize(~VAR[i][0](15 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow32Int#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow32Int# :: Int# -> Int#" + , "template" : "resize(~VAR[i][0](31 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow8Word#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow8Word# :: Word# -> Word#" + , "template" : "resize(~VAR[w][0](7 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow16Word#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow16Word# :: Word# -> Word#" + , "template" : "resize(~VAR[w][0](15 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.narrow32Word#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "narrow32Word# :: Word# -> Word#" + , "template" : "resize(~VAR[w][0](31 downto 0),~SIZE[~TYPO])" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse# :: Word# -> Word#" + , "template" : +"-- bitReverse begin +~GENSYM[bitReverse][0] : for ~GENSYM[i][1] in 0 to ~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI generate +begin +~RESULT(~SYM[1]) <= ~VAR[x][0](~IF ~IW64 ~THEN 63 ~ELSE 31 ~FI-~SYM[1]); +end generate; +-- bitReverse end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse8#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse8# :: Word# -> Word#" + , "template" : +"-- bitReverse8 begin +~GENSYM[bitReverse8][0] : for ~GENSYM[i][1] in 0 to 7 generate +begin +~RESULT(~SYM[1]) <= ~VAR[x][0](7-~SYM[1]); +end generate; +-- bitReverse8 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse16#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse16# :: Word# -> Word#" + , "template" : +"-- bitReverse16 begin +~GENSYM[bitReverse16][0] : for ~GENSYM[i][1] in 0 to 15 generate +begin +~RESULT(~SYM[1]) <= ~VAR[x][0](15-~SYM[1]); +end generate; +-- bitReverse16 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse32#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse32# :: Word# -> Word#" + , "template" : +"-- bitReverse32 begin +~GENSYM[bitReverse32][0] : for ~GENSYM[i][1] in 0 to 31 generate +begin +~RESULT(~SYM[1]) <= ~VAR[x][0](31-~SYM[1]); +end generate; +-- bitReverse32 end" + } + } +, { "BlackBox" : + { "name" : "GHC.Prim.bitReverse64#" + , "workInfo" : "Never" + , "kind" : "Declaration" + , "type" : "bitReverse64# :: Word# -> Word#" + , "template" : +"-- bitReverse64 begin +~GENSYM[bitReverse64][0] : for ~GENSYM[i][1] in 0 to 63 generate +begin +~RESULT(~SYM[1]) <= ~VAR[x][0](63-~SYM[1]); +end generate; +-- bitReverse64 end" + } + } +] diff --git a/prims/vhdl/GHC_Word.json b/prims/vhdl/GHC_Word.json deleted file mode 100644 --- a/prims/vhdl/GHC_Word.json +++ /dev/null @@ -1,33 +0,0 @@ -[ { "BlackBox" : - { "name" : "GHC.Word.W8#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "W8# :: Word# -> Word8" - , "template" : "resize(~ARG[0],8)" - } - } -, { "BlackBox" : - { "name" : "GHC.Word.W16#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "W16# :: Word# -> Word16" - , "template" : "resize(~ARG[0],16)" - } - } -, { "BlackBox" : - { "name" : "GHC.Word.W32#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "W32# :: Word# -> Word32" - , "template" : "resize(~ARG[0],32)" - } - } -, { "BlackBox" : - { "name" : "GHC.Word.W64#" - , "workInfo" : "Never" - , "kind" : "Expression" - , "type" : "W64# :: Word# -> Word64" - , "template" : "resize(~ARG[0],64)" - } - } -] diff --git a/prims/vhdl/GHC_Word.primitives b/prims/vhdl/GHC_Word.primitives new file mode 100644 --- /dev/null +++ b/prims/vhdl/GHC_Word.primitives @@ -0,0 +1,33 @@ +[ { "BlackBox" : + { "name" : "GHC.Word.W8#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "W8# :: Word# -> Word8" + , "template" : "resize(~ARG[0],8)" + } + } +, { "BlackBox" : + { "name" : "GHC.Word.W16#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "W16# :: Word# -> Word16" + , "template" : "resize(~ARG[0],16)" + } + } +, { "BlackBox" : + { "name" : "GHC.Word.W32#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "W32# :: Word# -> Word32" + , "template" : "resize(~ARG[0],32)" + } + } +, { "BlackBox" : + { "name" : "GHC.Word.W64#" + , "workInfo" : "Never" + , "kind" : "Expression" + , "type" : "W64# :: Word# -> Word64" + , "template" : "resize(~ARG[0],64)" + } + } +] diff --git a/src/Clash/Backend.hs b/src/Clash/Backend.hs --- a/src/Clash/Backend.hs +++ b/src/Clash/Backend.hs @@ -10,22 +10,19 @@ module Clash.Backend where -import Control.Lens (Lens') -import qualified Control.Lens as Lens -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) -import Data.Maybe (fromMaybe) import Data.Semigroup.Monad (Mon (..)) -import qualified Data.Text as T import Data.Text (Text) import qualified Data.Text.Lazy as LT import Control.Monad.State (State) import Data.Text.Prettyprint.Doc.Extra (Doc) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (SrcSpan) +#else import SrcLoc (SrcSpan) +#endif -import Clash.Netlist.Id import {-# SOURCE #-} Clash.Netlist.Types import Clash.Netlist.BlackBox.Types @@ -52,7 +49,7 @@ clashVer = "development" #endif -type ModName = Identifier +type ModName = Text -- | Is a type used for internal or external use data Usage @@ -61,9 +58,33 @@ | External Text -- ^ External use, field indicates the library name -class Backend state where +-- | Is '-fclash-aggresive-x-optimization-blackbox' set? +newtype AggressiveXOptBB = AggressiveXOptBB Bool + + +-- | Kind of a HDL type. Used to determine whether types need conversions in +-- order to cross top entity boundaries. +data HWKind + = PrimitiveType + -- ^ A type defined in an HDL spec. Usually types such as: bool, bit, .. + | SynonymType + -- ^ A user defined type that's simply a synonym for another type, very much + -- like a type synonym in Haskell. As long as two synonym types refer to the + -- same type, they can be used interchangeably. E.g., a subtype in VHDL. + | UserType + -- ^ User defined type that's not interchangeable with any others, even if + -- the underlying structures are the same. Similar to an ADT in Haskell. + +class HasIdentifierSet state => Backend state where -- | Initial state for state monad - initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> state + initBackend + :: Int + -> HdlSyn + -> Bool + -> PreserveCase + -> Maybe (Maybe Int) + -> AggressiveXOptBB + -> state -- | What HDL is the backend generating hdlKind :: state -> HDL @@ -82,11 +103,13 @@ extractTypes :: state -> HashSet HWType -- | Generate HDL for a Netlist component - genHDL :: Identifier -> SrcSpan -> HashMap Identifier Word -> Component -> Mon (State state) ((String, Doc),[(String,Doc)]) + genHDL :: ModName -> SrcSpan -> IdentifierSet -> Component -> Mon (State state) ((String, Doc),[(String,Doc)]) -- | Generate a HDL package containing type definitions for the given HWTypes - mkTyPackage :: Identifier -> [HWType] -> Mon (State state) [(String, Doc)] + mkTyPackage :: ModName -> [HWType] -> Mon (State state) [(String, Doc)] -- | Convert a Netlist HWType to a target HDL type hdlType :: Usage -> HWType -> Mon (State state) Doc + -- | Query what kind of type a given HDL type is + hdlHWTypeKind :: HWType -> State state HWKind -- | Convert a Netlist HWType to an HDL error value for that type hdlTypeErrValue :: HWType -> Mon (State state) Doc -- | Convert a Netlist HWType to the root of a target HDL type @@ -111,10 +134,6 @@ fromBV :: HWType -> LT.Text -> Mon (State state) Doc -- | Synthesis tool we're generating HDL for hdlSyn :: State state HdlSyn - -- | mkIdentifier - mkIdentifier :: State state (IdType -> Identifier -> Identifier) - -- | mkIdentifier - extendIdentifier :: State state (IdType -> Identifier -> Identifier -> Identifier) -- | setModName setModName :: ModName -> state -> state -- | setSrcSpan @@ -122,9 +141,7 @@ -- | getSrcSpan getSrcSpan :: State state SrcSpan -- | Block of declarations - blockDecl :: Text -> [Declaration] -> Mon (State state) Doc - -- | unextend/unescape identifier - unextend :: State state (Identifier -> Identifier) + blockDecl :: Identifier -> [Declaration] -> Mon (State state) Doc addIncludes :: [(String, Doc)] -> State state () addLibraries :: [LT.Text] -> State state () addImports :: [LT.Text] -> State state () @@ -132,52 +149,6 @@ getDataFiles :: State state [(String,FilePath)] addMemoryDataFile :: (String,String) -> State state () getMemoryDataFiles :: State state [(String,String)] - seenIdentifiers :: Lens' state (HashMap Identifier Word) ifThenElseExpr :: state -> Bool - --- | Replace a normal HDL template placeholder with an unescaped/unextended --- template placeholder. --- --- Needed when the the place-holder is filled with an escaped/extended identifier --- inside an escaped/extended identifier and we want to strip the escape --- /extension markers. Otherwise we end up with illegal identifiers. -escapeTemplate :: Identifier -> Identifier -escapeTemplate "~RESULT" = "~ERESULT" -escapeTemplate t = fromMaybe t $ do - t1 <- T.stripPrefix "~ARG[" t - n <- T.stripSuffix "]" t1 - pure (T.concat ["~EARG[",n,"]"]) - -mkUniqueIdentifier - :: Backend s - => IdType - -> Identifier - -> State s Identifier -mkUniqueIdentifier typ nm = do - mkId <- mkIdentifier - extendId <- extendIdentifier - seen <- Lens.use seenIdentifiers - let i = mkId typ nm - case HashMap.lookup i seen of - Just n -> go extendId n seen i - Nothing -> do - seenIdentifiers Lens.%= (HashMap.insert i 0) - return i - where - go extendId n seen i = do - let i' = extendId typ i (T.pack ('_':show n)) - case HashMap.lookup i' seen of - Just _ -> go extendId (n+1) seen i - Nothing -> do - seenIdentifiers Lens.%= (HashMap.insert i' (n+1)) - return i' - -preserveSeen - :: Backend s - => Mon (State s) a - -> Mon (State s) a -preserveSeen m = do - s <- Mon (Lens.use seenIdentifiers) - a <- m - Mon (seenIdentifiers Lens..= s) - return a + -- | Whether -fclash-aggressive-x-optimization-blackboxes was set + aggressiveXOptBB :: State state AggressiveXOptBB diff --git a/src/Clash/Backend/SystemVerilog.hs b/src/Clash/Backend/SystemVerilog.hs --- a/src/Clash/Backend/SystemVerilog.hs +++ b/src/Clash/Backend/SystemVerilog.hs @@ -23,7 +23,6 @@ import Data.Bits (Bits, testBit) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap -import qualified Data.HashMap.Strict as HashMapS import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.List (nub, nubBy) @@ -36,6 +35,7 @@ import qualified Data.Text.Lazy as Text import qualified Data.Text as TextS import Data.Text.Prettyprint.Doc.Extra +import qualified Data.Text.Prettyprint.Doc.Extra as PP import qualified System.FilePath import Clash.Annotations.Primitive (HDL (..)) @@ -53,9 +53,9 @@ import Clash.Netlist.BlackBox.Types (HdlSyn (..)) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) -import Clash.Netlist.Id (IdType (..), mkBasicId') +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types hiding (_intWidth, intWidth) -import Clash.Netlist.Util hiding (mkIdentifier, extendIdentifier) +import Clash.Netlist.Util import Clash.Signal.Internal (ActiveEdge (..)) import Clash.Util (SrcSpan, noSrcSpan, curLoc, makeCached, first, on, indexNote) @@ -65,11 +65,10 @@ data SystemVerilogState = SystemVerilogState { _tyCache :: HashSet HWType -- ^ Previously encountered HWTypes - , _tySeen :: HashMapS.HashMap Identifier Word -- ^ Product type counter - , _nameCache :: HashMap HWType Doc -- ^ Cache for previously generated product type names + , _nameCache :: HashMap HWType Identifier -- ^ Cache for previously generated product type names , _genDepth :: Int -- ^ Depth of current generative block - , _modNm :: Identifier - , _idSeen :: HashMapS.HashMap Identifier Word + , _modNm :: ModName + , _idSeen :: IdentifierSet , _oports :: [Identifier] , _srcSpan :: SrcSpan , _includes :: [(String,Doc)] @@ -84,16 +83,35 @@ -- ^ Are we in the context of generating the @_types@ package? , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn - , _escapedIds :: Bool , _undefValue :: Maybe (Maybe Int) + , _aggressiveXOptBB_ :: AggressiveXOptBB } makeLenses ''SystemVerilogState +instance HasIdentifierSet SystemVerilogState where + identifierSet = idSeen + instance Backend SystemVerilogState where - initBackend = SystemVerilogState HashSet.empty HashMapS.empty HashMap.empty - 0 "" HashMapS.empty [] noSrcSpan [] [] [] - [] [] False + initBackend w hdlsyn_ esc lw undefVal xOpt = SystemVerilogState { + _tyCache=HashSet.empty + , _nameCache=HashMap.empty + , _genDepth=0 + , _modNm="" + , _idSeen=Id.emptyIdentifierSet esc lw SystemVerilog + , _oports=[] + , _srcSpan=noSrcSpan + , _includes=[] + , _imports=[] + , _libraries=[] + , _dataFiles=[] + , _memoryDataFiles=[] + , _tyPkgCtx=False + , _intWidth=w + , _hdlsyn=hdlsyn_ + , _undefValue=undefVal + , _aggressiveXOptBB_=xOpt + } hdlKind = const SystemVerilog primDirs = const $ do root <- primsRoot return [ root System.FilePath. "common" @@ -104,8 +122,15 @@ name = const "systemverilog" extension = const ".sv" - genHDL = genVerilog + genHDL = genSystemVerilog mkTyPackage = mkTyPackage_ + hdlHWTypeKind = \case + Vector {} -> pure UserType + RTree {} -> pure UserType + Product {} -> pure UserType + BiDirectional _ ty -> hdlHWTypeKind ty + Annotated _ ty -> hdlHWTypeKind ty + _ -> pure PrimitiveType hdlType _ = verilogType hdlTypeErrValue = verilogTypeErrValue hdlTypeMark = verilogTypeMark @@ -124,35 +149,9 @@ inst = inst_ expr = expr_ iwWidth = use intWidth - toBV hty id_ = toSLV hty (Identifier (Text.toStrict id_) Nothing) + toBV hty id_ = toSLV hty (Identifier (Id.unsafeMake (Text.toStrict id_)) Nothing) fromBV hty id_ = simpleFromSLV hty (Text.toStrict id_) hdlSyn = use hdlsyn - mkIdentifier = do - allowEscaped <- use escapedIds - return (go allowEscaped) - where - go _ Basic nm = case (TextS.take 1024 . filterReserved) (mkBasicId' SystemVerilog True nm) of - nm' | TextS.null nm' -> "_clash_internal" - | otherwise -> nm' - go esc Extended (rmSlash . escapeTemplate -> nm) = case go esc Basic nm of - nm' | esc && nm /= nm' -> TextS.concat ["\\",nm," "] - | otherwise -> nm' - extendIdentifier = do - allowEscaped <- use escapedIds - return (go allowEscaped) - where - go _ Basic nm ext = - case (TextS.take 1024 . filterReserved) (mkBasicId' SystemVerilog True (nm `TextS.append` ext)) of - nm' | TextS.null nm' -> "_clash_internal" - | otherwise -> nm' - go esc Extended (rmSlash -> nm) ext = - let nmExt = nm `TextS.append` ext - in case go esc Basic nm ext of - nm' | esc && nm' /= nmExt -> case TextS.isPrefixOf "c$" nmExt of - True -> TextS.concat ["\\",nmExt," "] - _ -> TextS.concat ["\\c$",nmExt," "] - | otherwise -> nm' - setModName nm s = s {_modNm = nm} setSrcSpan = (srcSpan .=) getSrcSpan = use srcSpan @@ -163,7 +162,6 @@ else pure decs <> line <> insts ds - unextend = return rmSlash addIncludes inc = includes %= (inc++) addLibraries libs = libraries %= (libs ++) addImports inps = imports %= (inps ++) @@ -175,67 +173,30 @@ getDataFiles = use dataFiles addMemoryDataFile f = memoryDataFiles %= (f:) getMemoryDataFiles = use memoryDataFiles - seenIdentifiers = idSeen ifThenElseExpr _ = True - -rmSlash :: Identifier -> Identifier -rmSlash nm = fromMaybe nm $ do - nm1 <- TextS.stripPrefix "\\" nm - pure (TextS.filter (not . (== ' ')) nm1) + aggressiveXOptBB = use aggressiveXOptBB_ type SystemVerilogM a = Mon (State SystemVerilogState) a --- List of reserved SystemVerilog-2012 keywords -reservedWords :: [Identifier] -reservedWords = ["accept_on","alias","always","always_comb","always_ff" - ,"always_latch","and","assert","assign","assume","automatic","before","begin" - ,"bind","bins","binsof","bit","break","buf","bufif0","bufif1","byte","case" - ,"casex","casez","cell","chandle","checker","class","clocking","cmos","config" - ,"const","constraint","context","continue","cover","covergroup","coverpoint" - ,"cross","deassign","default","defparam","design","disable","dist","do","edge" - ,"else","end","endcase","endchecker","endclass","endclocking","endconfig" - ,"endfunction","endgenerate","endgroup","endinterface","endmodule","endpackage" - ,"endprimitive","endprogram","endproperty","endspecify","endsequence" - ,"endtable","endtask","enum","event","eventually","expect","export","extends" - ,"extern","final","first_match","for","force","foreach","forever","fork" - ,"forkjoin","function","generate","genvar","global","highz0","highz1","if" - ,"iff","ifnone","ignore_bins","illegal_bins","implements","implies","import" - ,"incdir","include","initial","inout","input","inside","instance","int" - ,"integer","interconnect","interface","intersect","join","join_any" - ,"join_none","large","let","liblist","library","local","localparam","logic" - ,"longint","macromodule","matches","medium","modport","module","nand" - ,"negedge","nettype","new","nexttime","nmos","nor","noshowcancelled","not" - ,"notif0","notif1","null","or","output","package","packed","parameter","pmos" - ,"posedge","primitive","priority","program","property","protected","pull0" - ,"pull1","pulldown","pullup","pulsestyle_ondetect","pulsestyle_onevent" - ,"pure","rand","randc","randcase","randsequence","rcmos","real","realtime" - ,"ref","reg","reject_on","release","repeat","restrict","return","rnmos" - ,"rpmos","rtran","rtranif0","rtranif1","s_always","s_eventually","s_nexttime" - ,"s_until","s_until_with","scalared","sequence","shortint","shortreal" - ,"showcancelled","signed","small","soft","solve","specify","specparam" - ,"static","string","strong","strong0","strong1","struct","super","supply0" - ,"supply1","sync_accept_on","sync_reject_on","table","tagged","task","this" - ,"throughout","time","timeprecision","timeunit","tran","tranif0","tranif1" - ,"tri","tri0","tri1","triand","trior","trireg","type","typedef","union" - ,"unique","unique0","unsigned","until","until_with","untyped","use","uwire" - ,"var","vectored","virtual","void","wait","wait_order","wand","weak","weak0" - ,"weak1","while","wildcard","wire","with","within","wor","xnor","xor"] - -filterReserved :: Identifier -> Identifier -filterReserved s = if s `elem` reservedWords - then s `TextS.append` "_r" - else s - -- | Generate SystemVerilog for a Netlist component -genVerilog :: Identifier -> SrcSpan -> HashMapS.HashMap Identifier Word -> Component -> SystemVerilogM ((String,Doc),[(String,Doc)]) -genVerilog _ sp seen c = preserveSeen $ do - Mon $ idSeen .= seen - -- Don't have type names conflict with module names - Mon $ tySeen %= HashMapS.unionWith max seen +genSystemVerilog + :: ModName + -> SrcSpan + -> IdentifierSet + -> Component + -> SystemVerilogM ((String, Doc), [(String, Doc)]) +genSystemVerilog _ sp seen c = do + -- Don't have type names conflict with module names or with previously + -- generated type names. + -- + -- TODO: Collect all type names up front, to prevent relatively costly union. + -- TODO: Investigate whether type names / signal names collide in the first place + Mon $ idSeen %= Id.union seen + Mon $ setSrcSpan sp v <- verilog incs <- Mon $ use includes - return ((TextS.unpack cName,v),incs) + return ((TextS.unpack (Id.toText cName), v), incs) where cName = componentName c verilog = commentHeader <> line <> @@ -248,9 +209,7 @@ timescale = "`timescale 100fs/100fs" -- | Generate a SystemVerilog package containing type definitions for the given HWTypes -mkTyPackage_ :: Identifier - -> [HWType] - -> SystemVerilogM [(String,Doc)] +mkTyPackage_ :: TextS.Text -> [HWType] -> SystemVerilogM [(String,Doc)] mkTyPackage_ modName hwtys = do Mon (tyPkgCtx .= True) normTys <- nub <$> mapM (normaliseType) (hwtys ++ usedTys) @@ -339,7 +298,8 @@ normaliseType ty@(Sum _ _) = return (BitVector (typeSize ty)) normaliseType ty@(CustomSum _ _ _ _) = return (BitVector (typeSize ty)) normaliseType (Clock _) = return Bit -normaliseType (Reset {}) = return Bit +normaliseType (Reset _) = return Bit +normaliseType (Enable _) = return Bool normaliseType (BiDirectional dir ty) = BiDirectional dir <$> normaliseType ty normaliseType ty = return ty @@ -403,6 +363,7 @@ Vector {} -> error $ $(curLoc) ++ "impossible" Clock {} -> (ns, verilogType t) Reset {} -> (ns, "logic") + Enable {} -> (ns, "logic") Bool -> (ns, "logic") Bit -> (ns, "logic") String -> (ns, "string") @@ -452,13 +413,13 @@ if n > 1 then "function" <+> "automatic" <+> tName <+> tName <> "_cons" <> parens (sigDecl "x" elTy <> comma <> vecSigDecl "xs") <> semi <> line <> indent 2 - (tName <> "_cons" <> brackets (int 0) <+> "=" <+> (toSLV elTy (Identifier "x" Nothing)) <> semi <> line <> + (tName <> "_cons" <> brackets (int 0) <+> "=" <+> (toSLV elTy (Identifier (Id.unsafeMake "x") Nothing)) <> semi <> line <> tName <> "_cons" <> brackets (int 1 <> colon <> int (n-1)) <+> "=" <+> "xs" <> semi) <> line <> "endfunction" else "function" <+> "automatic" <+> tName <+> tName <> "_cons" <> parens (sigDecl "x" elTy) <> semi <> line <> indent 2 - (tName <> "_cons" <> brackets (int 0) <+> "=" <+> (toSLV elTy (Identifier "x" Nothing)) <> semi) <> line <> + (tName <> "_cons" <> brackets (int 0) <+> "=" <+> (toSLV elTy (Identifier (Id.unsafeMake "x") Nothing)) <> semi) <> line <> "endfunction" where tName = tyName ty @@ -529,7 +490,7 @@ module_ :: Component -> SystemVerilogM Doc module_ c = - addSeen c *> modVerilog <* Mon (imports .= [] >> oports .= []) + modVerilog <* Mon (imports .= [] >> oports .= []) where modVerilog = do body <- modBody @@ -537,7 +498,7 @@ libs <- Mon $ use libraries modHeader <> line <> modPorts <> line <> include (nub imps) <> uselibs (nub libs) <> pure body <> line <> modEnding - modHeader = "module" <+> stringS (componentName c) + modHeader = "module" <+> pretty (componentName c) modPorts = indent 4 (tupleInputs inPorts <> line <> tupleOutputs outPorts <> semi) modBody = indent 2 (decls (declarations c)) <> line <> line <> indent 2 (insts (declarations c)) modEnding = "endmodule" @@ -556,7 +517,7 @@ -- map a port to its verilog type, port name, and any encoding notes sigPort (wr2ty -> portTy) (nm, hwTy) iEM = addAttrs (hwTypeAttrs hwTy) - (portTy <+> sigDecl (stringS nm) hwTy <> iE <+> encodingNote hwTy) + (portTy <+> sigDecl (pretty nm) hwTy <> iE <+> encodingNote hwTy) where iE = maybe emptyDoc (noEmptyInit . expr_ False) iEM -- slightly more readable than 'tupled', makes the output Haskell-y-er @@ -578,33 +539,6 @@ <> (if null xs then emptyDoc else line <> vcat (forM xs commafy)) <> line <> rparen -addSeen :: Component -> SystemVerilogM () -addSeen c = do - let iport = map fst (inputs c) - oport = map (fst . (\(_,x,_)->x)) $ outputs c - nets = mapMaybe (\case {NetDecl' _ _ i _ _ -> Just i; _ -> Nothing}) $ declarations c - Mon (idSeen %= (HashMapS.unionWith max (HashMapS.fromList (concatMap (map (,0)) [iport,oport,nets])))) - Mon (oports .= oport) - -mkUniqueId :: Identifier -> SystemVerilogM Identifier -mkUniqueId i = do - mkId <- Mon (mkIdentifier <*> pure Extended) - seen <- Mon $ use idSeen - let i' = mkId i - case HashMapS.lookup i seen of - Just n -> go mkId seen i' n - Nothing -> do Mon (idSeen %= (HashMapS.insert i' 0)) - return i' - where - go :: (Identifier -> Identifier) -> HashMapS.HashMap Identifier Word -> Identifier - -> Word -> SystemVerilogM Identifier - go mkId seen i' n = do - let i'' = mkId (TextS.append i' (TextS.pack ('_':show n))) - case HashMapS.lookup i'' seen of - Just _ -> go mkId seen i' (n+1) - Nothing -> do Mon (idSeen %= (HashMapS.insert i'' (n+1))) - return i'' - verilogType :: HWType -> SystemVerilogM Doc verilogType t_ = do t <- normaliseType t_ @@ -622,7 +556,8 @@ RTree {} -> pvrType Signed n -> logicOrWire <+> "signed" <+> brackets (int (n-1) <> colon <> int 0) Clock _ -> "logic" - Reset {} -> "logic" + Reset _ -> "logic" + Enable _ -> "logic" Bit -> "logic" Bool -> "logic" String -> "string" @@ -662,29 +597,15 @@ tyName t@(CustomSP _ _ _ _) = "logic_vector_" <> int (typeSize t) tyName t@(Product nm _ _) = do tN <- normaliseType t - Mon (makeCached tN nameCache prodName) - where - prodName = do - seen <- use tySeen - mkId <- mkIdentifier <*> pure Basic - let nm' = (mkId . last . TextS.splitOn ".") nm - nm'' = if TextS.null nm' - then "product" - else nm' - (nm3,count) = case HashMapS.lookup nm'' seen of - Just cnt -> go mkId seen cnt nm'' - Nothing -> (nm'',0) - tySeen %= HashMap.insert nm3 count - stringS nm3 + PP.pretty =<< Mon (makeCached tN nameCache prodName) + where + prodName :: State SystemVerilogState Identifier + prodName = Id.makeBasicOr (last (TextS.splitOn "." nm)) "product" - go mkId s i n = - let n' = n `TextS.append` TextS.pack ('_':show i) - in case HashMapS.lookup n' s of - Just _ -> go mkId s (i+1) n - Nothing -> (n',i+1) tyName t@(SP _ _) = "logic_vector_" <> int (typeSize t) tyName (Clock _) = "logic" -tyName (Reset {}) = "logic" +tyName (Reset _) = "logic" +tyName (Enable _) = "logic" tyName t = error $ $(curLoc) ++ "tyName: " ++ show t -- | Convert a Netlist HWType to an error SystemVerilog value for that type @@ -728,8 +649,8 @@ decl (NetDecl' noteM _ id_ tyE iEM) = Just A.<$> maybe id addNote noteM (addAttrs attrs (typ tyE)) where - typ (Left ty) = stringS ty <+> stringS id_ <> iE - typ (Right ty) = sigDecl (stringS id_) ty <> iE + typ (Left ty) = stringS ty <+> pretty id_ <> iE + typ (Right ty) = sigDecl (pretty id_) ty <> iE addNote n = mappend ("//" <+> stringS n <> line) attrs = fromMaybe [] (hwTypeAttrs A.<$> either (const Nothing) Just tyE) iE = maybe emptyDoc (noEmptyInit . expr_ False) iEM @@ -810,7 +731,7 @@ patMod _ l = l -- | Helper function for inst_, handling CustomSP and CustomSum -inst_' :: TextS.Text -> Expr -> HWType -> [(Maybe Literal, Expr)] -> SystemVerilogM (Maybe Doc) +inst_' :: Identifier -> Expr -> HWType -> [(Maybe Literal, Expr)] -> SystemVerilogM (Maybe Doc) inst_' id_ scrut scrutTy es = fmap Just $ "always_comb begin" <> line <> indent 2 casez <> line <> "end" where @@ -825,10 +746,10 @@ conds :: [(Maybe Literal,Expr)] -> SystemVerilogM Doc conds [] = error $ $(curLoc) ++ "Empty list of conditions invalid." - conds [(_,e)] = "default" <+> ":" <+> stringS id_ <+> "=" <+> expr_ False e <> ";" - conds ((Nothing,e):_) = "default" <+> ":" <+> stringS id_ <+> "=" <+> expr_ False e <> ";" + conds [(_,e)] = "default" <+> ":" <+> pretty id_ <+> "=" <+> expr_ False e <> ";" + conds ((Nothing,e):_) = "default" <+> ":" <+> pretty id_ <+> "=" <+> expr_ False e <> ";" conds ((Just c ,e):es') = - mask' <+> ":" <+> stringS id_ <+> "=" <+> expr_ False e <> ";" <> line <> conds es' + mask' <+> ":" <+> pretty id_ <+> "=" <+> expr_ False e <> ";" <> line <> conds es' where mask' = patLitCustom scrutTy c @@ -837,28 +758,28 @@ inst_ (TickDecl {}) = return Nothing inst_ (Assignment id_ e) = fmap Just $ - "assign" <+> stringS id_ <+> equals <+> align (expr_ False e <> semi) + "assign" <+> pretty id_ <+> equals <+> align (expr_ False e <> semi) inst_ (CondAssignment id_ ty scrut _ [(Just (BoolLit b), l),(_,r)]) = fmap Just $ do { syn <- Mon hdlSyn ; p <- Mon $ use oports ; if syn == Vivado && id_ `elem` p then do - { regId <- mkUniqueId =<< Mon (extendIdentifier <*> pure Extended <*> pure id_ <*> pure "_reg") - ; verilogType ty <+> stringS regId <> semi <> line <> + { regId <- Id.suffix id_ "reg" + ; verilogType ty <+> pretty regId <> semi <> line <> "always_comb begin" <> line <> indent 2 ("if" <> parens (expr_ True scrut) <> line <> - (indent 2 $ stringS regId <+> equals <+> expr_ False t <> semi) <> line <> + (indent 2 $ pretty regId <+> equals <+> expr_ False t <> semi) <> line <> "else" <> line <> - (indent 2 $ stringS regId <+> equals <+> expr_ False f <> semi)) <> line <> + (indent 2 $ pretty regId <+> equals <+> expr_ False f <> semi)) <> line <> "end" <> line <> - "assign" <+> stringS id_ <+> equals <+> stringS regId <> semi + "assign" <+> pretty id_ <+> equals <+> pretty regId <> semi } else "always_comb begin" <> line <> indent 2 ("if" <> parens (expr_ True scrut) <> line <> - (indent 2 $ stringS id_ <+> equals <+> expr_ False t <> semi) <> line <> + (indent 2 $ pretty id_ <+> equals <+> expr_ False t <> semi) <> line <> "else" <> line <> - (indent 2 $ stringS id_ <+> equals <+> expr_ False f <> semi)) <> line <> + (indent 2 $ pretty id_ <+> equals <+> expr_ False f <> semi)) <> line <> "end" } where @@ -878,14 +799,14 @@ ; p <- Mon $ use oports ; if syn == Vivado && id_ `elem` p then do - { regId <- mkUniqueId =<< Mon (extendIdentifier <*> pure Extended <*> pure id_ <*> pure "_reg") - ; verilogType ty <+> stringS regId <> semi <> line <> + { regId <- Id.suffix id_ "reg" + ; verilogType ty <+> pretty regId <> semi <> line <> "always_comb begin" <> line <> indent 2 ("case" <> parens (expr_ True scrut) <> line <> (indent 2 $ vcat $ punctuate semi (conds regId es)) <> semi <> line <> "endcase") <> line <> "end" <> line <> - "assign" <+> stringS id_ <+> equals <+> stringS regId <> semi + "assign" <+> pretty id_ <+> equals <+> pretty regId <> semi } else "always_comb begin" <> line <> indent 2 ("case" <> parens (expr_ True scrut) <> line <> @@ -896,17 +817,26 @@ where conds :: Identifier -> [(Maybe Literal,Expr)] -> SystemVerilogM [Doc] conds _ [] = return [] - conds i [(_,e)] = ("default" <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> return [] - conds i ((Nothing,e):_) = ("default" <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> return [] - conds i ((Just c ,e):es') = (exprLitSV (Just (scrutTy,conSize scrutTy)) c <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> conds i es' + conds i [(_,e)] = ("default" <+> colon <+> pretty i <+> equals <+> expr_ False e) <:> return [] + conds i ((Nothing,e):_) = ("default" <+> colon <+> pretty i <+> equals <+> expr_ False e) <:> return [] + conds i ((Just c ,e):es') = (exprLitSV (Just (scrutTy,conSize scrutTy)) c <+> colon <+> pretty i <+> equals <+> expr_ False e) <:> conds i es' -inst_ (InstDecl _ _ nm lbl ps pms) = fmap Just $ - nest 2 (stringS nm <> params <> stringS lbl <> line <> pms' <> semi) +inst_ (InstDecl _ _ attrs nm lbl ps pms0) = fmap Just $ + attrs' <> nest 2 (pretty nm <> params <> pretty lbl <> line <> pms2 <> semi) where - pms' = tupled $ sequence [dot <> expr_ False i <+> parens (expr_ False e) | (i,_,_,e) <- pms] + pms2 = case pms0 of + NamedPortMap pms1 -> + let pm i e = dot <> expr_ False i <+> parens (expr_ False e) in + tupled $ sequence [pm i e | (i,_,_,e) <- pms1] + IndexedPortMap pms1 -> + tupled $ sequence [expr_ False e | (_,_,e) <- pms1] + params | null ps = space | otherwise = line <> "#" <> tupled (sequence [dot <> expr_ False i <+> parens (expr_ False e) | (i,_,e) <- ps]) <> line + attrs' + | null attrs = emptyDoc + | otherwise = addAttrs attrs line inst_ (BlackBoxD _ libs imps inc bs bbCtx) = fmap Just (Mon (column (renderBlackBox libs imps inc bs bbCtx))) @@ -1000,7 +930,7 @@ seq_ (SeqDecl sd) = case sd of Assignment id_ e -> - stringS id_ <+> equals <+> expr_ False e <> semi + pretty id_ <+> equals <+> expr_ False e <> semi BlackBoxD {} -> fromMaybe <$> emptyDoc <*> inst_ sd @@ -1012,7 +942,7 @@ seqs :: [Seq] -> SystemVerilogM Doc seqs [] = emptyDoc -seqs (SeqDecl (TickDecl id_):ds) = "//" <+> stringS id_ <> line <> seqs ds +seqs (SeqDecl (TickDecl id_):ds) = "//" <+> pretty id_ <> line <> seqs ds seqs (d:ds) = seq_ d <> line <> line <> seqs ds -- | Turn a Netlist expression into a SystemVerilog expression @@ -1020,7 +950,7 @@ -> Expr -- ^ Expr to convert -> SystemVerilogM Doc expr_ _ (Literal sizeM lit) = exprLitSV sizeM lit -expr_ _ (Identifier id_ Nothing) = stringS id_ +expr_ _ (Identifier id_ Nothing) = pretty id_ expr_ _ (Identifier id_ (Just (Indexed (CustomSP _id dataRepr _size args,dcI,fI)))) = case fieldTy of Void {} -> @@ -1030,7 +960,7 @@ where (ConstrRepr' _name _n _mask _value anns, _, fieldTypes) = args !! dcI ranges = map range' $ bitRanges (anns !! fI) - range' (start, end) = stringS id_ <> brackets (int start <> ":" <> int end) + range' (start, end) = pretty id_ <> brackets (int start <> ":" <> int end) fieldTy = indexNote ($(curLoc) ++ "panic") fieldTypes fI expr_ _ (Identifier id_ (Just (Indexed (CustomProduct _id dataRepr _size _maybeFieldNames args,dcI,fI)))) = @@ -1042,10 +972,11 @@ where (anns, fieldTypes) = unzip args ranges = map range' $ bitRanges (anns !! fI) - range' (start, end) = stringS id_ <> brackets (int start <> ":" <> int end) + range' (start, end) = pretty id_ <> brackets (int start <> ":" <> int end) fieldTy = indexNote ($(curLoc) ++ "panic") fieldTypes fI -expr_ _ (Identifier id_ (Just (Indexed (ty@(SP _ args),dcI,fI)))) = fromSLV argTy id_ start end +expr_ _ (Identifier id_ (Just (Indexed (ty@(SP _ args),dcI,fI)))) = + fromSLV argTy (Id.toText id_) start end where argTys = snd $ args !! dcI argTy = argTys !! fI @@ -1055,60 +986,60 @@ end = start - argSize + 1 expr_ _ (Identifier id_ (Just (Indexed (ty@(Product _ _ tys),_,fI)))) = do - id'<- fmap (Text.toStrict . renderOneLine) (stringS id_ <> dot <> tyName ty <> "_sel" <> int fI) + id'<- fmap (Text.toStrict . renderOneLine) (pretty id_ <> dot <> tyName ty <> "_sel" <> int fI) simpleFromSLV (tys !! fI) id' expr_ _ (Identifier id_ (Just (Indexed ((Vector _ elTy),1,0)))) = do - id' <- fmap (Text.toStrict . renderOneLine) (stringS id_ <> brackets (int 0)) + id' <- fmap (Text.toStrict . renderOneLine) (pretty id_ <> brackets (int 0)) simpleFromSLV elTy id' -expr_ _ (Identifier id_ (Just (Indexed ((Vector n _),1,1)))) = stringS id_ <> brackets (int 1 <> colon <> int (n-1)) +expr_ _ (Identifier id_ (Just (Indexed ((Vector n _),1,1)))) = pretty id_ <> brackets (int 1 <> colon <> int (n-1)) -- This is a "Hack", we cannot construct trees with a negative depth. This is -- here so that we can recognise merged RTree modifiers. See the code in -- @Clash.Backend.nestM@ which construct these tree modifiers. expr_ _ (Identifier id_ (Just (Indexed (RTree (-1) _,l,r)))) = - stringS id_ <> brackets (int l <> colon <> int (r-1)) + pretty id_ <> brackets (int l <> colon <> int (r-1)) expr_ _ (Identifier id_ (Just (Indexed ((RTree 0 elTy),0,0)))) = do - id' <- fmap (Text.toStrict . renderOneLine) (stringS id_ <> brackets (int 0)) + id' <- fmap (Text.toStrict . renderOneLine) (pretty id_ <> brackets (int 0)) simpleFromSLV elTy id' expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,0)))) = let z = 2^(n-1) - in stringS id_ <> brackets (int 0 <> colon <> int (z-1)) + in pretty id_ <> brackets (int 0 <> colon <> int (z-1)) expr_ _ (Identifier id_ (Just (Indexed ((RTree n _),1,1)))) = let z = 2^(n-1) z' = 2^n - in stringS id_ <> brackets (int z <> colon <> int (z'-1)) + in pretty id_ <> brackets (int z <> colon <> int (z'-1)) --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- Vector's don't have a 10'th constructor, this is just so that we can -- recognize the particular case expr_ _ (Identifier id_ (Just (Indexed ((Vector _ elTy),10,fI)))) = do - id' <- fmap (Text.toStrict . renderOneLine) (stringS id_ <> brackets (int fI)) + id' <- fmap (Text.toStrict . renderOneLine) (pretty id_ <> brackets (int fI)) simpleFromSLV elTy id' --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- RTree's don't have a 10'th constructor, this is just so that we can -- recognize the particular case expr_ _ (Identifier id_ (Just (Indexed ((RTree _ elTy),10,fI)))) = do - id' <- fmap (Text.toStrict . renderOneLine) (stringS id_ <> brackets (int fI)) + id' <- fmap (Text.toStrict . renderOneLine) (pretty id_ <> brackets (int fI)) simpleFromSLV elTy id' -expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = stringS id_ <> brackets (int start <> colon <> int end) +expr_ _ (Identifier id_ (Just (DC (ty@(SP _ _),_)))) = pretty id_ <> brackets (int start <> colon <> int end) where start = typeSize ty - 1 end = typeSize ty - conSize ty expr_ _ (Identifier id_ (Just m@Nested {})) = case modifier 0 [] m of - Nothing -> stringS id_ + Nothing -> pretty id_ Just (mods,resTy) -> do nm <- Mon $ use modNm pkgCtx <- Mon $ use tyPkgCtx let prefix = if pkgCtx then emptyDoc else stringS nm <> "_types::" - let e = stringS id_ <> hcat (mapM (either bracketNMod bracketNMod) (reverse mods)) + let e = pretty id_ <> hcat (mapM (either bracketNMod bracketNMod) (reverse mods)) case resTy of Signed _ -> "$signed" <> parens e Vector {} @@ -1132,13 +1063,13 @@ expr_ _ (Identifier id_ (Just (Indexed ((Signed w),_,_)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ -- See [Note] integer projection expr_ _ (Identifier id_ (Just (Indexed ((Unsigned w),_,_)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ -- See [Note] mask projection expr_ _ (Identifier _ (Just (Indexed ((BitVector _),_,0)))) = do @@ -1150,12 +1081,12 @@ expr_ _ (Identifier id_ (Just (Indexed ((BitVector w),_,1)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ expr_ _ (Identifier id_ (Just (Sliced ((BitVector _,start,end))))) = - stringS id_ <> brackets (int start <> ":" <> int end) + pretty id_ <> brackets (int start <> ":" <> int end) -expr_ _ (Identifier id_ (Just _)) = stringS id_ +expr_ _ (Identifier id_ (Just _)) = pretty id_ expr_ b (DataCon _ (DC (Void {}, -1)) [e]) = expr_ b e @@ -1202,6 +1133,9 @@ expr_ _ (DataCon (Product _ _ tys) _ es) = listBraces (zipWithM toSLV tys es) +expr_ _ (DataCon (Enable _) _ [e]) = + expr_ False e + expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "Clash.Sized.Internal.Signed.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx @@ -1232,20 +1166,20 @@ expr_ b (BlackBoxE _ libs imps inc bs bbCtx b') = parenIf (b || b') (Mon (renderBlackBox libs imps inc bs bbCtx <*> pure 0)) -expr_ _ (DataTag Bool (Left id_)) = stringS id_ <> brackets (int 0) +expr_ _ (DataTag Bool (Left id_)) = pretty id_ <> brackets (int 0) expr_ _ (DataTag Bool (Right id_)) = do iw <- Mon $ use intWidth - "$unsigned" <> parens (listBraces (sequence [braces (int (iw-1) <+> braces "1'b0"),stringS id_])) + "$unsigned" <> parens (listBraces (sequence [braces (int (iw-1) <+> braces "1'b0"),pretty id_])) -expr_ _ (DataTag (Sum _ _) (Left id_)) = "$unsigned" <> parens (stringS id_) -expr_ _ (DataTag (Sum _ _) (Right id_)) = "$unsigned" <> parens (stringS id_) +expr_ _ (DataTag (Sum _ _) (Left id_)) = "$unsigned" <> parens (pretty id_) +expr_ _ (DataTag (Sum _ _) (Right id_)) = "$unsigned" <> parens (pretty id_) expr_ _ (DataTag (Product {}) (Right _)) = do iw <- Mon $ use intWidth int iw <> "'sd0" expr_ _ (DataTag hty@(SP _ _) (Right id_)) = "$unsigned" <> parens - (stringS id_ <> brackets + (pretty id_ <> brackets (int start <> colon <> int end)) where start = typeSize hty - 1 @@ -1265,33 +1199,33 @@ iw <- Mon $ use intWidth int iw <> "'sd1" -expr_ b (ConvBV topM t True e) = do +expr_ b (ToBv topM t e) = do nm <- Mon $ use modNm pkgCtx <- Mon $ use tyPkgCtx let prefix = if pkgCtx then emptyDoc else stringS nm <> "_types::" case t of Vector {} -> do Mon (tyCache %= HashSet.insert t) - maybe prefix ((<> "_types::") . stringS) topM <> + maybe prefix ((<> "_types::") . pretty) topM <> tyName t <> "_to_lv" <> parens (expr_ False e) RTree {} -> do Mon (tyCache %= HashSet.insert t) - maybe prefix ((<> "_types::") . stringS) topM <> + maybe prefix ((<> "_types::") . pretty) topM <> tyName t <> "_to_lv" <> parens (expr_ False e) _ -> expr b e -expr_ b (ConvBV topM t False e) = do +expr_ b (FromBv topM t e) = do nm <- Mon $ use modNm pkgCtx <- Mon $ use tyPkgCtx let prefix = if pkgCtx then emptyDoc else stringS nm <> "_types::" case t of Vector {} -> do Mon (tyCache %= HashSet.insert t) - maybe prefix ((<> "_types::") . stringS) topM <> + maybe prefix ((<> "_types::") . pretty) topM <> tyName t <> "_from_lv" <> parens (expr_ False e) RTree {} -> do Mon (tyCache %= HashSet.insert t) - maybe prefix ((<> "_types::") . stringS) topM <> + maybe prefix ((<> "_types::") . pretty) topM <> tyName t <> "_from_lv" <> parens (expr_ False e) _ -> expr b e @@ -1326,17 +1260,17 @@ RTree _ _ -> braces (verilogTypeMark t <> "_to_lv" <> parens (expr_ False e)) _ -> expr_ False e -fromSLV :: HWType -> Identifier -> Int -> Int -> SystemVerilogM Doc -fromSLV t@(Vector _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (stringS id_ <> brackets (int start <> colon <> int end)) -fromSLV t@(RTree _ _) id_ start end = verilogTypeMark t <> "_from_lv" <> parens (stringS id_ <> brackets (int start <> colon <> int end)) -fromSLV (Signed _) id_ start end = "$signed" <> parens (stringS id_ <> brackets (int start <> colon <> int end)) -fromSLV _ id_ start end = stringS id_ <> brackets (int start <> colon <> int end) +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 _ id_ start end = pretty id_ <> brackets (int start <> colon <> int end) -simpleFromSLV :: HWType -> Identifier -> SystemVerilogM Doc -simpleFromSLV t@(Vector _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (stringS id_) -simpleFromSLV t@(RTree _ _) id_ = verilogTypeMark t <> "_from_lv" <> parens (stringS id_) -simpleFromSLV (Signed _) id_ = "$signed" <> parens (stringS id_) -simpleFromSLV _ id_ = stringS id_ +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 _ id_ = pretty id_ expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc expFromSLV t@(Vector _ _) exp_ = verilogTypeMark t <> "_from_lv" <> parens exp_ @@ -1448,7 +1382,7 @@ rhsS = (d-1)^(2 :: Int) rhsE = d^(2 :: Int)-1 --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- Vector's don't have a 10'th constructor, this is just so that we can -- recognize the particular case modifier offset mods (Indexed (ty@(Vector _ argTy),10,fI)) = case mods of @@ -1460,7 +1394,7 @@ start = typeSize ty - (fI * argSize) - 1 end = start - argSize + 1 --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- RTree's don't have a 10'th constructor, this is just so that we can -- recognize the particular case modifier offset mods (Indexed (ty@(RTree _ argTy),10,fI)) = case mods of diff --git a/src/Clash/Backend/VHDL.hs b/src/Clash/Backend/VHDL.hs --- a/src/Clash/Backend/VHDL.hs +++ b/src/Clash/Backend/VHDL.hs @@ -13,6 +13,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} module Clash.Backend.VHDL (VHDLState) where @@ -23,7 +24,6 @@ import Control.Monad (forM,join,zipWithM) import Control.Monad.State (State, StateT) import Data.Bits (testBit, Bits) -import Data.Hashable (Hashable) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashMap.Strict as HashMapS @@ -32,7 +32,7 @@ import Data.List (mapAccumL, nub, nubBy, intersperse, group, sort) import Data.List.Extra ((<:>), equalLength, zipEqual) -import Data.Maybe (catMaybes,fromMaybe,mapMaybe) +import Data.Maybe (catMaybes,mapMaybe) #if !MIN_VERSION_base(4,11,0) import Data.Monoid hiding (Sum, Product) #endif @@ -59,11 +59,12 @@ import Clash.Netlist.BlackBox.Types (HdlSyn (..)) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) -import Clash.Netlist.Id (IdType (..), mkBasicId') +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types hiding (_intWidth, intWidth) -import Clash.Netlist.Util hiding (mkIdentifier) +import Clash.Netlist.Util import Clash.Util (SrcSpan, noSrcSpan, clogBase, curLoc, first, makeCached, on, indexNote) +import qualified Clash.Util.Interpolate as I import Clash.Util.Graph (reverseTopSort) import Clash.Backend.Verilog (Range (..), continueWithRange) @@ -71,14 +72,12 @@ -- | State for the 'Clash.Netlist.VHDL.VHDLM' monad: data VHDLState = VHDLState - { _tyCache :: (HashSet HWType) + { _tyCache :: HashSet HWType -- ^ Previously encountered HWTypes - , _tySeen :: HashMap Identifier Word - -- ^ Generated product types , _nameCache :: (HashMap (HWType, Bool) TextS.Text) -- ^ Cache for type names. Bool indicates whether this name includes length -- information in its first "part". See `tyName'` for more information. - , _modNm :: Identifier + , _modNm :: ModName , _srcSpan :: SrcSpan , _libraries :: [T.Text] , _packages :: [T.Text] @@ -88,20 +87,40 @@ , _memoryDataFiles:: [(String,String)] -- ^ Files to be stored: (filename, contents). These files are generated -- during the execution of 'genNetlist'. - , _idSeen :: HashMapS.HashMap Identifier Word + , _idSeen :: IdentifierSet , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn -- ^ For which HDL synthesis tool are we generating VHDL - , _extendedIds :: Bool , _undefValue :: Maybe (Maybe Int) + , _productFieldNameCache :: HashMap (Maybe [TextS.Text], [HWType]) [TextS.Text] + -- ^ Caches output of 'productFieldNames'. + , _aggressiveXOptBB_ :: AggressiveXOptBB } makeLenses ''VHDLState +instance HasIdentifierSet VHDLState where + identifierSet = idSeen + instance Backend VHDLState where - initBackend = VHDLState HashSet.empty HashMap.empty HashMap.empty "" - noSrcSpan [] [] [] [] [] HashMapS.empty + initBackend w hdlsyn_ esc lw undefVal xOpt = VHDLState + { _tyCache=mempty + , _nameCache=mempty + , _modNm="" + , _srcSpan=noSrcSpan + , _libraries=[] + , _packages=[] + , _includes=[] + , _dataFiles=[] + , _memoryDataFiles=[] + , _idSeen=Id.emptyIdentifierSet esc lw VHDL + , _intWidth=w + , _hdlsyn=hdlsyn_ + , _undefValue=undefVal + , _productFieldNameCache=mempty + , _aggressiveXOptBB_=xOpt + } hdlKind = const VHDL primDirs = const $ do root <- primsRoot return [ root System.FilePath. "common" @@ -113,6 +132,38 @@ genHDL = genVHDL mkTyPackage = mkTyPackage_ + hdlHWTypeKind = \case + Vector {} -> pure UserType + RTree {} -> pure UserType + Product {} -> pure UserType + + Clock {} -> pure SynonymType + Reset {} -> pure SynonymType + Enable {} -> pure SynonymType + Index {} -> pure SynonymType + CustomSP {} -> pure SynonymType + SP {} -> pure SynonymType + Sum {} -> pure SynonymType + CustomSum {} -> pure SynonymType + CustomProduct {} -> pure SynonymType + + BitVector _ -> pure PrimitiveType + Bool -> pure PrimitiveType + Bit -> pure PrimitiveType + Unsigned {} -> pure PrimitiveType + Signed {} -> pure PrimitiveType + String -> pure PrimitiveType + Integer -> pure PrimitiveType + FileType -> pure PrimitiveType + + -- Transparent types: + BiDirectional _ ty -> hdlHWTypeKind ty + Annotated _ ty -> hdlHWTypeKind ty + + -- Shouldn't be printed? + Void {} -> pure PrimitiveType + KnownDomain {} -> pure PrimitiveType + hdlType Internal (filterTransparent -> ty) = sizedQualTyName ty hdlType (External nm) (filterTransparent -> ty) = let sized = sizedQualTyName ty in @@ -135,46 +186,21 @@ | isBV t = pretty id_ | otherwise = do nm <- Mon $ use modNm - seen <- use seenIdentifiers + -- TODO: restore hack +-- seen <- use seenIdentifiers -- This is a bit hacky, as id_ is just a rendered expression. -- But if it's a bare identifier that we've seen before, -- then this identifier has a defined type and we can skip the explicit type qualification. - let e | T.toStrict id_ `HashMapS.member` seen = pretty id_ - | otherwise = hdlTypeMark t <> squote <> parens (pretty id_) - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens e +-- let e | T.toStrict id_ `HashMapS.member` seen = pretty id_ +-- | otherwise = + let e = hdlTypeMark t <> squote <> parens (pretty id_) + pretty nm <> "_types.toSLV" <> parens e fromBV t id_ | isBV t = pretty id_ | otherwise = do nm <- Mon $ use modNm - qualTyName t <> "'" <> parens (pretty (TextS.toLower nm) <> "_types.fromSLV" <> parens (pretty id_)) + qualTyName t <> "'" <> parens (pretty nm <> "_types.fromSLV" <> parens (pretty id_)) hdlSyn = use hdlsyn - mkIdentifier = do - allowExtended <- use extendedIds - return (go allowExtended) - where - go _ Basic nm = - case (stripTrailingUnderscore . filterReserved) (TextS.toLower (mkBasicId' VHDL True nm)) of - nm' | TextS.null nm' -> "clash_internal" - | otherwise -> nm' - go esc Extended (rmSlash -> nm) = case go esc Basic nm of - nm' | esc && nm /= nm' -> TextS.concat ["\\",nm,"\\"] - | otherwise -> nm' - extendIdentifier = do - allowExtended <- use extendedIds - return (go allowExtended) - where - go _ Basic nm ext = - case (stripTrailingUnderscore . filterReserved) (TextS.toLower (mkBasicId' VHDL True (nm `TextS.append` ext))) of - nm' | TextS.null nm' -> "clash_internal" - | otherwise -> nm' - go esc Extended ((rmSlash . escapeTemplate) -> nm) ext = - let nmExt = nm `TextS.append` ext - in case go esc Basic nm ext of - nm' | esc && nm' /= nmExt -> case TextS.isPrefixOf "c$" nmExt of - True -> TextS.concat ["\\",nmExt,"\\"] - _ -> TextS.concat ["\\c$",nmExt,"\\"] - | otherwise -> nm' - setModName nm s = s {_modNm = nm} setSrcSpan = (srcSpan .=) getSrcSpan = use srcSpan @@ -190,12 +216,11 @@ pure decs <> if null attrs then emptyDoc - else line <> line <> renderAttrs attrs) <> line <> + else line <> line <> renderAttrs (TextS.pack "signal") attrs) <> line <> nest 2 ("begin" <> line <> insts ds) <> line <> "end block" <> semi - unextend = return rmSlash addIncludes inc = includes %= (inc++) addLibraries libs = libraries %= (libs ++) addImports imps = packages %= (imps ++) @@ -207,13 +232,8 @@ getDataFiles = use dataFiles addMemoryDataFile f = memoryDataFiles %= (f:) getMemoryDataFiles = use memoryDataFiles - seenIdentifiers = idSeen ifThenElseExpr _ = False - -rmSlash :: Identifier -> Identifier -rmSlash nm = fromMaybe nm $ do - nm1 <- TextS.stripPrefix "\\" nm - pure (TextS.filter (not . (== '\\')) nm1) + aggressiveXOptBB = use aggressiveXOptBB_ type VHDLM a = Mon (State VHDLState) a @@ -222,91 +242,17 @@ isBV (normaliseType -> BitVector _) = True isBV _ = False --- | Time units: are added to 'reservedWords' as simulators trip over signals --- named after them. -timeUnits :: [Identifier] -timeUnits = ["fs", "ps", "ns", "us", "ms", "sec", "min", "hr"] - --- | Identifiers which are imported from the following: --- --- use IEEE.STD_LOGIC_1164.ALL; --- use IEEE.NUMERIC_STD.ALL; --- use IEEE.MATH_REAL.ALL; --- use std.textio.all; --- --- Clash should not use these identifiers, as it can lead to errors when --- interfacing with an EDA tool. --- --- See https://github.com/clash-lang/clash-compiler/issues/1439. --- -importedNames :: [Identifier] -importedNames = - [ -- ieee.std_logic_1164.all - "std_ulogic", "std_ulogic_vector", "resolved", "std_logic", "std_logic_vector" - , "x01", "x01z", "ux01", "ux01z", "to_bit", "to_bitvector", "to_stdulogic" - , "to_stdlogicvector", "to_stdulogicvector", "to_01", "to_x01", "to_x01z" - , "to_ux01", "rising_edge", "falling_edge", "is_x" - -- ieee.numeric_std.all - , "unresolved_unsigned", "unresolved_signed", "u_unsigned", "u_signed" - , "unsigned", "signed", "find_leftmost", "find_rightmost", "minimum" - , "maximum", "shift_left", "shift_right", "rotate_left", "rotate_right" - , "resize", "to_integer", "to_unsigned", "to_signed", "std_match" - -- ieee.math_real.all - , "math_e", "math_1_over_e", "math_pi", "math_2_pi", "math_1_over_pi" - , "math_pi_over_2", "math_pi_over_3", "path_pi_over_4", "path_3_pi_over_2" - , "math_log_of_2", "math_log_of_10", "math_log10_of_e", "math_sqrt_2" - , "math_1_over_sqrt_2", "math_sqrt_pi", "math_deg_to_rad", "math_rad_to_deg" - , "sign", "ceil", "floor", "round", "trunc", "realmax", "realmin", "uniform" - , "sqrt", "cbrt", "exp", "log", "log2", "log10", "sin", "cos", "tan", "arcsin" - , "arccos", "arctan", "sinh", "cosh", "tanh", "arcsinh", "arccosh", "arctanh" - -- std.textio.all - , "line", "text", "side", "width", "justify", "input", "output", "readline" - , "read", "sread", "string_read", "bread", "binary_read", "oread", "octal_read" - , "hread", "hex_read", "writeline", "tee", "write", "swrite", "string_write" - , "bwrite", "binary_write", "owrite", "octal_write", "hwrite", "hex_write" - ] - --- List of reserved VHDL-2008 keywords --- + used internal names: toslv, fromslv, tagtoenum, datatotag --- + used IEEE library names: integer, boolean, std_logic, std_logic_vector, --- signed, unsigned, to_integer, to_signed, to_unsigned, string -reservedWords :: [Identifier] -reservedWords = ["abs","access","after","alias","all","and","architecture" - ,"array","assert","assume","assume_guarantee","attribute","begin","block" - ,"body","buffer","bus","case","component","configuration","constant","context" - ,"cover","default","disconnect","downto","else","elsif","end","entity","exit" - ,"fairness","file","for","force","function","generate","generic","group" - ,"guarded","if","impure","in","inertial","inout","is","label","library" - ,"linkage","literal","loop","map","mod","nand","new","next","nor","not","null" - ,"of","on","open","or","others","out","package","parameter","port","postponed" - ,"procedure","process","property","protected","pure","range","record" - ,"register","reject","release","rem","report","restrict","restrict_guarantee" - ,"return","rol","ror","select","sequence","severity","signal","shared","sla" - ,"sll","sra","srl","strong","subtype","then","to","transport","type" - ,"unaffected","units","until","use","variable","vmode","vprop","vunit","wait" - ,"when","while","with","xnor","xor","toslv","fromslv","tagtoenum","datatotag" - ,"integer", "boolean", "std_logic", "std_logic_vector", "signed", "unsigned" - ,"to_integer", "to_signed", "to_unsigned", "string","log"] ++ timeUnits ++ importedNames - -filterReserved :: Identifier -> Identifier -filterReserved s = if s `elem` reservedWords - then s `TextS.append` "_r" - else s - -stripTrailingUnderscore :: Identifier -> Identifier -stripTrailingUnderscore = TextS.dropWhileEnd (== '_') - -- | Generate unique (partial) names for product fields. Example: -- -- >>> productFieldNames [Unsigned 6, Unsigned 6, Bit, Bool] -- ["unsigned6_0", "unsigned6_1", "bit", "boolean"] productFieldNames :: HasCallStack - => Maybe [TextS.Text] + => Maybe [IdentifierText] -- ^ Label hints. From user records, for example. -> [HWType] -- ^ Field types - -> VHDLM [TextS.Text] + -> VHDLM [IdentifierText] productFieldNames labels0 fields = do let labels1 = sequence labels0 ++ repeat Nothing hFields <- zipWithM hName labels1 fields @@ -318,19 +264,17 @@ return names where hName - :: Maybe Identifier + :: Maybe IdentifierText -> HWType - -> VHDLM Identifier - hName Nothing field = - tyName' False field - hName (Just label) _field = do - Mon (mkIdentifier <*> pure Basic <*> pure label) + -> VHDLM IdentifierText + hName Nothing field = tyName' False field + hName (Just label) _field = Id.toText <$> Id.makeBasic label name' - :: HashMap TextS.Text Int - -> HashMap TextS.Text Int - -> TextS.Text - -> (HashMap TextS.Text Int, TextS.Text) + :: HashMap IdentifierText Int + -> HashMap IdentifierText Int + -> IdentifierText + -> (HashMap IdentifierText Int, IdentifierText) name' counted countMap fieldName | counted HashMapS.! fieldName > 1 = -- Seen this fieldname more than once, so we need to add a number @@ -347,7 +291,7 @@ productFieldName :: HasCallStack - => Maybe [TextS.Text] + => Maybe [IdentifierText] -- ^ Label hints. From user records, for example. -> [HWType] -- ^ Field types @@ -355,13 +299,16 @@ -- ^ Index of field -> VHDLM Doc productFieldName labels fields fieldIndex = do - -- TODO: cache - names <- productFieldNames labels fields + names <- + makeCached + (labels, fields) + productFieldNameCache + (productFieldNames labels fields) return (PP.pretty (names !! fieldIndex)) selectProductField :: HasCallStack - => Maybe [TextS.Text] + => Maybe [IdentifierText] -- ^ Label hints. From user records, for example. -> [HWType] -- ^ Field types @@ -372,17 +319,26 @@ "_sel" <> int fieldIndex <> "_" <> productFieldName fieldLabels fieldTypes fieldIndex -- | Generate VHDL for a Netlist component -genVHDL :: Identifier -> SrcSpan -> HashMapS.HashMap Identifier Word -> Component -> VHDLM ((String,Doc),[(String,Doc)]) -genVHDL nm sp seen c = preserveSeen $ do - Mon $ idSeen .= seen - -- Don't have type names conflict with component names - Mon $ tySeen %= HashMap.unionWith max seen +genVHDL + :: ModName + -> SrcSpan + -> IdentifierSet + -> Component + -> VHDLM ((String, Doc), [(String, Doc)]) +genVHDL nm sp seen c = do + -- Don't have type names conflict with module names or with previously + -- generated type names. + -- + -- TODO: Collect all type names up front, to prevent relatively costly union. + -- TODO: Investigate whether type names / signal names collide in the first place + Mon $ idSeen %= Id.union seen + Mon $ setSrcSpan sp v <- vhdl i <- Mon $ use includes Mon $ libraries .= [] Mon $ packages .= [] - return ((TextS.unpack cName,v),i) + return ((TextS.unpack (Id.toText cName), v), i) where cName = componentName c vhdl = do @@ -395,23 +351,20 @@ pure arch) -- | Generate a VHDL package containing type definitions for the given HWTypes -mkTyPackage_ :: Identifier - -> [HWType] - -> VHDLM [(String,Doc)] +mkTyPackage_ :: ModName -> [HWType] -> VHDLM [(String,Doc)] mkTyPackage_ modName (map filterTransparent -> hwtys) = do { syn <- Mon hdlSyn - ; mkId <- Mon (mkIdentifier <*> pure Basic) ; let usedTys = concatMap mkUsedTys hwtys ; let normTys0 = nub (map mkVecZ (hwtys ++ usedTys)) ; let sortedTys0 = topSortHWTys normTys0 packageDec = vcat $ mapM tyDec (nubBy eqTypM sortedTys0) (funDecs,funBodies) = unzip . mapMaybe (funDec syn) $ nubBy eqTypM (map normaliseType sortedTys0) - ; (:[]) <$> (TextS.unpack $ mkId (modName `TextS.append` "_types"),) <$> + ; (:[]) <$> (TextS.unpack (modName `TextS.append` "_types"),) <$> "library IEEE;" <> line <> "use IEEE.STD_LOGIC_1164.ALL;" <> line <> "use IEEE.NUMERIC_STD.ALL;" <> line <> line <> - "package" <+> pretty (mkId (modName `TextS.append` "_types")) <+> "is" <> line <> + "package" <+> pretty (modName `TextS.append` "_types") <+> "is" <> line <> indent 2 ( packageDec <> line <> vcat (sequence funDecs) ) <> line <> @@ -422,9 +375,8 @@ packageBodyDec funBodies = case funBodies of [] -> emptyDoc _ -> do - { mkId <- Mon (mkIdentifier <*> pure Basic) - ; line <> line <> - "package" <+> "body" <+> pretty (mkId (modName `TextS.append` "_types")) <+> "is" <> line <> + { line <> line <> + "package" <+> "body" <+> pretty (modName `TextS.append` "_types") <+> "is" <> line <> indent 2 (vcat (sequence funBodies)) <> line <> "end" <> semi } @@ -559,6 +511,7 @@ -- Type aliases: Clock _ -> typAliasDec hwty Reset _ -> typAliasDec hwty + Enable _ -> typAliasDec hwty Index _ -> typAliasDec hwty CustomSP _ _ _ _ -> typAliasDec hwty SP _ _ -> typAliasDec hwty @@ -574,6 +527,7 @@ Signed _ -> emptyDoc String -> emptyDoc Integer -> emptyDoc + FileType -> emptyDoc -- Transparent types: BiDirectional _ ty -> tyDec ty @@ -582,7 +536,10 @@ Void {} -> emptyDoc KnownDomain {} -> emptyDoc - _ -> error $ $(curLoc) ++ show hwty + -- Unexpected arguments: + Product _ _ _ -> error $ $(curLoc) ++ [I.i| + Unexpected Product with fewer than 2 fields: #{hwty} + |] @@ -809,9 +766,8 @@ funDec _ _ = Nothing -tyImports :: Identifier -> VHDLM Doc +tyImports :: ModName -> VHDLM Doc tyImports nm = do - mkId <- Mon (mkIdentifier <*> pure Basic) libs <- Mon $ use libraries packs <- Mon $ use packages punctuate' semi $ sequence @@ -821,20 +777,20 @@ , "use IEEE.MATH_REAL.ALL" , "use std.textio.all" , "use work.all" - , "use work." <> pretty (mkId (nm `TextS.append` "_types")) <> ".all" + , "use work." <> pretty (nm `TextS.append` "_types") <> ".all" ] ++ (map (("library" <+>) . pretty) (nub libs)) ++ (map (("use" <+>) . pretty) (nub packs))) -- TODO: Way too much happening on a single line port :: Num t - => TextS.Text + => Identifier -> HWType -> VHDLM Doc -> Int -> Maybe Expr -> VHDLM (Doc, t) -port elName hwType portDirection fillToN iEM = +port (Id.toText -> elName) hwType portDirection fillToN iEM = (,fromIntegral $ TextS.length elName) <$> (encodingNote hwType <> fill fillToN (pretty elName) <+> colon <+> direction <+> sizedQualTyName hwType <> iE) @@ -878,7 +834,7 @@ rports p = "port" <> (parens (align (vcat (punctuate semi (pure p))))) <> semi - rattrs = renderAttrs attrs + rattrs = renderAttrs (TextS.pack "signal") attrs attrs = inputAttrs ++ outputAttrs inputAttrs = [(id_, attr) | (id_, hwtype) <- inputs c, attr <- hwTypeAttrs hwtype] outputAttrs = [(id_, attr) | (_wireOrReg, (id_, hwtype), _) <- outputs c, attr <- hwTypeAttrs hwtype] @@ -894,7 +850,7 @@ ; nest 2 (("architecture structural of" <+> pretty (componentName c) <+> "is" <> line <> decls (declarations c)) <> line <> - if null attrs then emptyDoc else line <> line <> renderAttrs attrs) <> line <> + if null attrs then emptyDoc else line <> line <> renderAttrs (TextS.pack "signal") attrs) <> line <> nest 2 ("begin" <> line <> insts (declarations c)) <> line <> @@ -941,13 +897,15 @@ attrMap :: forall t . t ~ HashMap T.Text (T.Text, [(TextS.Text, T.Text)]) - => [(TextS.Text, Attr')] + => [(Identifier, Attr')] -> t -attrMap attrs = foldl go empty' attrs +attrMap attrs0 = foldl go empty' attrs1 where + attrs1 = map (first Id.toText) attrs0 + empty' = HashMap.fromList [(k, (types HashMap.! k, [])) | k <- HashMap.keys types] - types = attrTypes (map snd attrs) + types = attrTypes (map snd attrs1) go :: t -> (TextS.Text, Attr') -> t go map' attr = HashMap.adjust @@ -963,10 +921,11 @@ (typ, (signalName, renderAttr attr) : elems) renderAttrs - :: [(TextS.Text, Attr')] + :: TextS.Text + -> [(Identifier, Attr')] -> VHDLM Doc -renderAttrs (attrMap -> attrs) = - vcat $ sequence $ intersperse " " $ map renderAttrGroup (assocs attrs) +renderAttrs what (attrMap -> attrs) = + vcat $ sequence $ intersperse " " $ map renderAttrGroup (HashMap.toList attrs) where renderAttrGroup :: (T.Text, (T.Text, [(TextS.Text, T.Text)])) @@ -984,18 +943,12 @@ "attribute" <+> string attrname <+> "of" - <+> stringS signalName + <+> stringS signalName -- or component name <+> colon - <+> "signal is" + <+> stringS what <+> "is" -- "signal is" or "component is" <+> string value <> semi --- | Return all key/value pairs in the map in arbitrary key order. -assocs :: Eq a => Hashable a => HashMap a b -> [(a,b)] -assocs m = zip keys (map (m HashMap.!) keys) - where - keys = (HashMap.keys m) - -- | Convert single attribute to VHDL syntax renderAttr :: Attr' -> T.Text renderAttr (StringAttr' _key value) = T.replace "\\\"" "\"\"" $ T.pack $ show value @@ -1043,7 +996,7 @@ -- Custom types: _ -> do modName <- Mon (use modNm) - pretty (TextS.toLower modName) <> "_types." <> tyName hwty + pretty modName <> "_types." <> tyName hwty -- | Generates a unique name for a given type. This action will cache its -- results, thus returning the same answer for the same @HWType@ argument. @@ -1115,6 +1068,9 @@ Reset nm0 -> let nm1 = "rst_" `TextS.append` nm0 in Mon $ makeCached (t, False) nameCache (userTyName "rst" nm1 t) + Enable nm0 -> + let nm1 = "en_" `TextS.append` nm0 in + Mon $ makeCached (t, False) nameCache (userTyName "en" nm1 t) Sum nm _ -> Mon $ makeCached (t, False) nameCache (userTyName "sum" nm t) CustomSum nm _ _ _ -> @@ -1158,6 +1114,7 @@ -- Simple types, for which a subtype (without qualifiers) will be made in VHDL: Clock _ -> Bit Reset _ -> Bit + Enable _ -> Bool Index _ -> Unsigned (typeSize hwty) CustomSP _ _ _ _ -> BitVector (typeSize hwty) SP _ _ -> BitVector (typeSize hwty) @@ -1181,6 +1138,7 @@ Bit -> hwty Clock _ -> hwty Reset _ -> hwty + Enable _ -> hwty Index _ -> hwty Sum _ _ -> hwty CustomSum _ _ _ _ -> hwty @@ -1212,31 +1170,16 @@ -- | Create a unique type name for user defined types userTyName - :: Identifier + :: IdentifierText -- ^ Default name - -> Identifier + -> IdentifierText -- ^ Identifier stored in @hwTy@ -> HWType -- ^ Type to give a (unique) name - -> StateT VHDLState Identity TextS.Text + -> StateT VHDLState Identity IdentifierText userTyName dflt nm0 hwTy = do tyCache %= HashSet.insert hwTy - seen <- use tySeen - mkId <- mkIdentifier <*> pure Basic - let nm1 = (mkId . last . TextS.splitOn ".") nm0 - nm2 = if TextS.null nm1 then dflt else nm1 - (nm3,count) = case HashMap.lookup nm2 seen of - Just cnt -> go mkId seen cnt nm2 - Nothing -> (nm2,0) - tySeen %= HashMap.insert nm3 count - return nm3 - where - go mkId seen count nm0' = - let nm1' = nm0' `TextS.append` TextS.pack ('_':show count) in - case HashMap.lookup nm1' seen of - Just _ -> go mkId seen (count+1) nm0' - Nothing -> (nm1',count+1) - + Id.toText <$> Id.makeBasicOr (last (TextS.splitOn "." nm0)) dflt -- | Convert a Netlist HWType to an error VHDL value for that type sizedQualTyNameErrValue :: HWType -> VHDLM Doc @@ -1262,8 +1205,9 @@ _ -> qualTyName t <> "'" <> parens (int 0 <+> "to" <+> int (2^n - 1) <+> rarrow <+> sizedQualTyNameErrValue elTy) sizedQualTyNameErrValue t@(Product _ _ elTys) = qualTyName t <> "'" <> tupled (mapM sizedQualTyNameErrValue elTys) -sizedQualTyNameErrValue (Reset {}) = singularErrValue sizedQualTyNameErrValue (Clock _) = singularErrValue +sizedQualTyNameErrValue (Reset _) = singularErrValue +sizedQualTyNameErrValue (Enable _) = singularErrValue sizedQualTyNameErrValue (Void {}) = return (error ($(curLoc) ++ "[CLASH BUG] Forced to print Void error value")) sizedQualTyNameErrValue String = "\"ERROR\"" @@ -1293,16 +1237,16 @@ rec (dsDoc,ls) <- fmap (unzip . catMaybes) $ mapM (decl (maximum ls)) ds case dsDoc of [] -> emptyDoc - _ -> punctuate' semi (pure dsDoc) + _ -> vcat (pure dsDoc) decl :: Int -> Declaration -> VHDLM (Maybe (Doc,Int)) -decl l (NetDecl' noteM _ id_ ty iEM) = Just <$> (,fromIntegral (TextS.length id_)) <$> - maybe id addNote noteM ("signal" <+> fill l (pretty id_) <+> colon <+> either pretty sizedQualTyName ty <> iE) +decl l (NetDecl' noteM _ id_ ty iEM) = Just <$> (,fromIntegral (TextS.length (Id.toText id_))) <$> + maybe id addNote noteM ("signal" <+> fill l (pretty id_) <+> colon <+> either pretty sizedQualTyName ty <> iE <> semi) where addNote n = mappend ("--" <+> pretty n <> line) iE = maybe emptyDoc (noEmptyInit . expr_ False) iEM -decl _ (InstDecl Comp _ nm _ gens pms) = fmap (Just . (,0)) $ do +decl _ (InstDecl Comp _ attrs nm _ gens (NamedPortMap pms)) = fmap (Just . (,0)) $ do { rec (p,ls) <- fmap unzip $ sequence [ (,formalLength i) <$> fill (maximum ls) (expr_ False i) <+> colon <+> portDir dir <+> sizedQualTyName ty | (i,dir,ty,_) <- pms ] ; rec (g,lsg) <- fmap unzip $ sequence [ (,formalLength i) <$> fill (maximum lsg) (expr_ False i) <+> colon <+> tyName ty | (i,ty,_) <- gens] ; "component" <+> pretty nm <> line <> @@ -1310,15 +1254,18 @@ else indent 2 ("generic" <> line <> tupledSemi (pure g) <> semi) <> line ) <> indent 2 ("port" <+> tupledSemi (pure p) <> semi) <> line <> - "end component" + "end component" <> semi <> line + <> attrs' } where - formalLength (Identifier i _) = fromIntegral (TextS.length i) + formalLength (Identifier i _) = fromIntegral (TextS.length (Id.toText i)) formalLength _ = 0 portDir In = "in" portDir Out = "out" + attrs' = if null attrs then emptyDoc else renderAttrs (TextS.pack "component") [(nm, a) | a <- attrs] + decl _ _ = return Nothing noEmptyInit :: VHDLM Doc -> VHDLM Doc @@ -1387,7 +1334,12 @@ _ -> insts ds -- | Helper function for inst_, handling CustomSP and CustomSum -inst_' :: TextS.Text -> Expr -> HWType -> [(Maybe Literal, Expr)] -> VHDLM (Maybe Doc) +inst_' + :: Identifier + -> Expr + -> HWType + -> [(Maybe Literal, Expr)] + -> VHDLM (Maybe Doc) inst_' id_ scrut scrutTy es = fmap Just $ (pretty id_ <+> larrow <+> align (vcat (conds esNub) <> semi)) where @@ -1440,20 +1392,26 @@ conds ((Nothing,e):_) = expr_ False e <+> "when" <+> "others" <:> return [] conds ((Just c ,e):es') = expr_ False e <+> "when" <+> patLit scrutTy c <:> conds es' -inst_ (InstDecl entOrComp libM nm lbl gens pms) = do +inst_ (InstDecl entOrComp libM _ nm lbl gens pms0) = do maybe (return ()) (\lib -> Mon (libraries %= (T.fromStrict lib:))) libM fmap Just $ nest 2 $ pretty lbl <+> colon <> entOrComp' - <+> maybe emptyDoc ((<> ".") . pretty) libM <> pretty nm <> line <> gms <> pms' <> semi + <+> maybe emptyDoc ((<> ".") . pretty) libM <> pretty nm <> line <> gms <> pms2 <> semi where gms | [] <- gens = emptyDoc | otherwise = do rec (p,ls) <- fmap unzip $ sequence [ (,formalLength i) <$> fill (maximum ls) (expr_ False i) <+> "=>" <+> expr_ False e | (i,_,e) <- gens] nest 2 ("generic map" <> line <> tupled (pure p)) <> line - pms' = do - rec (p,ls) <- fmap unzip $ sequence [ (,formalLength i) <$> fill (maximum ls) (expr_ False i) <+> "=>" <+> expr_ False e | (i,_,_,e) <- pms] + pms2 = do + rec (p,ls) <- case pms0 of + NamedPortMap pms1 -> fmap unzip $ sequence [pm ls i e | (i,_,_,e) <- pms1] + IndexedPortMap pms1 -> fmap unzip $ sequence [pmi e | (_,_,e) <- pms1] nest 2 $ "port map" <> line <> tupled (pure p) - formalLength (Identifier i _) = fromIntegral (TextS.length i) + + pm ls i e = (,formalLength i) <$> fill (maximum ls) (expr_ False i) <+> "=>" <+> expr_ False e + pmi e = (,0) <$> expr_ False e + + formalLength (Identifier i _) = fromIntegral (TextS.length (Id.toText i)) formalLength _ = 0 entOrComp' = case entOrComp of { Entity -> " entity"; Comp -> " component"; Empty -> ""} @@ -1589,6 +1547,9 @@ expr_ _ (DataCon ty@(Product _ labels tys) _ es) = tupled $ zipWithM (\i e' -> tyName ty <> selectProductField labels tys i <+> rarrow <+> expr_ False e') [0..] es +expr_ _ (DataCon (Enable _) _ [e]) = + expr_ False e + expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "Clash.Sized.Internal.Signed.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx @@ -1679,14 +1640,14 @@ iw <- Mon $ use intWidth "to_signed" <> parens (int 1 <> "," <> int iw) -expr_ _ (ConvBV topM hwty True e) = do +expr_ _ (ToBv topM hwty e) = do nm <- Mon $ use modNm case topM of Nothing -> pretty nm <> "_types" <> dot <> "toSLV" <> parens (qualTyName hwty <> "'" <> parens (expr_ False e)) Just t -> pretty t <> dot <> pretty t <> "_types" <> dot <> "toSLV" <> parens (expr_ False e) -expr_ _ (ConvBV topM _ False e) = do +expr_ _ (FromBv topM _ e) = do nm <- Mon $ use modNm maybe (pretty nm <> "_types" ) (\t -> pretty t <> dot <> pretty t <> "_types") topM <> dot <> "fromSLV" <> parens (expr_ False e) @@ -1801,16 +1762,19 @@ toSLV :: HasCallStack => HWType -> Expr -> VHDLM Doc toSLV Bool e = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV Bit e = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV (Clock {}) e = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV (Reset {}) e = do nm <- Mon $ use modNm pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) +toSLV (Enable _) e = do + nm <- Mon $ use modNm + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV (BitVector _) e = expr_ True e toSLV (Signed _) e = "std_logic_vector" <> parens (expr_ False e) toSLV (Unsigned _) e = "std_logic_vector" <> parens (expr_ False e) @@ -1826,7 +1790,7 @@ encloseSep lparen rparen " & " (zipWithM toSLV tys selIds') where tName = tyName t - selNames = map (fmap (T.toStrict . renderOneLine) ) [pretty id_ <> dot <> tName <> selectProductField labels tys i | i <- [0..(length tys)-1]] + selNames = map (fmap (Id.unsafeMake . T.toStrict . renderOneLine) ) [pretty id_ <> dot <> tName <> selectProductField labels tys i | i <- [0..(length tys)-1]] selIds = map (fmap (\n -> Identifier n Nothing)) selNames toSLV (Product _ _ tys) (DataCon _ _ es) | equalLength tys es = -- Need equalLenght for code seen in ZipWithUnitVector @@ -1837,7 +1801,7 @@ expr_ False e toSLV t@(Product _ _ _) e = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (qualTyName t <> "'" <> parens (expr_ False e)) + pretty nm <> "_types.toSLV" <> parens (qualTyName t <> "'" <> parens (expr_ False e)) toSLV (SP _ _) e = expr_ False e toSLV (CustomSP _ _ _ _) e = -- Custom representations are represented as bitvectors in HDL, so we don't @@ -1851,17 +1815,17 @@ Vivado -> mapM (expr_ False) selIds' _ -> mapM (toSLV elTy) selIds')) where - selNames = map (fmap (T.toStrict . renderOneLine) ) $ [pretty id_ <> parens (int i) | i <- [0 .. (n-1)]] + selNames = map (fmap (Id.unsafeMake . T.toStrict . renderOneLine) ) $ [pretty id_ <> parens (int i) | i <- [0 .. (n-1)]] selIds = map (fmap (`Identifier` Nothing)) selNames -- Don't split up newtype wrappers, or void-filtered types toSLV (Vector _ _) e@(DataCon _ (DC (Void Nothing, -1)) _) = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV (Vector n elTy) (DataCon _ _ es) = "std_logic_vector'" <> (parens $ vcat $ punctuate " & " (zipWithM toSLV [elTy,Vector (n-1) elTy] es)) toSLV (Vector _ _) e = do nm <- Mon $ use modNm - pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) + pretty nm <> "_types.toSLV" <> parens (expr_ False e) toSLV (RTree _ _) e = do nm <- Mon (use modNm) pretty (TextS.toLower nm) <> "_types.toSLV" <> parens (expr_ False e) @@ -1885,7 +1849,8 @@ encodingNote :: HWType -> VHDLM Doc encodingNote (Clock _) = "-- clock" <> line -encodingNote (Reset _ ) = "-- reset" <> line +encodingNote (Reset _) = "-- reset" <> line +encodingNote (Enable _) = "-- enable" <> line encodingNote (Annotated _ t) = encodingNote t encodingNote _ = emptyDoc @@ -2045,7 +2010,7 @@ z = 2^(d - 1) z' = 2^d --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- Vector's don't have a 10'th constructor, this is just so that we can -- recognize the particular case buildModifier syn prevM (Indexed (ty@(Vector _ argTy),10,fI)) = case prevM of @@ -2062,7 +2027,7 @@ _ -> Just (vivadoRange syn argTy (((Idx fI,argTy):prevM))) --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- RTree's don't have a 10'th constructor, this is just so that we can -- recognize the particular case buildModifier syn prevM (Indexed (ty@(RTree _ argTy),10,fI)) = case prevM of diff --git a/src/Clash/Backend/Verilog.hs b/src/Clash/Backend/Verilog.hs --- a/src/Clash/Backend/Verilog.hs +++ b/src/Clash/Backend/Verilog.hs @@ -39,7 +39,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet -import Data.Maybe (catMaybes,fromMaybe,mapMaybe) +import Data.Maybe (catMaybes, fromMaybe) import Data.List (mapAccumL, mapAccumR, nubBy, foldl') import Data.List.Extra ((<:>)) @@ -67,9 +67,9 @@ import Clash.Netlist.BlackBox.Types (HdlSyn) import Clash.Netlist.BlackBox.Util (extractLiterals, renderBlackBox, renderFilePath) -import Clash.Netlist.Id (IdType (..), mkBasicId') +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types hiding (_intWidth, intWidth) -import Clash.Netlist.Util hiding (mkIdentifier, extendIdentifier) +import Clash.Netlist.Util import Clash.Signal.Internal (ActiveEdge (..)) import Clash.Util (SrcSpan, noSrcSpan, curLoc, on, first, indexNote, makeCached, second) @@ -78,7 +78,7 @@ data VerilogState = VerilogState { _genDepth :: Int -- ^ Depth of current generative block - , _idSeen :: HashMap Identifier Word + , _idSeen :: IdentifierSet , _srcSpan :: SrcSpan , _includes :: [(String,Doc)] , _imports :: HashSet Text.Text @@ -88,27 +88,35 @@ , _memoryDataFiles:: [(String,String)] -- ^ Files to be stored: (filename, contents). These files are generated -- during the execution of 'genNetlist'. - , _customConstrs :: HashMap Identifier Identifier + , _customConstrs :: HashMap TextS.Text Identifier -- ^ Custom data constructor => Verilog function name , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn - , _escapedIds :: Bool , _undefValue :: Maybe (Maybe Int) + , _aggressiveXOptBB_ :: AggressiveXOptBB } makeLenses ''VerilogState +instance HasIdentifierSet VerilogState where + identifierSet = idSeen + instance Backend VerilogState where - initBackend = VerilogState - 0 - HashMap.empty - noSrcSpan - [] - HashSet.empty - HashSet.empty - [] - [] - HashMap.empty + initBackend iw hdlsyn_ esc lw undefVal xOpt = VerilogState + { _genDepth=0 + , _idSeen=Id.emptyIdentifierSet esc lw Verilog + , _srcSpan=noSrcSpan + , _includes=[] + , _imports=HashSet.empty + , _libraries=HashSet.empty + , _dataFiles=[] + , _memoryDataFiles=[] + , _customConstrs=HashMap.empty + , _intWidth=iw + , _hdlsyn=hdlsyn_ + , _undefValue=undefVal + , _aggressiveXOptBB_=xOpt + } hdlKind = const Verilog primDirs = const $ do root <- primsRoot return [ root System.FilePath. "common" @@ -122,6 +130,7 @@ genHDL = const genVerilog mkTyPackage _ _ = return [] hdlType _ = verilogType + hdlHWTypeKind _ = pure PrimitiveType -- Everything is a bitvector! hdlTypeErrValue = verilogTypeErrValue hdlTypeMark = verilogTypeMark hdlRecSel = verilogRecSel @@ -146,32 +155,6 @@ Signed _ -> "$signed" <> parens (string e) _ -> string e hdlSyn = use hdlsyn - mkIdentifier = do - allowEscaped <- use escapedIds - return (go allowEscaped) - where - go _ Basic nm = case (TextS.take 1024 . filterReserved) (mkBasicId' Verilog True nm) of - nm' | TextS.null nm' -> "_clash_internal" - | otherwise -> nm' - go esc Extended (rmSlash -> nm) = case go esc Basic nm of - nm' | esc && nm /= nm' -> TextS.concat ["\\",nm," "] - | otherwise -> nm' - extendIdentifier = do - allowEscaped <- use escapedIds - return (go allowEscaped) - where - go _ Basic nm ext = - case (TextS.take 1024 . filterReserved) (mkBasicId' Verilog True (nm `TextS.append` ext)) of - nm' | TextS.null nm' -> "_clash_internal" - | otherwise -> nm' - go esc Extended (rmSlash . escapeTemplate -> nm) ext = - let nmExt = nm `TextS.append` ext - in case go esc Basic nm ext of - nm' | esc && nm' /= nmExt -> case TextS.isPrefixOf "c$" nmExt of - True -> TextS.concat ["\\",nmExt," "] - _ -> TextS.concat ["\\c$",nmExt," "] - | otherwise -> nm' - setModName _ = id setSrcSpan = (srcSpan .=) getSrcSpan = use srcSpan @@ -182,7 +165,6 @@ else pure decs <> line <> insts ds - unextend = return rmSlash addIncludes inc = includes %= (inc ++) addLibraries libs = libraries %= (\s -> foldl' (flip HashSet.insert) s libs) addImports inps = imports %= (\s -> foldl' (flip HashSet.insert) s inps) @@ -194,48 +176,29 @@ getDataFiles = use dataFiles addMemoryDataFile f = memoryDataFiles %= (f:) getMemoryDataFiles = use memoryDataFiles - seenIdentifiers = idSeen ifThenElseExpr _ = True - -rmSlash :: Identifier -> Identifier -rmSlash nm = fromMaybe nm $ do - nm1 <- TextS.stripPrefix "\\" nm - pure (TextS.filter (not . (== ' ')) nm1) + aggressiveXOptBB = use aggressiveXOptBB_ type VerilogM a = Mon (State VerilogState) a --- List of reserved Verilog-2005 keywords -reservedWords :: [Identifier] -reservedWords = ["always","and","assign","automatic","begin","buf","bufif0" - ,"bufif1","case","casex","casez","cell","cmos","config","deassign","default" - ,"defparam","design","disable","edge","else","end","endcase","endconfig" - ,"endfunction","endgenerate","endmodule","endprimitive","endspecify" - ,"endtable","endtask","event","for","force","forever","fork","function" - ,"generate","genvar","highz0","highz1","if","ifnone","incdir","include" - ,"initial","inout","input","instance","integer","join","large","liblist" - ,"library","localparam","macromodule","medium","module","nand","negedge" - ,"nmos","nor","noshowcancelled","not","notif0","notif1","or","output" - ,"parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup" - ,"pulsestyle_onevent","pulsestyle_ondetect","rcmos","real","realtime","reg" - ,"release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared" - ,"showcancelled","signed","small","specify","specparam","strong0","strong1" - ,"supply0","supply1","table","task","time","tran","tranif0","tranif1","tri" - ,"tri0","tri1","triand","trior","trireg","unsigned","use","uwire","vectored" - ,"wait","wand","weak0","weak1","while","wire","wor","xnor","xor"] - -filterReserved :: Identifier -> Identifier -filterReserved s = if s `elem` reservedWords - then s `TextS.append` "_r" - else s +-- | Generate Verilog for a Netlist component +genVerilog + :: SrcSpan + -> IdentifierSet + -> Component + -> VerilogM ((String, Doc), [(String, Doc)]) +genVerilog sp seen c = do + -- Don't have type names conflict with module names or with previously + -- generated type names. + -- + -- TODO: Collect all type names up front, to prevent relatively costly union. + -- TODO: Investigate whether type names / signal names collide in the first place + Mon $ idSeen %= Id.union seen --- | Generate VHDL for a Netlist component -genVerilog :: SrcSpan -> HashMap Identifier Word -> Component -> VerilogM ((String,Doc),[(String,Doc)]) -genVerilog sp seen c = preserveSeen $ do - Mon (idSeen .= seen) Mon (setSrcSpan sp) v <- commentHeader <> line <> timescale <> line <> module_ c incs <- Mon $ use includes - return ((TextS.unpack cName,v),incs) + return ((TextS.unpack (Id.toText cName), v), incs) where cName = componentName c commentHeader @@ -244,12 +207,13 @@ <> line <> "*/" timescale = "`timescale 100fs/100fs" -sigPort :: Maybe WireOrReg - -> TextS.Text - -> HWType - -> Maybe Expr - -> VerilogM Doc -sigPort wor pName hwType iEM = +sigPort + :: Maybe WireOrReg + -> Identifier + -> HWType + -> Maybe Expr + -> VerilogM Doc +sigPort wor (Id.toText -> pName) hwType iEM = addAttrs (hwTypeAttrs hwType) (portType <+> verilogType hwType <+> stringS pName <> iE <> encodingNote hwType) where @@ -262,7 +226,7 @@ module_ :: Component -> VerilogM Doc module_ c = - addSeen c *> modVerilog <* Mon (imports .= HashSet.empty >> libraries .= HashSet.empty) + modVerilog <* Mon (imports .= HashSet.empty >> libraries .= HashSet.empty) where modVerilog = do body <- modBody @@ -273,7 +237,7 @@ uselibs (HashSet.toList libs) <> pure body <> line <> modEnding - modHeader = "module" <+> stringS (componentName c) + modHeader = "module" <+> pretty (componentName c) modPorts = indent 4 (tupleInputs inPorts <> line <> tupleOutputs outPorts <> semi) modBody = indent 2 (decls (declarations c)) <> line <> line <> indent 2 (insts (declarations c)) modEnding = "endmodule" @@ -313,23 +277,17 @@ indent 2 (string "`uselib" <+> (hsep (mapM (\l -> ("lib=" <> string l)) xs))) <> line <> line -wireRegFileDoc :: WireOrReg -> (Either Identifier HWType) -> VerilogM Doc +wireRegFileDoc :: WireOrReg -> (Either a HWType) -> VerilogM Doc wireRegFileDoc _ (Right FileType) = "integer" wireRegFileDoc Wire _ = "wire" wireRegFileDoc Reg _ = "reg" -addSeen :: Component -> VerilogM () -addSeen c = do - let iport = [iName | (iName, _) <- inputs c] - oport = [oName | (_, (oName, _), _) <- outputs c] - nets = mapMaybe (\case {NetDecl' _ _ i _ _ -> Just i; _ -> Nothing}) $ declarations c - Mon $ idSeen %= (HashMap.unionWith max (HashMap.fromList (concatMap (map (,0)) [iport,oport,nets]))) - verilogType :: HWType -> VerilogM Doc verilogType t = case t of Signed n -> "signed" <+> brackets (int (n-1) <> colon <> int 0) Clock {} -> emptyDoc Reset {} -> emptyDoc + Enable {} -> emptyDoc Bit -> emptyDoc Bool -> emptyDoc FileType -> emptyDoc @@ -391,8 +349,8 @@ decl (NetDecl' noteM wr id_ tyE iEM) = Just A.<$> maybe id addNote noteM (addAttrs attrs (wireRegFileDoc wr tyE <+> tyDec tyE)) where - tyDec (Left ty) = stringS ty <+> stringS id_ <> iE - tyDec (Right ty) = sigDecl (stringS id_) ty <> iE + tyDec (Left ty) = stringS ty <+> pretty id_ <> iE + tyDec (Right ty) = sigDecl (pretty id_) ty <> iE addNote n = mappend ("//" <+> stringS n <> line) attrs = fromMaybe [] (hwTypeAttrs A.<$> either (const Nothing) Just tyE) iE = maybe emptyDoc (noEmptyInit . expr_ False) iEM @@ -499,47 +457,58 @@ inst_ :: Declaration -> VerilogM (Maybe Doc) inst_ (TickDecl {}) = return Nothing inst_ (Assignment id_ e) = fmap Just $ - "assign" <+> stringS id_ <+> equals <+> expr_ False e <> semi + "assign" <+> pretty id_ <+> equals <+> expr_ False e <> semi inst_ (CondAssignment id_ _ scrut _ [(Just (BoolLit b), l),(_,r)]) = fmap Just $ "always @(*) begin" <> line <> indent 2 ("if" <> parens (expr_ True scrut) <> line <> - (indent 2 $ stringS id_ <+> equals <+> expr_ False t <> semi) <> line <> + (indent 2 $ pretty id_ <+> equals <+> expr_ False t <> semi) <> line <> "else" <> line <> - (indent 2 $ stringS id_ <+> equals <+> expr_ False f <> semi)) <> line <> + (indent 2 $ pretty id_ <+> equals <+> expr_ False f <> semi)) <> line <> "end" where (t,f) = if b then (l,r) else (r,l) inst_ (CondAssignment id_ _ scrut scrutTy@(CustomSP {}) es) = - inst_' id_ scrut scrutTy es + inst_' (Id.toText id_) scrut scrutTy es inst_ (CondAssignment id_ _ scrut scrutTy@(CustomSum {}) es) = - inst_' id_ scrut scrutTy es + inst_' (Id.toText id_) scrut scrutTy es inst_ (CondAssignment id_ _ scrut scrutTy@(CustomProduct {}) es) = - inst_' id_ scrut scrutTy es + inst_' (Id.toText id_) scrut scrutTy es inst_ (CondAssignment id_ _ scrut scrutTy es) = fmap Just $ "always @(*) begin" <> line <> indent 2 ("case" <> parens (expr_ True scrut) <> line <> - (indent 2 $ vcat $ punctuate semi (conds id_ es)) <> semi <> line <> + (indent 2 $ vcat $ punctuate semi (conds (Id.toText id_) es)) <> semi <> line <> "endcase") <> line <> "end" where - conds :: Identifier -> [(Maybe Literal,Expr)] -> VerilogM [Doc] + conds :: IdentifierText -> [(Maybe Literal,Expr)] -> VerilogM [Doc] conds _ [] = return [] conds i [(_,e)] = ("default" <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> return [] conds i ((Nothing,e):_) = ("default" <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> return [] conds i ((Just c ,e):es') = (exprLitV (Just (scrutTy,conSize scrutTy)) c <+> colon <+> stringS i <+> equals <+> expr_ False e) <:> conds i es' -inst_ (InstDecl _ _ nm lbl ps pms) = fmap Just $ - nest 2 (stringS nm <> params <> stringS lbl <> line <> pms' <> semi) +inst_ (InstDecl _ _ attrs nm lbl ps pms0) = fmap Just $ + attrs' <> nest 2 (pretty nm <> params <> pretty lbl <> line <> pms2 <> semi) where - pms' = tupled $ sequence [dot <> expr_ False i <+> parens (expr_ False e) | (i,_,_,e) <- pms] + pms2 = case pms0 of + NamedPortMap pms1 -> + -- ( .clk (clk_0), .arst (arst_0), ........ ) + let pm i e = dot <> expr_ False i <+> parens (expr_ False e) in + tupled $ sequence [pm i e | (i,_,_,e) <- pms1] + IndexedPortMap pms1 -> + -- ( clk_0, arst_0, ..... ) + tupled $ sequence [expr_ False e | (_,_,e) <- pms1] + params | null ps = space | otherwise = line <> "#" <> tupled (sequence [dot <> expr_ False i <+> parens (expr_ False e) | (i,_,e) <- ps]) <> line + attrs' + | null attrs = emptyDoc + | otherwise = addAttrs attrs line inst_ (BlackBoxD _ libs imps inc bs bbCtx) = fmap Just (Mon (column (renderBlackBox libs imps inc bs bbCtx))) @@ -589,7 +558,7 @@ seq_ (SeqDecl sd) = case sd of Assignment id_ e -> - stringS id_ <+> equals <+> expr_ False e <> semi + pretty id_ <+> equals <+> expr_ False e <> semi BlackBoxD {} -> fromMaybe <$> emptyDoc <*> inst_ sd @@ -813,7 +782,7 @@ start = (typeSize ty `div` 2) - 1 hty = RTree (d-1) argTy --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- Vector's don't have a 10'th constructor, this is just so that we can -- recognize the particular case modifier r (Indexed (ty@(Vector _ argTy),10,fI)) = @@ -823,7 +792,7 @@ start = typeSize ty - (fI * argSize) - 1 end = start - argSize + 1 --- This is a HACK for Clash.Driver.TopWrapper.mkOutput +-- This is a HACK for Clash.Netlist.Util.mkTopOutput -- RTree's don't have a 10'th constructor, this is just so that we can -- recognize the particular case modifier r (Indexed (ty@(RTree _ argTy),10,fI)) = @@ -882,24 +851,25 @@ _ -> error "internal error" customReprDataCon dataRepr constrRepr args = do funId <- mkConstrFunction - Mon (imports %= HashSet.insert (Text.pack (TextS.unpack funId ++ ".inc"))) - stringS funId <> tupled (mapM (expr_ False . snd) nzArgs) + Mon (imports %= HashSet.insert (Text.pack (TextS.unpack (Id.toText funId) ++ ".inc"))) + pretty funId <> tupled (mapM (expr_ False . snd) nzArgs) where nzArgs = filter ((/=0) . typeSize . fst) args + mkConstrFunction :: Mon (State VerilogState) Identifier mkConstrFunction = makeCached (crName constrRepr) customConstrs $ do let size = drSize dataRepr aTys = map fst args origins = bitOrigins dataRepr constrRepr :: [BitOrigin] - mkId <- Mon mkIdentifier - let ids = [ mkId Basic (TextS.pack ('v':show n)) | n <- [1..length args] ] - fId = mkId Basic (crName constrRepr) + let mkId nm = Id.makeBasic nm + ids <- mapM (\n -> mkId (TextS.pack ('v':show n))) [1..length args] + fId <- mkId (crName constrRepr) let fInps = [ case typeSize t of 0 -> emptyDoc - 1 -> "input" <+> stringS i <> semi <> line + 1 -> "input" <+> pretty i <> semi <> line n -> "input" <+> brackets (int (n-1) <> colon <> int 0) <+> - stringS i <> semi <> line + pretty i <> semi <> line | (i,t) <- zip ids aTys ] @@ -911,10 +881,10 @@ in case typeSize aTy of 0 -> error "internal error" 1 -> if start == 0 && end == 0 then - stringS v + pretty v else error "internal error" - _ -> stringS v <> brackets (int start <> colon <> int end) + _ -> pretty v <> brackets (int start <> colon <> int end) let val = case origins of [] -> error "internal error" @@ -927,13 +897,13 @@ n -> brackets (int (n-1) <> colon <> int 0) funDoc <- - "function" <+> oSz <+> stringS fId <> semi <> line <> + "function" <+> oSz <+> pretty fId <> semi <> line <> hcat (sequence fInps) <> "begin" <> line <> - indent 2 (stringS fId <+> "=" <+> val <> semi) <> line <> + indent 2 (pretty fId <+> "=" <+> val <> semi) <> line <> "end" <> line <> "endfunction" - Mon (includes %= ((TextS.unpack fId ++ ".inc",funDoc):)) + Mon (includes %= ((TextS.unpack (Id.toText fId) ++ ".inc",funDoc):)) return fId -- | Turn a Netlist expression into a Verilog expression @@ -942,7 +912,7 @@ -> VerilogM Doc expr_ _ (Literal sizeM lit) = exprLitV sizeM lit -expr_ _ (Identifier id_ Nothing) = stringS id_ +expr_ _ (Identifier id_ Nothing) = pretty id_ expr_ _ (Identifier id_ (Just (Indexed (CustomSP _id dataRepr _size args,dcI,fI)))) = case fieldTy of @@ -951,7 +921,7 @@ where (ConstrRepr' _name _n _mask _value anns, _, fieldTypes) = args !! dcI ranges = map range' $ bitRanges (anns !! fI) - range' (start, end) = stringS id_ <> brackets (int start <> ":" <> int end) + range' (start, end) = pretty id_ <> brackets (int start <> ":" <> int end) fieldTy = indexNote ($(curLoc) ++ "panic") fieldTypes fI expr_ _ (Identifier d_ (Just (Indexed (CustomProduct _id dataRepr _size _maybeFieldNames tys, dcI, fI)))) @@ -963,19 +933,19 @@ _ -> braces $ hcat $ punctuate ", " $ sequence ranges where (_fieldAnn, fieldTy) = indexNote ($(curLoc) ++ "panic") tys fI - range' (start, end) = stringS d_ <> brackets (int start <> ":" <> int end) + range' (start, end) = pretty d_ <> brackets (int start <> ":" <> int end) -- See [Note] integer projection expr_ _ (Identifier id_ (Just (Indexed ((Signed w),_,_)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ -- See [Note] integer projection expr_ _ (Identifier id_ (Just (Indexed ((Unsigned w),_,_)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ -- See [Note] mask projection expr_ _ (Identifier _ (Just (Indexed ((BitVector _),_,0)))) = do @@ -987,10 +957,10 @@ expr_ _ (Identifier id_ (Just (Indexed ((BitVector w),_,1)))) = do iw <- Mon $ use intWidth traceIf (iw < w) ($(curLoc) ++ "WARNING: result smaller than argument") $ - stringS id_ + pretty id_ expr_ _ (Identifier id_ (Just m)) = case modifier (Contiguous 0 0) m of - Nothing -> stringS id_ + Nothing -> pretty id_ Just (Contiguous start end,resTy) -> case resTy of Signed _ -> "$signed" <> parens (slice start end) _ -> slice start end @@ -1001,7 +971,7 @@ _ -> rs1 where - slice s e = stringS id_ <> brackets (int s <> colon <> int e) + slice s e = pretty id_ <> brackets (int s <> colon <> int e) expr_ b (DataCon _ (DC (Void {}, -1)) [e]) = expr_ b e @@ -1009,15 +979,11 @@ expr_ _ (DataCon (Vector 1 _) _ [e]) = expr_ False e expr_ _ e@(DataCon (Vector _ _) _ es@[_,_]) = - case vectorChain e of - Just es' -> listBraces (mapM (expr_ False) es') - Nothing -> listBraces (mapM (expr_ False) es) + listBraces $ mapM (expr_ False) $ fromMaybe es $ vectorChain e expr_ _ (DataCon (RTree 0 _) _ [e]) = expr_ False e expr_ _ e@(DataCon (RTree _ _) _ es@[_,_]) = - case rtreeChain e of - Just es' -> listBraces (mapM (expr_ False) es') - Nothing -> listBraces (mapM (expr_ False) es) + listBraces $ mapM (expr_ False) $ fromMaybe es $ rtreeChain e expr_ _ (DataCon (SP {}) (DC (BitVector _,_)) es) = assignExpr where @@ -1048,6 +1014,9 @@ customReprDataCon dataRepr cRepr (zip (map snd tys) es) expr_ _ (DataCon (Product {}) _ es) = listBraces (mapM (expr_ False) es) +expr_ _ (DataCon (Enable _) _ [e]) = + expr_ False e + expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _) | pNm == "Clash.Sized.Internal.Signed.fromInteger#" , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx @@ -1080,20 +1049,20 @@ expr_ b (BlackBoxE _ libs imps inc bs bbCtx b') = do parenIf (b || b') (Mon (renderBlackBox libs imps inc bs bbCtx <*> pure 0)) -expr_ _ (DataTag Bool (Left id_)) = stringS id_ <> brackets (int 0) -expr_ _ (DataTag Bool (Right id_)) = do +expr_ _ (DataTag Bool (Left id_)) = pretty id_ <> brackets (int 0) +expr_ _ (DataTag Bool (Right id_)) = do iw <- Mon (use intWidth) - "$unsigned" <> parens (listBraces (sequence [braces (int (iw-1) <+> braces "1'b0"),stringS id_])) + "$unsigned" <> parens (listBraces (sequence [braces (int (iw-1) <+> braces "1'b0"),pretty id_])) -expr_ _ (DataTag (Sum _ _) (Left id_)) = "$unsigned" <> parens (stringS id_) -expr_ _ (DataTag (Sum _ _) (Right id_)) = "$unsigned" <> parens (stringS id_) +expr_ _ (DataTag (Sum _ _) (Left id_)) = "$unsigned" <> parens (pretty id_) +expr_ _ (DataTag (Sum _ _) (Right id_)) = "$unsigned" <> parens (pretty id_) expr_ _ (DataTag (Product {}) (Right _)) = do iw <- Mon (use intWidth) int iw <> "'sd0" expr_ _ (DataTag hty@(SP _ _) (Right id_)) = "$unsigned" <> parens - (stringS id_ <> brackets + (pretty id_ <> brackets (int start <> colon <> int end)) where start = typeSize hty - 1 @@ -1113,7 +1082,8 @@ iw <- Mon $ use intWidth int iw <> "'sd1" -expr_ b (ConvBV _ _ _ e) = expr_ b e +expr_ b (ToBv _ _ e) = expr_ b e +expr_ b (FromBv _ _ e) = expr_ b e expr_ b (IfThenElse c t e) = parenIf b (expr_ True c <+> "?" <+> expr_ True t <+> ":" <+> expr_ True e) @@ -1200,7 +1170,7 @@ dcToExpr ty i = Literal (Just (ty,conSize ty)) (NumLit (toInteger i)) listBraces :: Monad m => m [Doc] -> m Doc -listBraces = align . encloseSep lbrace rbrace comma +listBraces = align . enclose lbrace rbrace . hsep . punctuate (comma <+> softline) parenIf :: Monad m => Bool -> m Doc -> m Doc parenIf True = parens @@ -1212,5 +1182,6 @@ encodingNote :: Applicative m => HWType -> m Doc encodingNote (Clock _) = string " // clock" encodingNote (Reset _) = string " // reset" +encodingNote (Enable _) = string " // enable" encodingNote (Annotated _ t) = encodingNote t encodingNote _ = emptyDoc diff --git a/src/Clash/Core/EqSolver.hs b/src/Clash/Core/EqSolver.hs --- a/src/Clash/Core/EqSolver.hs +++ b/src/Clash/Core/EqSolver.hs @@ -1,3 +1,10 @@ +{-| + Copyright : (C) 2021 QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Clash.Core.EqSolver where @@ -11,6 +18,11 @@ import Clash.Core.Type import Clash.Core.Var import Clash.Core.VarEnv (VarSet, elemVarSet, emptyVarSet, mkVarSet) +#if MIN_VERSION_ghc(9,0,0) +import Clash.Core.DataCon (dcUniq) +import GHC.Builtin.Names (unsafeReflDataConKey) +import GHC.Types.Unique (getKey) +#endif -- | Data type that indicates what kind of solution (if any) was found data TypeEqSolution @@ -124,6 +136,12 @@ :: TyConMap -> Alt -> Bool +#if MIN_VERSION_base(4,15,0) +isAbsurdAlt _tcm (DataPat dc _ _,_) + -- unsafeCoerce is not absurd in the way intended by /isAbsurdAlt/ + | dcUniq dc == getKey unsafeReflDataConKey + = False +#endif isAbsurdAlt tcm alt = any (isAbsurdEq tcm exts) (altEqs tcm alt) where diff --git a/src/Clash/Core/Evaluator.hs b/src/Clash/Core/Evaluator.hs deleted file mode 100644 --- a/src/Clash/Core/Evaluator.hs +++ /dev/null @@ -1,535 +0,0 @@ -{-| - Copyright : (C) 2017, Google Inc. - License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij - - Call-by-need evaluator based on the evaluator described in: - - Maximilian Bolingbroke, Simon Peyton Jones, "Supercompilation by evaluation", - Haskell '10, Baltimore, Maryland, USA. - --} - -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Clash.Core.Evaluator where - -import Prelude hiding (lookup) - -import Control.Concurrent.Supply (Supply, freshId) -import Data.Either (lefts,rights) -import Data.List (foldl',mapAccumL) -import Data.Maybe (fromMaybe) -import qualified Data.Primitive.ByteArray as BA -import qualified Data.Text as Text -import qualified Data.Vector.Primitive as PV -import GHC.Integer.GMP.Internals - (Integer (..), BigNat (..)) - -import Clash.Core.DataCon -import Clash.Core.Evaluator.Types -import Clash.Core.FreeVars -import Clash.Core.Literal -import Clash.Core.Name -import Clash.Core.Pretty -import Clash.Core.Subst -import Clash.Core.Term -import Clash.Core.TermInfo -import Clash.Core.TyCon -import Clash.Core.Type -import Clash.Core.Util -import Clash.Core.Var -import Clash.Core.VarEnv -import Clash.Debug -import Clash.Driver.Types (BindingMap, Binding(..)) -import Clash.Pretty -import Clash.Unique -import Clash.Util (curLoc) - -isUndefinedPrimVal :: Value -> Bool -isUndefinedPrimVal (PrimVal (PrimInfo{primName}) _ _) = - primName == "Clash.Transformations.undefined" -isUndefinedPrimVal _ = False - -whnf' - :: PrimStep - -> PrimUnwind - -> BindingMap - -> TyConMap - -> PrimHeap - -> Supply - -> InScopeSet - -> Bool - -> Term - -> (PrimHeap, PureHeap, Term) -whnf' eval fu bm tcm ph ids is isSubj e = - toResult $ whnf tcm isSubj m - where - toResult x = (mHeapPrim x, mHeapLocal x, mTerm x) - - m = Machine eval fu ph gh emptyVarEnv [] ids is e - gh = mapVarEnv bindingTerm bm - --- | Evaluate to WHNF given an existing Heap and Stack -whnf - :: TyConMap - -> Bool - -> Machine - -> Machine -whnf tcm isSubj m - | isSubj = - -- See [Note: empty case expressions] - let ty = termType tcm (mTerm m) - in go (stackPush (Scrutinise ty []) m) - | otherwise = go m - where - go s = case step s tcm of - Just s' -> go s' - Nothing -> fromMaybe (error . showDoc . ppr $ mTerm m) (unwindStack s) - --- | Completely unwind the stack to get back the complete term -unwindStack :: Machine -> Maybe Machine -unwindStack m - | stackNull m = Just m - | otherwise = do - (m', kf) <- stackPop m - - case kf of - PrimApply p tys vs tms -> - let term = foldl' App - (foldl' App - (foldl' TyApp (Prim p) tys) - (fmap valToTerm vs)) - (mTerm m' : tms) - in unwindStack (setTerm term m') - - Instantiate ty -> - let term = TyApp (getTerm m') ty - in unwindStack (setTerm term m') - - Apply n -> - case heapLookup LocalId n m' of - Just e -> - let term = App (getTerm m') e - in unwindStack (setTerm term m') - - Nothing -> error $ unlines $ - [ "Clash.Core.Evaluator.unwindStack:" - , "Stack:" - ] <> - [ " " <> showDoc (clashPretty frame) | frame <- mStack m] <> - [ "" - , "Expression:" - , showPpr (mTerm m) - , "" - , "Heap:" - , showDoc (clashPretty $ mHeapLocal m) - ] - - Scrutinise _ [] -> - unwindStack m' - - Scrutinise ty alts -> - let term = Case (getTerm m') ty alts - in unwindStack (setTerm term m') - - Update LocalId x -> - unwindStack (heapInsert LocalId x (mTerm m') m') - - Update GlobalId _ -> - unwindStack m' - - Tickish sp -> - let term = Tick sp (getTerm m') - in unwindStack (setTerm term m') - --- | A single step in the partial evaluator. The result is the new heap and --- stack, and the next expression to be reduced. --- -type Step = Machine -> TyConMap -> Maybe Machine - -stepVar :: Id -> Step -stepVar i m _ - | Just e <- heapLookup LocalId i m - = go LocalId e - - | Just e <- heapLookup GlobalId i m - , isGlobalId i - = go GlobalId e - - | otherwise - = Nothing - where - go s e = - let term = deShadowTerm (mScopeNames m) (tickExpr e) - in Just . setTerm term . stackPush (Update s i) $ heapDelete s i m - - -- Removing the heap-bound value on a force ensures we do not get stuck on - -- expressions such as: "let x = x in x" - tickExpr = Tick (NameMod PrefixName (LitTy . SymTy $ toStr i)) - unQualName = snd . Text.breakOnEnd "." - toStr = Text.unpack . unQualName . flip Text.snoc '_' . nameOcc . varName - -stepData :: DataCon -> Step -stepData dc m tcm = unwind tcm m (DC dc []) - -stepLiteral :: Literal -> Step -stepLiteral l m tcm = unwind tcm m (Lit l) - -stepPrim :: PrimInfo -> Step -stepPrim pInfo m tcm - | primName pInfo == "GHC.Prim.realWorld#" = - unwind tcm m (PrimVal pInfo [] []) - - | otherwise = - case fst $ splitFunForallTy (primType pInfo) of - [] -> mPrimStep m tcm (forcePrims m) pInfo [] [] m - tys -> newBinder tys (Prim pInfo) m tcm - -stepLam :: Id -> Term -> Step -stepLam x e m tcm = unwind tcm m (Lambda x e) - -stepTyLam :: TyVar -> Term -> Step -stepTyLam x e m tcm = unwind tcm m (TyLambda x e) - -stepApp :: Term -> Term -> Step -stepApp x y m tcm = - case term of - Data dc -> - let tys = fst $ splitFunForallTy (dcType dc) - in case compare (length args) (length tys) of - EQ -> unwind tcm m (DC dc args) - LT -> newBinder tys' (App x y) m tcm - GT -> error "Overapplied DC" - - Prim p -> - let tys = fst $ splitFunForallTy (primType p) - in case compare (length args) (length tys) of - EQ -> case lefts args of - -- We make boolean conjunction and disjunction extra lazy by - -- deferring the evaluation of the arguments during the evaluation - -- of the primop rule. - -- - -- This allows us to implement: - -- - -- x && True --> x - -- x && False --> False - -- x || True --> True - -- x || False --> x - -- - -- even when that 'x' is _|_. This makes the evaluation - -- rule lazier than the actual Haskel implementations which - -- are strict in the first argument and lazy in the second. - [a0, a1] | primName p `elem` ["GHC.Classes.&&","GHC.Classes.||"] -> - let (m0,i) = newLetBinding tcm m a0 - (m1,j) = newLetBinding tcm m0 a1 - in mPrimStep m tcm (forcePrims m) p [] [Suspend (Var i), Suspend (Var j)] m1 - - (e':es) -> - Just . setTerm e' $ stackPush (PrimApply p (rights args) [] es) m - - _ -> error "internal error" - - LT -> newBinder tys' (App x y) m tcm - - GT -> let (m0, n) = newLetBinding tcm m y - in Just . setTerm x $ stackPush (Apply n) m0 - - _ -> let (m0, n) = newLetBinding tcm m y - in Just . setTerm x $ stackPush (Apply n) m0 - where - (term, args, _) = collectArgsTicks (App x y) - tys' = fst . splitFunForallTy . termType tcm $ App x y - -stepTyApp :: Term -> Type -> Step -stepTyApp x ty m tcm = - case term of - Data dc -> - let tys = fst $ splitFunForallTy (dcType dc) - in case compare (length args) (length tys) of - EQ -> unwind tcm m (DC dc args) - LT -> newBinder tys' (TyApp x ty) m tcm - GT -> error "Overapplied DC" - - Prim p -> - let tys = fst $ splitFunForallTy (primType p) - in case compare (length args) (length tys) of - EQ -> case lefts args of - [] | primName p `elem` [ "Clash.Transformations.removedArg" - , "Clash.Transformations.undefined" ] -> - unwind tcm m (PrimVal p (rights args) []) - - | otherwise -> - mPrimStep m tcm (forcePrims m) p (rights args) [] m - - (e':es) -> - Just . setTerm e' $ stackPush (PrimApply p (rights args) [] es) m - - LT -> newBinder tys' (TyApp x ty) m tcm - GT -> Just . setTerm x $ stackPush (Instantiate ty) m - - _ -> Just . setTerm x $ stackPush (Instantiate ty) m - where - (term, args, _) = collectArgsTicks (TyApp x ty) - tys' = fst . splitFunForallTy . termType tcm $ TyApp x ty - -stepLetRec :: [LetBinding] -> Term -> Step -stepLetRec bs x m _ = Just (allocate bs x m) - -stepCase :: Term -> Type -> [Alt] -> Step -stepCase scrut ty alts m _ = - Just . setTerm scrut $ stackPush (Scrutinise ty alts) m - --- TODO Support stepwise evaluation of casts. --- -stepCast :: Term -> Type -> Type -> Step -stepCast _ _ _ _ _ = - flip trace Nothing $ unlines - [ "WARNING: " <> $(curLoc) <> "Clash can't symbolically evaluate casts" - , "Please file an issue at https://github.com/clash-lang/clash-compiler/issues" - ] - -stepTick :: TickInfo -> Term -> Step -stepTick tick x m _ = - Just . setTerm x $ stackPush (Tickish tick) m - --- | Small-step operational semantics. --- -step :: Step -step m = case mTerm m of - Var i -> stepVar i m - Data dc -> stepData dc m - Literal l -> stepLiteral l m - Prim p -> stepPrim p m - Lam v x -> stepLam v x m - TyLam v x -> stepTyLam v x m - App x y -> stepApp x y m - TyApp x ty -> stepTyApp x ty m - Letrec bs x -> stepLetRec bs x m - Case s ty as -> stepCase s ty as m - Cast x a b -> stepCast x a b m - Tick t x -> stepTick t x m - --- | Take a list of types or type variables and create a lambda / type lambda --- for each one around the given term. --- -newBinder :: [Either TyVar Type] -> Term -> Step -newBinder tys x m tcm = - let (s', iss', x') = mkAbstr (mSupply m, mScopeNames m, x) tys - m' = m { mSupply = s', mScopeNames = iss', mTerm = x' } - in step m' tcm - where - mkAbstr = foldr go - where - go (Left tv) (s', iss', e') = - (s', iss', TyLam tv (TyApp e' (VarTy tv))) - - go (Right ty) (s', iss', e') = - let ((s'', _), n) = mkUniqSystemId (s', iss') ("x", ty) - in (s'', iss' ,Lam n (App e' (Var n))) - -newLetBinding - :: TyConMap - -> Machine - -> Term - -> (Machine, Id) -newLetBinding tcm m e - | Var v <- e - , heapContains LocalId v m - = (m, v) - - | otherwise - = let m' = heapInsert LocalId id_ e m - in (m' { mSupply = ids', mScopeNames = is1 }, id_) - where - ty = termType tcm e - ((ids', is1), id_) = mkUniqSystemId (mSupply m, mScopeNames m) ("x", ty) - --- | Unwind the stack by 1 -unwind - :: TyConMap - -> Machine - -> Value - -> Maybe Machine -unwind tcm m v = do - (m', kf) <- stackPop m - go kf m' - where - go (Update s x) = return . update s x v - go (Apply x) = return . apply tcm v x - go (Instantiate ty) = return . instantiate tcm v ty - go (PrimApply p tys vs tms) = mPrimUnwind m tcm p tys vs v tms - go (Scrutinise altTy as) = return . scrutinise v altTy as - go (Tickish _) = return . setTerm (valToTerm v) - --- | Update the Heap with the evaluated term -update :: IdScope -> Id -> Value -> Machine -> Machine -update s x (valToTerm -> term) = - setTerm term . heapInsert s x term - --- | Apply a value to a function -apply :: TyConMap -> Value -> Id -> Machine -> Machine -apply _tcm (Lambda x' e) x m = - setTerm (substTm "Evaluator.apply" subst e) m - where - subst = extendIdSubst subst0 x' (Var x) - subst0 = mkSubst $ extendInScopeSet (mScopeNames m) x -apply tcm pVal@(PrimVal (PrimInfo{primType}) tys []) x m - | isUndefinedPrimVal pVal - = setTerm (undefinedTm (piResultTys tcm primType (tys++[varType x]))) m - -apply _ _ _ _ = error "Evaluator.apply: Not a lambda" - --- | Instantiate a type-abstraction -instantiate :: TyConMap -> Value -> Type -> Machine -> Machine -instantiate _tcm (TyLambda x e) ty m = - setTerm (substTm "Evaluator.instantiate" subst e) m - where - subst = extendTvSubst subst0 x ty - subst0 = mkSubst iss0 - iss0 = mkInScopeSet (localFVsOfTerms [e] `unionUniqSet` tyFVsOfTypes [ty]) -instantiate tcm pVal@(PrimVal (PrimInfo{primType}) tys []) ty m - | isUndefinedPrimVal pVal - = setTerm (undefinedTm (piResultTys tcm primType (tys ++ [ty]))) m - -instantiate _ _ _ _ = error "Evaluator.instantiate: Not a tylambda" - --- | Evaluate a case-expression -scrutinise :: Value -> Type -> [Alt] -> Machine -> Machine -scrutinise v _altTy [] m = setTerm (valToTerm v) m --- [Note: empty case expressions] --- --- Clash does not have empty case-expressions; instead, empty case-expressions --- are used to indicate that the `whnf` function was called the context of a --- case-expression, which means certain special primitives must be forced. --- See also [Note: forcing special primitives] -scrutinise (Lit l) _altTy alts m = case alts of - (DefaultPat, altE):alts1 -> setTerm (go altE alts1) m - _ -> let term = go (error $ "Evaluator.scrutinise: no match " - <> showPpr (Case (valToTerm (Lit l)) (ConstTy Arrow) alts)) alts - in setTerm term m - where - go def [] = def - go _ ((LitPat l1,altE):_) | l1 == l = altE - go _ ((DataPat dc [] [x],altE):_) - | IntegerLiteral l1 <- l - , Just patE <- case dcTag dc of - 1 | l1 >= ((-2)^(63::Int)) && l1 < 2^(63::Int) -> - Just (IntLiteral l1) - 2 | l1 >= (2^(63::Int)) -> - let !(Jp# !(BN# ba0)) = l1 - ba1 = BA.ByteArray ba0 - bv = PV.Vector 0 (BA.sizeofByteArray ba1) ba1 - in Just (ByteArrayLiteral bv) - 3 | l1 < ((-2)^(63::Int)) -> - let !(Jn# !(BN# ba0)) = l1 - ba1 = BA.ByteArray ba0 - bv = PV.Vector 0 (BA.sizeofByteArray ba1) ba1 - in Just (ByteArrayLiteral bv) - _ -> Nothing - = let inScope = localFVsOfTerms [altE] - subst0 = mkSubst (mkInScopeSet inScope) - subst1 = extendIdSubst subst0 x (Literal patE) - in substTm "Evaluator.scrutinise" subst1 altE - | NaturalLiteral l1 <- l - , Just patE <- case dcTag dc of - 1 | l1 >= 0 && l1 < 2^(64::Int) -> - Just (WordLiteral l1) - 2 | l1 >= (2^(64::Int)) -> - let !(Jp# !(BN# ba0)) = l1 - ba1 = BA.ByteArray ba0 - bv = PV.Vector 0 (BA.sizeofByteArray ba1) ba1 - in Just (ByteArrayLiteral bv) - _ -> Nothing - = let inScope = localFVsOfTerms [altE] - subst0 = mkSubst (mkInScopeSet inScope) - subst1 = extendIdSubst subst0 x (Literal patE) - in substTm "Evaluator.scrutinise" subst1 altE - go def (_:alts1) = go def alts1 - -scrutinise (DC dc xs) _altTy alts m - | altE:_ <- [substInAlt altDc tvs pxs xs altE - | (DataPat altDc tvs pxs,altE) <- alts, altDc == dc ] ++ - [altE | (DefaultPat,altE) <- alts ] - = setTerm altE m - -scrutinise v@(PrimVal p _ vs) altTy alts m - | isUndefinedPrimVal v - = setTerm (undefinedTm altTy) m - - | any (\case {(LitPat {},_) -> True; _ -> False}) alts - = case alts of - ((DefaultPat,altE):alts1) -> setTerm (go altE alts1) m - _ -> let term = go (error $ "Evaluator.scrutinise: no match " - <> showPpr (Case (valToTerm v) (ConstTy Arrow) alts)) alts - in setTerm term m - where - go def [] = def - go _ ((LitPat l1,altE):_) | l1 == l = altE - go def (_:alts1) = go def alts1 - - l = case primName p of - "Clash.Sized.Internal.BitVector.fromInteger#" - | [_,Lit (IntegerLiteral 0),Lit l0] <- vs -> l0 - "Clash.Sized.Internal.Index.fromInteger#" - | [_,Lit l0] <- vs -> l0 - "Clash.Sized.Internal.Signed.fromInteger#" - | [_,Lit l0] <- vs -> l0 - "Clash.Sized.Internal.Unsigned.fromInteger#" - | [_,Lit l0] <- vs -> l0 - _ -> error ("scrutinise: " ++ showPpr (Case (valToTerm v) (ConstTy Arrow) alts)) - -scrutinise v _ alts _ = - error ("scrutinise: " ++ showPpr (Case (valToTerm v) (ConstTy Arrow) alts)) - -substInAlt :: DataCon -> [TyVar] -> [Id] -> [Either Term Type] -> Term -> Term -substInAlt dc tvs xs args e = substTm "Evaluator.substInAlt" subst e - where - tys = rights args - tms = lefts args - substTyMap = zip tvs (drop (length (dcUnivTyVars dc)) tys) - substTmMap = zip xs tms - inScope = tyFVsOfTypes tys `unionVarSet` localFVsOfTerms (e:tms) - subst = extendTvSubstList (extendIdSubstList subst0 substTmMap) substTyMap - subst0 = mkSubst (mkInScopeSet inScope) - --- | Allocate let-bindings on the heap -allocate :: [LetBinding] -> Term -> Machine -> Machine -allocate xes e m = - m { mHeapLocal = extendVarEnvList (mHeapLocal m) xes' - , mSupply = ids' - , mScopeNames = isN - , mTerm = e' - } - where - xNms = fmap fst xes - is1 = extendInScopeSetList (mScopeNames m) xNms - (ids', s) = mapAccumL (letSubst (mHeapLocal m)) (mSupply m) xNms - (nms, s') = unzip s - isN = extendInScopeSetList is1 nms - subst = extendIdSubstList subst0 s' - subst0 = mkSubst (foldl' extendInScopeSet is1 nms) - xes' = zip nms (fmap (substTm "Evaluator.allocate0" subst . snd) xes) - e' = substTm "Evaluator.allocate1" subst e - --- | Create a unique name and substitution for a let-binder -letSubst - :: PureHeap - -> Supply - -> Id - -> (Supply, (Id, (Id, Term))) -letSubst h acc id0 = - let (acc',id1) = mkUniqueHeapId h acc id0 - in (acc',(id1,(id0,Var id1))) - where - mkUniqueHeapId :: PureHeap -> Supply -> Id -> (Supply, Id) - mkUniqueHeapId h' ids x = - maybe (ids', x') (const $ mkUniqueHeapId h' ids' x) (lookupVarEnv x' h') - where - (i,ids') = freshId ids - x' = modifyVarName (`setUnique` i) x - diff --git a/src/Clash/Core/Evaluator/Types.hs b/src/Clash/Core/Evaluator/Types.hs --- a/src/Clash/Core/Evaluator/Types.hs +++ b/src/Clash/Core/Evaluator/Types.hs @@ -13,44 +13,140 @@ import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap (insert, lookup) import Data.List (foldl') -import Data.Maybe (isJust) +import Data.Maybe (fromMaybe, isJust) import Data.Text.Prettyprint.Doc (hsep) import Clash.Core.DataCon (DataCon) import Clash.Core.Literal (Literal(CharLiteral)) -import Clash.Core.Pretty (fromPpr) +import Clash.Core.Pretty (fromPpr, ppr, showPpr) import Clash.Core.Term (Term(..), PrimInfo(..), TickInfo, Alt) +import Clash.Core.TermInfo (termType) import Clash.Core.TyCon (TyConMap) import Clash.Core.Type (Type) import Clash.Core.Var (Id, IdScope(..), TyVar) import Clash.Core.VarEnv -import Clash.Pretty (ClashPretty(..), fromPretty) +import Clash.Driver.Types (BindingMap, bindingTerm) +import Clash.Pretty (ClashPretty(..), fromPretty, showDoc) -{- [Note: forcing special primitives] -Clash uses the `whnf` function in two places (for now): +whnf' + :: Evaluator + -> BindingMap + -> TyConMap + -> PrimHeap + -> Supply + -> InScopeSet + -> Bool + -> Term + -> (PrimHeap, PureHeap, Term) +whnf' eval bm tcm ph ids is isSubj e = + toResult $ whnf eval tcm isSubj m + where + toResult x = (mHeapPrim x, mHeapLocal x, mTerm x) - 1. The case-of-known-constructor transformation - 2. The reduceConstant transformation + m = Machine ph gh emptyVarEnv [] ids is e + gh = mapVarEnv bindingTerm bm -The first transformation is needed to reach the required normal form. The -second transformation is more of cleanup transformation, so non-essential. +-- | Evaluate to WHNF given an existing Heap and Stack +whnf + :: Evaluator + -> TyConMap + -> Bool + -> Machine + -> Machine +whnf eval tcm isSubj m + | isSubj = + -- See [Note: empty case expressions] + let ty = termType tcm (mTerm m) + in go (stackPush (Scrutinise ty []) m) + | otherwise = go m + where + go :: Machine -> Machine + go s = case step eval s tcm of + Just s' -> go s' + Nothing -> fromMaybe (error . showDoc . ppr $ mTerm m) (unwindStack s) -Normally, `whnf` would force the evaluation of all primitives, which is needed -in the `case-of-known-constructor` transformation. However, there are some -primitives which we want to leave unevaluated in the `reduceConstant` -transformation. Such primitives are: - - Primitives such as `Clash.Sized.Vector.transpose`, `Clash.Sized.Vector.map`, - etc. that do not reduce to an expression in normal form. Where the - `reduceConstant` transformation is supposed to be normal-form preserving. - - Primitives such as `GHC.Int.I8#`, `GHC.Word.W32#`, etc. which seem like - wrappers around a 64-bit literal, but actually perform truncation to the - desired bit-size. +-- | An evaluator is a collection of basic building blocks which are used to +-- define partial evaluation. In this implementation, it consists of two types +-- of function: +-- +-- * steps, which applies the reduction realtion to the current term +-- * unwindings, which pop the stack and evaluate the stack frame +-- +-- Variants of these functions also exist for evalauting primitive operations. +-- This is because there may be multiple frontends to the compiler which can +-- reuse a common step and unwind, but have different primitives. +-- +data Evaluator = Evaluator + { step :: Step + , unwind :: Unwind + , primStep :: PrimStep + , primUnwind :: PrimUnwind + } -This is why the Primitive Evaluator gets a flag telling whether it should -evaluate these special primitives. --} +-- | Completely unwind the stack to get back the complete term +unwindStack :: Machine -> Maybe Machine +unwindStack m + | stackNull m = Just m + | otherwise = do + (m', kf) <- stackPop m + case kf of + PrimApply p tys vs tms -> + let term = foldl' App + (foldl' App + (foldl' TyApp (Prim p) tys) + (fmap valToTerm vs)) + (mTerm m' : tms) + in unwindStack (setTerm term m') + + Instantiate ty -> + let term = TyApp (getTerm m') ty + in unwindStack (setTerm term m') + + Apply n -> + case heapLookup LocalId n m' of + Just e -> + let term = App (getTerm m') e + in unwindStack (setTerm term m') + + Nothing -> error $ unlines $ + [ "Clash.Core.Evaluator.unwindStack:" + , "Stack:" + ] <> + [ " " <> showDoc (clashPretty frame) | frame <- mStack m] <> + [ "" + , "Expression:" + , showPpr (mTerm m) + , "" + , "Heap:" + , showDoc (clashPretty $ mHeapLocal m) + ] + + Scrutinise _ [] -> + unwindStack m' + + Scrutinise ty alts -> + let term = Case (getTerm m') ty alts + in unwindStack (setTerm term m') + + Update LocalId x -> + unwindStack (heapInsert LocalId x (mTerm m') m') + + Update GlobalId _ -> + unwindStack m' + + Tickish sp -> + let term = Tick sp (getTerm m') + in unwindStack (setTerm term m') + +-- | A single step in the partial evaluator. The result is the new heap and +-- stack, and the next expression to be reduced. +-- +type Step = Machine -> TyConMap -> Maybe Machine + +type Unwind = Value -> Step + type PrimStep = TyConMap -> Bool @@ -70,12 +166,19 @@ -> Machine -> Maybe Machine -type PrimEvaluator = (PrimStep, PrimUnwind) - +-- | A machine represents the current state of the abstract machine used to +-- evaluate terms. A machine has a term under evaluation, a stack, and three +-- heaps: +-- +-- * a primitive heap to store IO values from primitives (like ByteArrays) +-- * a global heap to store top-level bindings in scope +-- * a local heap to store local bindings in scope +-- +-- Machines also include a unique supply and InScopeSet. These are needed when +-- new heap bindings are created, and are just an implementation detail. +-- data Machine = Machine - { mPrimStep :: PrimStep - , mPrimUnwind :: PrimUnwind - , mHeapPrim :: PrimHeap + { mHeapPrim :: PrimHeap , mHeapGlobal :: PureHeap , mHeapLocal :: PureHeap , mStack :: Stack @@ -85,7 +188,7 @@ } instance Show Machine where - show (Machine _ _ ph gh lh s _ _ x) = + show (Machine ph gh lh s _ _ x) = unlines [ "Machine:" , "" diff --git a/src/Clash/Core/Literal.hs b/src/Clash/Core/Literal.hs --- a/src/Clash/Core/Literal.hs +++ b/src/Clash/Core/Literal.hs @@ -20,10 +20,9 @@ import Control.DeepSeq (NFData (..)) import Data.Binary (Binary) -import Data.Vector.Binary () import Data.Hashable (Hashable) -import Data.Vector.Primitive.Extra (Vector) -import Data.Word (Word8) +import Data.Primitive.ByteArray (ByteArray) +import Data.Primitive.ByteArray.Extra () import GHC.Generics (Generic) import {-# SOURCE #-} Clash.Core.Type (Type) @@ -46,7 +45,7 @@ | DoubleLiteral !Rational | CharLiteral !Char | NaturalLiteral !Integer - | ByteArrayLiteral !(Vector Word8) + | ByteArrayLiteral !ByteArray deriving (Eq,Ord,Show,Generic,NFData,Hashable,Binary) -- | Determines the Type of a Literal diff --git a/src/Clash/Core/Name.hs b/src/Clash/Core/Name.hs --- a/src/Clash/Core/Name.hs +++ b/src/Clash/Core/Name.hs @@ -6,6 +6,7 @@ Names -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -26,7 +27,11 @@ import GHC.BasicTypes.Extra () import GHC.Generics (Generic) import GHC.SrcLoc.Extra () +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (SrcSpan, noSrcSpan) +#else import SrcLoc (SrcSpan, noSrcSpan) +#endif import Clash.Unique diff --git a/src/Clash/Core/PartialEval.hs b/src/Clash/Core/PartialEval.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Core/PartialEval.hs @@ -0,0 +1,98 @@ +{-| +Copyright : (C) 2020 QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +The main API of the partial evaluator. This exposes the main functions needed +to call the evaluator, and the type of evaluators. A concrete implementation +of an evaluator is required to use this module: this can be imported from the +library for the compiler front-end, e.g. Clash.GHC.PartialEval in clash-ghc. +-} + +module Clash.Core.PartialEval where + +import Control.Concurrent.Supply (Supply) +import Data.IntMap.Strict (IntMap) + +import Clash.Core.PartialEval.AsTerm +import Clash.Core.PartialEval.Monad +import Clash.Core.PartialEval.NormalForm +import Clash.Core.Term (Term) +import Clash.Core.TyCon (TyConMap) +import Clash.Core.Var (Id) +import Clash.Core.VarEnv (InScopeSet) +import Clash.Driver.Types (Binding(..), BindingMap) + +-- | An evaluator for Clash core. This consists of two functions: one to +-- evaluate a term to weak-head normal form (WHNF) and another to recursively +-- evaluate sub-terms to obtain beta-normal eta-long form (NF). +-- +data Evaluator = Evaluator + { evalWhnf :: Term -> Eval Value + , quoteNf :: Value -> Eval Normal + } + +-- | Evaluate a term to WHNF, converting the result back to a Term. +-- The global environment at the end of evaluation is also returned, callers +-- should preserve any parts of the global environment needed for later calls. +-- +whnf + :: Evaluator + -- ^ The evaluator implementation to use. + -> GlobalEnv + -- ^ The initial global environment. + -> Bool + -- ^ Whether evaluation should keep lifted data constructors. + -- See NOTE [Lifted Constructors] in Clash.Core.PartialEval.NormalForm. + -> Id + -- ^ The id of the term under evaluation. + -> Term + -- ^ The term under evaluation. + -> IO (Term, GlobalEnv) + -- ^ The term evalated to WHNF, and the final global environment. +whnf e g isSubj i x = + let l = LocalEnv i mempty mempty (genvFuel g) isSubj + in runEval g l (asTerm <$> evalWhnf e x) + +-- | Evaluate a term to NF, converting the result back to a Term. +-- See `whnf` for more details. +-- +nf + :: Evaluator + -- ^ The evaluator implementation to use. + -> GlobalEnv + -- ^ The initial global environment. + -> Bool + -- ^ Whether evaluation should keep lifted data constructors. + -- See NOTE [Lifted Constructors] in Clash.Core.PartialEval.NormalForm. + -> Id + -- ^ The id of the term under evaluation. + -> Term + -- ^ The term under evaluation. + -> IO (Term, GlobalEnv) + -- ^ The term evalated to NF, and the final global environment. +nf e g isSubj i x = + let l = LocalEnv i mempty mempty (genvFuel g) isSubj + in runEval g l (asTerm <$> (evalWhnf e x >>= quoteNf e)) + +mkGlobalEnv + :: BindingMap + -- ^ Global bindings available to the evaluator. + -> TyConMap + -- ^ The type constructors known by Clash. + -> InScopeSet + -- ^ The set of variables in scope during evaluation. + -> Supply + -- ^ The supply of fresh names for variables. + -> Word + -- ^ The initial supply of fuel. + -> IntMap Value + -- ^ The initial IO heap. + -> Int + -- ^ The address of the next heap element. + -> GlobalEnv +mkGlobalEnv bm tcm iss ids fuel heap addr = + GlobalEnv (fmap asThunk bm) tcm iss ids fuel heap addr mempty + where + asThunk b@Binding{bindingId=i,bindingTerm=t} = + b { bindingTerm = VThunk t (LocalEnv i mempty mempty fuel False) } diff --git a/src/Clash/Core/PartialEval/AsTerm.hs b/src/Clash/Core/PartialEval/AsTerm.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Core/PartialEval/AsTerm.hs @@ -0,0 +1,84 @@ +{-| +Copyright : (C) 2020 QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +The AsTerm class and relevant instances for the partial evaluator. This +defines how to convert normal forms back into Terms which can be given as the +result of evaluation. +-} + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Clash.Core.PartialEval.AsTerm + ( AsTerm(..) + ) where + +import Data.Bifunctor (first, second) +import Data.Graph (SCC(..), flattenSCCs) + +import Clash.Core.FreeVars (localFVsOfTerms) +import Clash.Core.PartialEval.NormalForm +import Clash.Core.Term (Term(..), LetBinding, Pat, Alt, mkApps) +import Clash.Core.Util (sccLetBindings) +import Clash.Core.VarEnv (elemVarSet) + +-- | Convert a term in some normal form back into a Term. This is important, +-- as it may perform substitutions which have not yet been performed (i.e. when +-- converting from WHNF where heads contain the environment at that point). +-- +class AsTerm a where + asTerm:: a -> Term + +instance (AsTerm a) => AsTerm (Neutral a) where + asTerm = \case + NeVar i -> Var i + NePrim pr args -> mkApps (Prim pr) (argsToTerms args) + NeApp x y -> App (asTerm x) (asTerm y) + NeTyApp x ty -> TyApp (asTerm x) ty + NeLetrec bs x -> + let bs' = fmap (second asTerm) bs + x' = asTerm x + in removeUnusedBindings bs' x' + + NeCase x ty alts -> Case (asTerm x) ty (altsToTerms alts) + +removeUnusedBindings :: [LetBinding] -> Term -> Term +removeUnusedBindings bs x + | null used = x + | otherwise = Letrec used x + where + free = localFVsOfTerms [x] + used = flattenSCCs $ filter isUsed (sccLetBindings bs) + + isUsed = \case + AcyclicSCC y -> fst y `elemVarSet` free + CyclicSCC ys -> any (flip elemVarSet free . fst) ys + +instance AsTerm Value where + asTerm = \case + VNeutral neu -> asTerm neu + VLiteral lit -> Literal lit + VData dc args _env -> mkApps (Data dc) (argsToTerms args) + VLam i x _env -> Lam i x + VTyLam i x _env -> TyLam i x + VCast x a b -> Cast (asTerm x) a b + VTick x tick -> Tick tick (asTerm x) + VThunk x _env -> x + +instance AsTerm Normal where + asTerm = \case + NNeutral neu -> asTerm neu + NLiteral lit -> Literal lit + NData dc args -> mkApps (Data dc) (argsToTerms args) + NLam i x _env -> Lam i (asTerm x) + NTyLam i x _env -> TyLam i (asTerm x) + NCast x a b -> Cast (asTerm x) a b + NTick x tick -> Tick tick (asTerm x) + +argsToTerms :: (AsTerm a) => Args a -> Args Term +argsToTerms = fmap $ first asTerm + +altsToTerms :: (AsTerm a) => [(Pat, a)] -> [Alt] +altsToTerms = fmap $ second asTerm diff --git a/src/Clash/Core/PartialEval/Monad.hs b/src/Clash/Core/PartialEval/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Core/PartialEval/Monad.hs @@ -0,0 +1,317 @@ +{-| +Copyright : (C) 2020, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +The monad for partial evaluation, and its API. This should contain all +auxiliary functions needed to define new evaluator implementations. This +module is only needed to define new evaluators, for calling an existing +evaluator see Clash.Core.PartialEval. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} + +module Clash.Core.PartialEval.Monad + ( -- * Partial Evaluation Monad + Eval + , runEval + -- * Local and Global Environments + , getLocalEnv + , setLocalEnv + , modifyLocalEnv + , getGlobalEnv + , modifyGlobalEnv + -- * Evaluation Context + , getContext + , withContext + -- * Local Type Bindings + , getTvSubst + , findTyVar + , withTyVar + , withTyVars + -- * Local Term Bindings + , findId + , withId + , withIds + , withoutId + -- * Global Term Bindings + , findBinding + , replaceBinding + -- * IO Heap Bindings + , getRef + , setRef + -- * Lifted Data Constructors + , isKeepingLifted + , keepLifted + -- * Fuel + , getFuel + , withFuel + , preserveFuel + -- * Accessing Global State + , getTyConMap + , getInScope + -- * Fresh Variable Generation + , getUniqueId + , getUniqueTyVar + -- * Work free check + , workFreeValue + ) where + +import Control.Applicative (Alternative) +import Control.Concurrent.Supply (Supply) +import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask) +import Control.Monad.IO.Class (MonadIO) + +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail) +#endif + +import Control.Monad.RWS.Strict (RWST, MonadReader, MonadState) +import qualified Control.Monad.RWS.Strict as RWS +import qualified Data.IntMap.Strict as IntMap +import qualified Data.Map.Strict as Map + +import Clash.Core.FreeVars (localFVsOfTerms, tyFVsOfTypes) +import Clash.Core.Name (OccName) +import Clash.Core.PartialEval.AsTerm +import Clash.Core.PartialEval.NormalForm +import Clash.Core.Subst (Subst, mkTvSubst) +import Clash.Core.TyCon (TyConMap) +import Clash.Core.Type (Kind, KindOrType, Type) +import Clash.Core.Util (mkUniqSystemId, mkUniqSystemTyVar) +import Clash.Core.Var (Id, TyVar, Var) +import Clash.Core.VarEnv +import Clash.Driver.Types (Binding(..)) +import Clash.Rewrite.WorkFree (isWorkFree) + +{- +NOTE [RWS monad] +~~~~~~~~~~~~~~~~ +Local bindings are kept in the Reader monad and global bindings in the State +monad. This ensures that global changes are propagated to later evaluation +actions whereas local changes only exist when evaluating a particular sub-term. +For example, consider the term + + (let ... in f) (let ... in x) + +When evaluating this, the let bindings in the left sub-term should not be in +scope when evaluating the right sub-term. By using only the State monad for +local and global state, too much care needs to be given to ensuring that local +bindings are saved and restored when evaluating different sub-terms. + +The MonadWriter instance is deliberately not derived here, as the Writer monad +functionality of RWST is not wanted. +-} + +-- TODO The inner monad here could be changed to STM to allow the evaluator +-- to work on evaluating sub-terms concurrently. That would require slightly +-- different environment types, where data can be stored in STM types. + +-- | The monad of partial evaluation. The inner monad is IO, as primitive +-- evaluation can attempt to evaluate IO actions. +-- +newtype Eval a = Eval + { unEval :: RWST LocalEnv () GlobalEnv IO a } + deriving + ( Functor + , Applicative + , Alternative + , Monad + , MonadFail + , MonadIO + , MonadReader LocalEnv + , MonadState GlobalEnv + , MonadThrow + , MonadCatch + , MonadMask + ) + +-- | Evaluate an action in the partial evaluator, returning the result, +-- and the final state of the global environment. +-- +runEval :: GlobalEnv -> LocalEnv -> Eval a -> IO (a, GlobalEnv) +runEval g l x = + let extract (a, g', _) = (a, g') + in extract <$> RWS.runRWST (unEval x) l g +{-# INLINE runEval #-} + +getLocalEnv :: Eval LocalEnv +getLocalEnv = RWS.ask +{-# INLINE getLocalEnv #-} + +setLocalEnv :: LocalEnv -> Eval a -> Eval a +setLocalEnv = RWS.local . const +{-# INLINE setLocalEnv #-} + +modifyLocalEnv :: (LocalEnv -> LocalEnv) -> Eval a -> Eval a +modifyLocalEnv = RWS.local +{-# INLINE modifyLocalEnv #-} + +getGlobalEnv :: Eval GlobalEnv +getGlobalEnv = RWS.get +{-# INLINE getGlobalEnv #-} + +modifyGlobalEnv :: (GlobalEnv -> GlobalEnv) -> Eval () +modifyGlobalEnv = RWS.modify' +{-# INLINE modifyGlobalEnv #-} + +getContext :: Eval Id +getContext = lenvContext <$> getLocalEnv + +withContext :: Id -> Eval a -> Eval a +withContext i = modifyLocalEnv go + where + go env = env { lenvContext = i } + +findTyVar :: TyVar -> Eval (Maybe Type) +findTyVar i = Map.lookup i . lenvTypes <$> getLocalEnv + +withTyVar :: TyVar -> Type -> Eval a -> Eval a +withTyVar i a x = do + modifyGlobalEnv goGlobal + modifyLocalEnv goLocal x + where + goGlobal env@GlobalEnv{genvInScope=inScope} = + let fvs = unitVarSet i `unionVarSet` tyFVsOfTypes [a] + iss = mkInScopeSet fvs `unionInScope` inScope + in env { genvInScope = iss } + + goLocal env@LocalEnv{lenvTypes=types} = + env { lenvTypes = Map.insert i a types } + +withTyVars :: [(TyVar, Type)] -> Eval a -> Eval a +withTyVars = flip $ foldr (uncurry withTyVar) + +getTvSubst :: Eval Subst +getTvSubst = do + inScope <- getInScope + tys <- lenvTypes <$> getLocalEnv + let vars = mkVarEnv (Map.toList tys) + + pure (mkTvSubst inScope vars) + +findId :: Id -> Eval (Maybe Value) +findId i = Map.lookup i . lenvValues <$> getLocalEnv + +withId :: Id -> Value -> Eval a -> Eval a +withId i v x = do + modifyGlobalEnv goGlobal + modifyLocalEnv goLocal x + where + goGlobal env@GlobalEnv{genvInScope=inScope} = + -- TODO Is it a hack to use asTerm here? + let fvs = unitVarSet i `unionVarSet` localFVsOfTerms [asTerm v] + iss = mkInScopeSet fvs `unionInScope` inScope + in env { genvInScope = iss } + + goLocal env@LocalEnv{lenvValues=values} = + env { lenvValues = Map.insert i v values } + +withIds :: [(Id, Value)] -> Eval a -> Eval a +withIds = flip $ foldr (uncurry withId) + +withoutId :: Id -> Eval a -> Eval a +withoutId i = modifyLocalEnv go + where + go env@LocalEnv{lenvValues=values} = + env { lenvValues = Map.delete i values } + +findBinding :: Id -> Eval (Maybe (Binding Value)) +findBinding i = lookupVarEnv i . genvBindings <$> getGlobalEnv + +replaceBinding :: Binding Value -> Eval () +replaceBinding b = modifyGlobalEnv go + where + go env@GlobalEnv{genvBindings=bindings} = + env { genvBindings = extendVarEnv (bindingId b) b bindings } + +getRef :: Int -> Eval Value +getRef addr = do + heap <- genvHeap <$> getGlobalEnv + + case IntMap.lookup addr heap of + Just val -> pure val + Nothing -> error ("getHeap: Address " <> show addr <> " out of bounds") + +setRef :: Int -> Value -> Eval () +setRef addr val = modifyGlobalEnv go + where + go env@GlobalEnv{genvHeap=heap,genvAddr=next} + | addr == next = + env { genvHeap = IntMap.insert addr val heap, genvAddr = addr + 1 } + + | otherwise = + env { genvHeap = IntMap.insert addr val heap } + +isKeepingLifted :: Eval Bool +isKeepingLifted = lenvKeepLifted <$> getLocalEnv + +keepLifted :: Eval a -> Eval a +keepLifted = modifyLocalEnv forceLifted + where + forceLifted env = env { lenvKeepLifted = True } + +getFuel :: Eval Word +getFuel = do + lenv <- getLocalEnv + genv <- getGlobalEnv + + pure (min (lenvFuel lenv) (genvFuel genv)) + +withFuel :: Eval a -> Eval a +withFuel x = modifyGlobalEnv go >> x + where + go env@GlobalEnv{genvFuel=fuel} = + env { genvFuel = fuel - 1 } + +preserveFuel :: Eval a -> Eval a +preserveFuel x = do + fuel <- getFuel + res <- x + + modifyGlobalEnv (go fuel) + pure res + where + go fuel env = env { genvFuel = fuel } + +getTyConMap :: Eval TyConMap +getTyConMap = genvTyConMap <$> getGlobalEnv + +getInScope :: Eval InScopeSet +getInScope = genvInScope <$> getGlobalEnv + +getUniqueId :: OccName -> Type -> Eval Id +getUniqueId = getUniqueVar mkUniqSystemId + +getUniqueTyVar :: OccName -> Kind -> Eval TyVar +getUniqueTyVar = getUniqueVar mkUniqSystemTyVar + +getUniqueVar + :: ((Supply, InScopeSet) + -> (OccName, KindOrType) + -> ((Supply, InScopeSet), Var a)) + -> OccName + -> KindOrType + -> Eval (Var a) +getUniqueVar f name ty = do + env <- getGlobalEnv + let iss = genvInScope env + ids = genvSupply env + ((ids', iss'), i) = f (ids, iss) (name, ty) + + modifyGlobalEnv (go ids' iss') + pure i + where + go ids iss env = + env { genvInScope = iss, genvSupply = ids } + +workFreeValue :: Value -> Eval Bool +workFreeValue = \case + VNeutral _ -> pure False + VThunk x _ -> do + bindings <- fmap (fmap asTerm) . genvBindings <$> getGlobalEnv + isWorkFree workFreeCache bindings x + + _ -> pure True diff --git a/src/Clash/Core/PartialEval/NormalForm.hs b/src/Clash/Core/PartialEval/NormalForm.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Core/PartialEval/NormalForm.hs @@ -0,0 +1,196 @@ +{-| +Copyright : (C) 2020, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +Normal forms for the partial evaluator. These provide a restricted model of +how terms can be constructed (compared to the more liberal Term type) which +give a stronger guarantee that evaluation does not produce invalid results. +This module is only needed to define new evaluators, for calling an existing +evaluator see Clash.Core.PartialEval. +-} + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Clash.Core.PartialEval.NormalForm + ( Arg + , Args + , Neutral(..) + , Value(..) + , mkValueTicks + , stripValue + , collectValueTicks + , isUndefined + , Normal(..) + , LocalEnv(..) + , GlobalEnv(..) + , workFreeCache + ) where + +import Control.Concurrent.Supply (Supply) +import Control.Lens (Lens', lens) +import Data.IntMap.Strict (IntMap) +import Data.Map.Strict (Map) + +import Clash.Core.DataCon (DataCon) +import Clash.Core.Literal +import Clash.Core.Term (Term(..), PrimInfo(primName), TickInfo, Pat) +import Clash.Core.TyCon (TyConMap) +import Clash.Core.Type (Type, TyVar) +import Clash.Core.Var (Id) +import Clash.Core.VarEnv (VarEnv, InScopeSet) +import Clash.Driver.Types (Binding(..)) + +type Args a + = [Arg a] + +-- | An argument applied to a function / data constructor / primitive. +-- +type Arg a + = Either a Type + +-- | Neutral terms cannot be reduced, as they represent things like variables +-- which are unknown, partially applied functions, or case expressions where +-- the subject cannot be inspected. Consider: +-- +-- v Stuck if "v" is a free variable +-- p x1 ... xn Stuck if "p" is a primitive that cannot be reduced +-- x $ y Stuck if "x" is not known to be a lambda +-- x @ A Stuck if "x" is not known to be a type lambda +-- case x of ... Stuck if "x" is neutral (cannot choose an alternative) +-- +-- Neutral terms can also be let expressions which preserve required bindings +-- in the normal form representation. Examples of bindings that may be kept are +-- bindings which perform work (and should not be copied) or bindings that +-- are recursive and are still referred to by the body of the let expression. +-- +-- let ... in ... Preserved bindings are needed by the body +-- +data Neutral a + = NeVar !Id + | NePrim !PrimInfo !(Args a) + | NeApp !(Neutral a) !a + | NeTyApp !(Neutral a) !Type + | NeLetrec ![(Id, a)] !a + | NeCase !a !Type ![(Pat, a)] + deriving (Show) + +-- | A term which has been potentially evaluated to WHNF. If evaluation has +-- occurred, then there will be no redexes at the head of the Value, but +-- sub-terms may still have redexes. Data constructors are only considered to +-- be values when fully applied, if partially applied they should be +-- eta-expanded during evaluation. +-- +-- Thunks are included so that lazy evaluation can be modelled without needing +-- to store Either Term Value in the environment. This makes the presentation +-- simpler, with the caveat that values must be forced when they are required +-- to not be thunks. +-- +data Value + = VNeutral !(Neutral Value) + | VLiteral !Literal + | VData !DataCon !(Args Value) !LocalEnv + | VLam !Id !Term !LocalEnv + | VTyLam !TyVar !Term !LocalEnv + | VCast !Value !Type !Type + | VTick !Value !TickInfo + | VThunk !Term !LocalEnv + deriving (Show) + +mkValueTicks :: Value -> [TickInfo] -> Value +mkValueTicks = foldl VTick + +stripValue :: Value -> Value +stripValue = fst . collectValueTicks + +collectValueTicks :: Value -> (Value, [TickInfo]) +collectValueTicks = go [] + where + go !acc = \case + VTick v tick -> go (tick : acc) v + value -> (value, acc) + +isUndefined :: Value -> Bool +isUndefined = \case + VNeutral (NePrim pr _) -> + primName pr `elem` + [ "Control.Exception.Base.absentError" + , "Control.Exception.Base.patError" + , "EmptyCase" + , "GHC.Err.undefined" + , "Clash.Transformations.undefined" + , "Clash.XException.errorX" + ] + + _ -> False + +-- | A term which is in beta-normal eta-long form (NF). This has no redexes, +-- and all partially applied functions in sub-terms are eta-expanded. +-- +-- While not strictly necessary, NLam includes the environment at the point the +-- original term was evaluated. This makes it easier for the AsTerm instance +-- for Normal to reintroduce let expressions before lambdas without +-- accidentally floating a let using a lambda bound variable outwards. +-- +data Normal + = NNeutral !(Neutral Normal) + | NLiteral !Literal + | NData !DataCon !(Args Normal) + | NLam !Id !Normal !LocalEnv + | NTyLam !TyVar !Normal !LocalEnv + | NCast !Normal !Type !Type + | NTick !Normal !TickInfo + deriving (Show) + +data LocalEnv = LocalEnv + { lenvContext :: Id + -- ^ The id of the term currently under evaluation. + , lenvTypes :: Map TyVar Type + -- ^ Local type environment. These are types that are introduced while + -- evaluating the current term (i.e. by type applications) + , lenvValues :: Map Id Value + -- ^ Local term environment. These are WHNF terms or unevaluated thunks + -- introduced while evaluating the current term (i.e. by applications) + , lenvFuel :: Word + -- ^ The amount of fuel left in the local environment when the previous + -- head was reached. This is needed so resuming evaluation does not lead + -- to additional fuel being available. + , lenvKeepLifted :: Bool + -- ^ When evaluating, keep data constructors for boxed data types (e.g. I#) + -- instead of converting these back to their corresponding primitive. This + -- is used when evaluating terms where the result is subject of a case + -- expression (see note: lifted data types). + } deriving (Show) + +-- TODO Add recursion info to the global environment. Until then we are forced +-- to spend fuel on non-recursive (terminating) terms. + +data GlobalEnv = GlobalEnv + { genvBindings :: VarEnv (Binding Value) + -- ^ Global term environment. These are the potentially evaluated bodies + -- of the top level definitions which are forced on lookup. + , genvTyConMap :: TyConMap + -- ^ The type constructors known about by Clash. + , genvInScope :: InScopeSet + -- ^ The set of in scope variables during partial evaluation. This includes + -- new variables introduced by the evaluator (such as the ids of binders + -- introduced during eta expansion.) + , genvSupply :: Supply + -- ^ The supply of fresh names for generating identifiers. + , genvFuel :: Word + -- ^ The remaining fuel which can be spent inlining global variables. This + -- is saved in the local environment, so when evaluation resumes from WHNF + -- the amount of fuel used is preserved. + , genvHeap :: IntMap Value + -- ^ The heap containing the results of any evaluated IO primitives. + , genvAddr :: Int + -- ^ The address of the next element to be inserted into the heap. + , genvWorkCache :: VarEnv Bool + -- ^ Cache for the results of isWorkFree. This is required to use + -- Clash.Rewrite.WorkFree.isWorkFree. + } + +workFreeCache :: Lens' GlobalEnv (VarEnv Bool) +workFreeCache = lens genvWorkCache (\env x -> env { genvWorkCache = x }) diff --git a/src/Clash/Core/Pretty.hs b/src/Clash/Core/Pretty.hs --- a/src/Clash/Core/Pretty.hs +++ b/src/Clash/Core/Pretty.hs @@ -7,6 +7,7 @@ PrettyPrec printing class and instances for CoreHW -} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -40,7 +41,11 @@ import Data.Text.Prettyprint.Doc.Internal import GHC.Show (showMultiLineString) import Numeric (fromRat) +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Utils.Outputable as GHC +#else import qualified Outputable as GHC +#endif import System.Environment (lookupEnv) import System.IO.Unsafe (unsafePerformIO) import Text.Read (readMaybe) @@ -79,12 +84,16 @@ -- ^ whether to display type information , displayQualifiers :: Bool -- ^ whether to display module qualifiers + , displayTicks :: Bool + -- ^ whether to display ticks } + instance Default PrettyOptions where def = PrettyOptions { displayUniques = unsafeLookupEnvBool "CLASH_PPR_UNIQUES" True , displayTypes = unsafeLookupEnvBool "CLASH_PPR_TYPES" True , displayQualifiers = unsafeLookupEnvBool "CLASH_PPR_QUALIFIERS" True + , displayTicks = unsafeLookupEnvBool "CLASH_PPR_TICKS" True } -- | Annotations carried on pretty-printed code. @@ -96,7 +105,7 @@ deriving Eq -- | Specific places in the program syntax. -data SyntaxElement = Keyword | LitS | Type | Unique | Qualifier +data SyntaxElement = Keyword | LitS | Type | Unique | Qualifier | Ticky deriving (Eq, Show) -- | Clash's specialized @Doc@ type holds metadata of type @ClashAnnotation@. @@ -125,6 +134,7 @@ if not (displayTypes opts) && ann == AnnSyntax Type || not (displayUniques opts) && ann == AnnSyntax Unique || not (displayQualifiers opts) && ann == AnnSyntax Qualifier + || not (displayTicks opts) && ann == AnnSyntax Ticky then Empty else Annotated ann (hide d') d -> d @@ -251,7 +261,7 @@ Tick t e' -> do tDoc <- pprPrec prec t eDoc <- pprPrec prec e' - return (tDoc <> line' <> eDoc) + return (annotate (AnnSyntax Ticky) (tDoc <> line') <> eDoc) instance PrettyPrec TickInfo where pprPrec prec (SrcSpan sp) = pprPrec prec sp diff --git a/src/Clash/Core/Subst.hs b/src/Clash/Core/Subst.hs --- a/src/Clash/Core/Subst.hs +++ b/src/Clash/Core/Subst.hs @@ -420,7 +420,7 @@ -- it is as we would replace global variables in them. take (i+1) exts ++ substGlobalsInExistentials is (drop (i+1) exts) [subst] --- | This checks if the substitution satisfies the invariant from 'TvSbust's +-- | This checks if the substitution satisfies the invariant from 'TvSubst's -- Note [The substitution invariant]. checkValidSubst :: HasCallStack diff --git a/src/Clash/Core/Term.hs b/src/Clash/Core/Term.hs --- a/src/Clash/Core/Term.hs +++ b/src/Clash/Core/Term.hs @@ -7,6 +7,7 @@ Term representation in the CoreHW language: System F + LetRec + Case -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -35,6 +36,8 @@ , partitionTicks , NameMod (..) , PrimInfo (..) + , IsMultiPrim (..) + , MultiPrimInfo (..) , WorkInfo (..) , CoreContext (..) , Context @@ -61,15 +64,19 @@ import Data.List (nub, partition) import Data.Text (Text) import GHC.Generics +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (SrcSpan) +#else import SrcLoc (SrcSpan) +#endif -- Internal Modules import Clash.Core.DataCon (DataCon) import Clash.Core.Literal (Literal) import Clash.Core.Name (Name (..)) import {-# SOURCE #-} Clash.Core.Subst () -- instance Eq Type -import {-# SOURCE #-} Clash.Core.Type -import Clash.Core.Var (Var(Id), Id) +import {-# SOURCE #-} Clash.Core.Type (Type) +import Clash.Core.Var (Var(Id), Id, TyVar) import Clash.Util (curLoc) -- | Term representation in the CoreHW language: System F + LetRec + Case @@ -114,12 +121,30 @@ -- ^ @Clash.Magic.setName@ deriving (Eq,Show,Generic,NFData,Hashable,Binary) +data IsMultiPrim + = SingleResult + | MultiResult + deriving (Show, Generic, NFData, Hashable, Binary) + data PrimInfo = PrimInfo - { primName :: !Text - , primType :: !Type + { primName :: !Text + , primType :: !Type , primWorkInfo :: !WorkInfo + , primMultiResult :: !IsMultiPrim + -- ^ Primitive with multiple return values. Useful for primitives that cannot + -- return their results as a single product type, due to limitation of + -- synthesis tooling. It will be applied to its normal arguments, followed by + -- the variables it should assign its results to. + -- + -- See: 'Clash.Normalize.Transformations.setupMultiResultPrim' } deriving (Show,Generic,NFData,Hashable,Binary) +data MultiPrimInfo = MultiPrimInfo + { mpi_primInfo :: PrimInfo + , mpi_resultDc :: DataCon + , mpi_resultTypes :: [Type] + } + data WorkInfo = WorkConstant -- ^ Ignores its arguments, and outputs a constant @@ -130,7 +155,7 @@ | WorkAlways -- ^ Performs work regardless of whether the variables are constant or -- variable; these are things like clock or reset generators - deriving (Show,Generic,NFData,Hashable,Binary) + deriving (Eq,Show,Generic,NFData,Hashable,Binary) -- | Term reference type TmName = Name Term @@ -163,11 +188,11 @@ mkAbstraction :: Term -> [Either Id TyVar] -> Term mkAbstraction = foldr (either Lam TyLam) --- | Abstract a term over a list of term variables +-- | Abstract a term over a list of type variables mkTyLams :: Term -> [TyVar] -> Term mkTyLams tm = mkAbstraction tm . map Right --- | Abstract a term over a list of type variables +-- | Abstract a term over a list of variables mkLams :: Term -> [Id] -> Term mkLams tm = mkAbstraction tm . map Left @@ -362,4 +387,3 @@ varToId :: Term -> Id varToId (Var i) = i varToId e = error $ $(curLoc) ++ "varToId: not a var: " ++ show e - diff --git a/src/Clash/Core/TermInfo.hs b/src/Clash/Core/TermInfo.hs --- a/src/Clash/Core/TermInfo.hs +++ b/src/Clash/Core/TermInfo.hs @@ -1,20 +1,27 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Clash.Core.TermInfo where +import Data.Maybe (fromMaybe) import Data.Text.Prettyprint.Doc (line) +import Data.Text (isInfixOf) import Clash.Core.DataCon import Clash.Core.FreeVars import Clash.Core.Literal +import Clash.Core.Name import Clash.Core.Pretty import Clash.Core.Subst import Clash.Core.Term -import Clash.Core.TyCon (TyConMap) +import Clash.Core.TyCon (tyConDataCons, TyConMap) import Clash.Core.Type import Clash.Core.Var import Clash.Core.VarEnv import Clash.Debug (debugIsOn) +import Clash.Unique (lookupUniqMap) import Clash.Util import Clash.Util.Interpolate as I @@ -44,7 +51,7 @@ Var t -> varType t Data dc -> dcType dc Literal l -> literalType l - Prim t -> primType t + Prim p -> goPrimType p Lam v e' -> mkFunTy (varType v) (termType m e') TyLam tv e' -> ForAllTy tv (termType m e') App _ _ -> case collectArgs e of @@ -55,7 +62,75 @@ Case _ ty _ -> ty Cast _ _ ty2 -> ty2 Tick _ e' -> termType m e' + where + goPrimType = \case + PrimInfo{primMultiResult=SingleResult, primType} -> primType + p@PrimInfo{primMultiResult=MultiResult} -> multiPrimType p +-- | Type of multi prim primitive belonging to given primitive. See +-- 'Clash.Normalize.Transformations.setupMultiResultPrim' for more information. +-- +-- Example, given: +-- +-- @ +-- /\v1 -> t1 -> t2 -> (t3, t4) +-- @ +-- +-- produces: +-- +-- @ +-- /\v1 -> t1 -> t2 -> t3 -> t4 -> (t3, t4) +-- @ +-- +multiPrimType :: PrimInfo -> Type +multiPrimType primInfo = + if "GHC.Tuple.(," `isInfixOf` nameOcc tupTcNm + then mkPolyFunTy primResTy (primArgs <> map Right tupEls) + else error (multPrimErr primInfo) + where + (primArgs, primResTy) = splitFunForallTy (primType primInfo) + TyConApp tupTcNm tupEls = tyView primResTy + +multPrimErr :: PrimInfo -> String +multPrimErr primInfo = [I.i| + Internal error in multiPrimInfo': could not produce MultiPrimInfo. This + probably means a multi result blackbox's result type was not a tuple. + PrimInfo: + + #{primInfo} +|] + +splitMultiPrimArgs :: + HasCallStack => + MultiPrimInfo -> + [Either Term Type] -> + ([Either Term Type], [Id]) +splitMultiPrimArgs MultiPrimInfo{mpi_resultTypes} args0 = (args1, resArgs1) + where + resArgs1 = [id_ | Left (Var id_) <- resArgs0] + (args1, resArgs0) = splitAt (length args0 - length mpi_resultTypes) args0 + +-- | Same as 'multiPrimInfo', but produced an error if it could not produce a +-- 'MultiPrimInfo'. +multiPrimInfo' :: HasCallStack => TyConMap -> PrimInfo -> MultiPrimInfo +multiPrimInfo' tcm primInfo = + fromMaybe (error (multPrimErr primInfo)) (multiPrimInfo tcm primInfo) + +-- | Produce 'MutliPrimInfo' for given primitive +multiPrimInfo :: TyConMap -> PrimInfo -> Maybe MultiPrimInfo +multiPrimInfo tcm primInfo + | (_primArgs, primResTy) <- splitFunForallTy (primType primInfo) + , TyConApp tupTcNm tupEls <- tyView primResTy + -- XXX: Hardcoded for tuples + , "GHC.Tuple.(," `isInfixOf` nameOcc tupTcNm + , Just tupTc <- lookupUniqMap tupTcNm tcm + , [tupDc] <- tyConDataCons tupTc + = Just $ MultiPrimInfo + { mpi_primInfo = primInfo + , mpi_resultDc = tupDc + , mpi_resultTypes = tupEls } +multiPrimInfo _ _ = Nothing + -- | Get the result type of a polymorphic function given a list of arguments applyTypeToArgs :: Term @@ -124,7 +199,7 @@ | otherwise = Nothing --- | @(piResultTys f_ty [ty1, ..., tyn])@ give sthe type of @(f ty1 .. tyn)@ +-- | @(piResultTys f_ty [ty1, ..., tyn])@ gives the type of @(f ty1 .. tyn)@ -- where @f :: f_ty@ -- -- 'piResultTys' is interesting because: @@ -228,3 +303,7 @@ isPrim (Prim {}) = True isPrim _ = False +-- | Is a term a cast? +isCast :: Term -> Bool +isCast (Cast {}) = True +isCast _ = False diff --git a/src/Clash/Core/TermLiteral.hs b/src/Clash/Core/TermLiteral.hs --- a/src/Clash/Core/TermLiteral.hs +++ b/src/Clash/Core/TermLiteral.hs @@ -6,8 +6,11 @@ Tools to convert a 'Term' into its "real" representation -} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} +--{-# OPTIONS_GHC -ddump-splices #-} + module Clash.Core.TermLiteral ( TermLiteral , termToData @@ -15,21 +18,25 @@ , uncheckedTermToData ) where -import qualified Data.Text as Text -import Data.Text (Text) import Data.Bifunctor (bimap) import Data.Either (lefts) +import Data.Proxy (Proxy(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Typeable (Typeable, typeRep) import GHC.Natural import GHC.Stack import Clash.Core.Term (Term(Literal), collectArgs) import Clash.Core.Literal import Clash.Core.Pretty (showPpr) +import qualified Clash.Util.Interpolate as I +import qualified Clash.Verification.Internal as Cv import Clash.Core.TermLiteral.TH -- | Tools to deal with literals encoded as a "Term". -class TermLiteral a where +class Typeable a => TermLiteral a where -- | Convert 'Term' to the constant it represents. Will return an error if -- (one of the subterms) fail to translate. termToData @@ -55,6 +62,11 @@ Right (fromInteger n) termToData t = Left t +instance TermLiteral Word where + termToData (collectArgs -> (_, [Left (Literal (WordLiteral n))])) = + Right (fromInteger n) + termToData t = Left t + instance TermLiteral Integer where termToData (collectArgs -> (_, [Left (Literal (IntegerLiteral n))])) = Right n termToData t = Left t @@ -81,14 +93,35 @@ instance TermLiteral Bool where termToData = $(deriveTermToData ''Bool) +instance TermLiteral Cv.RenderAs where + termToData = $(deriveTermToData ''Cv.RenderAs) + +instance TermLiteral a => TermLiteral (Cv.Assertion' a) where + termToData = $(deriveTermToData ''Cv.Assertion') + +instance TermLiteral a => TermLiteral (Cv.Property' a) where + termToData = $(deriveTermToData ''Cv.Property') + -- | Same as 'termToData', but returns printable error message if it couldn't -- translate a term. -termToDataError :: TermLiteral a => Term -> Either String a +termToDataError :: forall a. TermLiteral a => Term -> Either String a termToDataError term = bimap err id (termToData term) where - err failedTerm = - "Failed to translate term to literal. Term that failed to translate:\n\n" - ++ showPpr failedTerm ++ "\n\nIn the full term:\n\n" ++ showPpr term + typ = show (typeRep (Proxy @a)) + + err failedTerm = [I.i| + Failed to translate term to literal. Term that failed to translate: + + #{showPpr failedTerm} + + In the full term: + + #{showPpr term} + + While trying to interpret something to type: + + #{typ} + |] -- | Same as 'termToData', but errors hard if it can't translate a given term -- to data. diff --git a/src/Clash/Core/TermLiteral/TH.hs b/src/Clash/Core/TermLiteral/TH.hs --- a/src/Clash/Core/TermLiteral/TH.hs +++ b/src/Clash/Core/TermLiteral/TH.hs @@ -2,6 +2,9 @@ module Clash.Core.TermLiteral.TH ( deriveTermToData + -- Stop exporting @dcName'@ once `ghcide` stops type-checking expanded + -- TH splices + , dcName' ) where import Data.Either @@ -34,9 +37,11 @@ deriveTermToData1 :: [(Name, Int)] -> Exp deriveTermToData1 constrs = - LamE - [pat] - (if null args then theCase else LetE args theCase) + LamCaseE + [ Match pat (NormalB (if null args then theCase else LetE args theCase)) [] + , Match (VarP termName) (NormalB ((ConE 'Left `AppE` VarE termName))) [] + + ] where nArgs = maximum (map snd constrs) diff --git a/src/Clash/Core/Termination.hs b/src/Clash/Core/Termination.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Core/Termination.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE LambdaCase #-} + +module Clash.Core.Termination + ( RecInfo + , mkRecInfo + , isRecursive + , recursiveGroup + ) where + +import Control.Lens.Fold +import Data.Graph (SCC(..)) +import qualified Data.Graph as Graph +import qualified Data.List as List + +import Clash.Core.FreeVars +import Clash.Core.Var +import Clash.Core.VarEnv +import Clash.Driver.Types + +-- Quick lookup for whether a binding is recursive or non-recursive. If a +-- binding is non-recursive, we can assume that it terminates and skip +-- analysing it. +-- +data RecInfo = RecInfo + { recBindings :: [VarSet] + -- ^ Recursive bindings, organized into groups of strongly connected + -- components. + , nonRecBindings :: VarSet + -- ^ Non-recursive bindings + } + +instance Show RecInfo where + show (RecInfo rs ns) = + "recursive groups:\n" <> show (fmap eltsVarSet rs) + <> "\n\nnon-recursive:\n" <> show (eltsVarSet ns) + +instance Semigroup RecInfo where + {-# INLINE (<>) #-} + RecInfo rX nX <> RecInfo rY nY = + RecInfo (rX <> rY) (nX <> nY) + +instance Monoid RecInfo where + {-# INLINE mempty #-} + mempty = RecInfo mempty mempty + + {-# INLINE mappend #-} + mappend = (<>) + +-- | Given a map of top-level bindings, identify which terms are recursive and +-- organize them into groups of mutually recursive bindings. For example, +-- calling mkRecInfo on a BindingMap with the definitions +-- +-- f [] = [] +-- f (x:xs) = g x : h xs +-- +-- g x = x + 1 +-- +-- h [] = [] +-- h (x:xs) = x : f xs +-- +-- i [] = [] +-- i (x:xs) = x * 2 : i xs +-- +-- would identify [f, g] and [i] as recursive groups, and g as non-recursive. +-- +mkRecInfo :: BindingMap -> RecInfo +mkRecInfo = + mconcat . fmap asInfo . dependencies + where + -- Convert a SCC to RecInfo + asInfo = \case + AcyclicSCC x -> RecInfo [] (unitVarSet $ bindingId x) + CyclicSCC xs -> RecInfo [mkVarSet $ fmap bindingId xs] emptyVarSet + + -- Get the SCCs of the dependency graph of free variables. + dependencies = + Graph.stronglyConnComp . eltsVarEnv . fmap go + where + go x = let fvs = bindingTerm x ^.. freeIds + in (x, bindingId x, fvs) + +-- | Check if a global binder is recursive. To be conservative, binders which +-- are not included in the RecInfo are assumed to be recursive. +-- +isRecursive :: Id -> RecInfo -> Bool +isRecursive i + | isGlobalId i = not . elemVarSet i . nonRecBindings + | otherwise = error ("isRecursive: " <> show i <> " is not a global Id") + +-- | Return the recursive group that a global binder belongs to. If the +-- binder is non-recursive or not included in the RecInfo, Nothing is returned. +-- +recursiveGroup :: Id -> RecInfo -> Maybe VarSet +recursiveGroup i = List.find (elemVarSet i) . recBindings + diff --git a/src/Clash/Core/Type.hs b/src/Clash/Core/Type.hs --- a/src/Clash/Core/Type.hs +++ b/src/Clash/Core/Type.hs @@ -63,7 +63,7 @@ import Data.Coerce (coerce) import Data.Hashable (Hashable) import Data.List (foldl') -import Data.List.Extra (splitAtList, zipEqual) +import Data.List.Extra (splitAtList) import Data.Maybe (isJust, mapMaybe) import GHC.Base (isTrue#,(==#)) import GHC.Generics (Generic(..)) @@ -71,6 +71,15 @@ import GHC.Integer.Logarithms (integerLogBase#) -- GHC API +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names + (integerTyConKey, typeNatAddTyFamNameKey, typeNatExpTyFamNameKey, + typeNatLeqTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey, + typeNatCmpTyFamNameKey, ordLTDataConKey, ordEQDataConKey, ordGTDataConKey, + typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey) +import GHC.Types.SrcLoc (wiredInSrcSpan) +import GHC.Types.Unique (getKey) +#else #if __GLASGOW_HASKELL__ >= 808 import PrelNames (ordLTDataConKey, ordEQDataConKey, ordGTDataConKey) @@ -86,6 +95,7 @@ typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey) import SrcLoc (wiredInSrcSpan) import Unique (getKey) +#endif -- Local imports import Clash.Core.DataCon @@ -413,16 +423,23 @@ -- a substituted RHS funSubsts :: TyConMap -> ([Type],Type) -> [Type] -> Maybe Type funSubsts tcm (tcSubstLhs,tcSubstRhs) args = do - tySubts <- foldl' (funSubst tcm) (Just []) (zipEqual tcSubstLhs args) + let (funArgs,remainder) = zipAtLeast tcSubstLhs args + tySubts <- foldl' (funSubst tcm) (Just []) funArgs let tyRhs = uncurry substTyWith (unzip tySubts) tcSubstRhs -- Type functions can return higher-kinded types - case drop (length tcSubstLhs) args of + case remainder of [] -> return tyRhs -- So don't forget to apply the arguments not consumed by the type -- function application! -- -- Forgetting leads to: #232 args' -> return (foldl' AppTy tyRhs args') + where + zipAtLeast [] ys = ([],ys) + zipAtLeast _ [] = error "Under-applied type family" + zipAtLeast (x:xs) (y:ys) = + let (zs,remainder) = zipAtLeast xs ys + in ((x,y):zs,remainder) -- Given a LHS matching type, and a RHS to-match type, check if LHS and RHS -- are a match. If they do match, and the LHS is a variable, return a @@ -452,7 +469,7 @@ -- and if so, the applied type, and the type in the substitution should match. Just ty' | ty' `aeqType` ty -> Just s _ -> Nothing - go ty1 (reduceTypeFamily tcm -> Just ty2) = go ty1 ty2 -- See [Note: lazy type families] + -- [Note] funSubst FunTy -- -- Whenever type classes have associated types whose instances 'map' to @@ -485,108 +502,133 @@ go _ _ = Nothing -{- [Note: lazy type families] - -I don't know whether type families are evaluated strictly or lazily, but this -being Haskell, I assume type families are evaluated lazily. +{- [Note: Eager type families] -Clash hence follows the Haskell way, and only evaluates type family arguments -to (WH)NF when the formal parameter is _not_ a type variable. +I don't know whether type families are evaluated strictly or lazily, but since +type families do not reduce on stuck argument, we assume strictly. -} reduceTypeFamily :: TyConMap -> Type -> Maybe Type reduceTypeFamily tcm (tyView -> TyConApp tc tys) | nameUniq tc == getKey typeNatAddTyFamNameKey - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just (LitTy (NumTy (i1 + i2))) + = case mapMaybe (litView tcm) tys of + [i1,i2] -> Just (LitTy (NumTy (i1 + i2))) + _ -> Nothing | nameUniq tc == getKey typeNatMulTyFamNameKey - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just (LitTy (NumTy (i1 * i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] -> Just (LitTy (NumTy (i1 * i2))) + _ -> Nothing | nameUniq tc == getKey typeNatExpTyFamNameKey - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just (LitTy (NumTy (i1 ^ i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] -> Just (LitTy (NumTy (i1 ^ i2))) + _ -> Nothing | nameUniq tc == getKey typeNatSubTyFamNameKey - , [i1, i2] <- mapMaybe (litView tcm) tys - , let z = i1 - i2 - , z >= 0 - = Just (LitTy (NumTy z)) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | let z = i1 - i2 + , z >= 0 + -> Just (LitTy (NumTy z)) + _ -> Nothing | nameUniq tc == getKey typeNatLeqTyFamNameKey - , [i1, i2] <- mapMaybe (litView tcm) tys - , Just (FunTyCon {tyConKind = tck}) <- lookupUniqMap tc tcm - , (_,tyView -> TyConApp boolTcNm []) <- splitFunTys tcm tck - , Just boolTc <- lookupUniqMap boolTcNm tcm - = let [falseTc,trueTc] = map (coerce . dcName) (tyConDataCons boolTc) - in if i1 <= i2 then Just (mkTyConApp trueTc [] ) - else Just (mkTyConApp falseTc []) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | Just (FunTyCon {tyConKind = tck}) <- lookupUniqMap tc tcm + , (_,tyView -> TyConApp boolTcNm []) <- splitFunTys tcm tck + , Just boolTc <- lookupUniqMap boolTcNm tcm + -> let [falseTc,trueTc] = map (coerce . dcName) (tyConDataCons boolTc) + in if i1 <= i2 then Just (mkTyConApp trueTc []) + else Just (mkTyConApp falseTc []) + _ -> Nothing | nameUniq tc == getKey typeNatCmpTyFamNameKey -- "GHC.TypeNats.CmpNat" - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just $ ConstTy $ TyCon $ - case compare i1 i2 of - LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan - EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan - GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan + = case mapMaybe (litView tcm) tys of + [i1, i2] -> + Just $ ConstTy $ TyCon $ + case compare i1 i2 of + LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan + EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan + GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan + _ -> Nothing | nameUniq tc == getKey typeSymbolCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol" - , [s1, s2] <- mapMaybe (symLitView tcm) tys - = Just $ ConstTy $ TyCon $ - case compare s1 s2 of - LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan - EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan - GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan + = case mapMaybe (symLitView tcm) tys of + [s1, s2] -> + Just $ ConstTy $ TyCon $ + case compare s1 s2 of + LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan + EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan + GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan + _ -> Nothing | nameUniq tc == getKey typeSymbolAppendFamNameKey -- GHC.TypeLits.AppendSymbol" - , [s1, s2] <- mapMaybe (symLitView tcm) tys - = Just (LitTy (SymTy (s1 ++ s2))) + = case mapMaybe (symLitView tcm) tys of + [s1, s2] -> + Just (LitTy (SymTy (s1 ++ s2))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.FLog", "GHC.TypeNats.FLog"] - , [i1, i2] <- mapMaybe (litView tcm) tys - , i1 > 1 - , i2 > 0 - = Just (LitTy (NumTy (smallInteger (integerLogBase# i1 i2)))) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | i1 > 1 + , i2 > 0 + -> Just (LitTy (NumTy (smallInteger (integerLogBase# i1 i2)))) + _ -> Nothing + | nameOcc tc `elem` ["GHC.TypeLits.Extra.CLog", "GHC.TypeNats.CLog"] - , [i1, i2] <- mapMaybe (litView tcm) tys - , Just k <- clogBase i1 i2 - = Just (LitTy (NumTy (toInteger k))) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | Just k <- clogBase i1 i2 + -> Just (LitTy (NumTy (toInteger k))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.Log", "GHC.TypeNats.Log"] - , [i1, i2] <- mapMaybe (litView tcm) tys - , i1 > 1 - , i2 > 0 - = if i2 == 1 - then Just (LitTy (NumTy 0)) - else let z1 = integerLogBase# i1 i2 - z2 = integerLogBase# i1 (i2-1) - in if isTrue# (z1 ==# z2) - then Nothing - else Just (LitTy (NumTy (smallInteger z1))) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | i1 > 1 + , i2 > 0 + -> if i2 == 1 + then Just (LitTy (NumTy 0)) + else let z1 = integerLogBase# i1 i2 + z2 = integerLogBase# i1 (i2-1) + in if isTrue# (z1 ==# z2) + then Nothing + else Just (LitTy (NumTy (smallInteger z1))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.GCD", "GHC.TypeNats.GCD"] - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just (LitTy (NumTy (i1 `gcd` i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] -> Just (LitTy (NumTy (i1 `gcd` i2))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.LCM", "GHC.TypeNats.LCM"] - , [i1, i2] <- mapMaybe (litView tcm) tys - = Just (LitTy (NumTy (i1 `lcm` i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] -> Just (LitTy (NumTy (i1 `lcm` i2))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.Div", "GHC.TypeNats.Div"] - , [i1, i2] <- mapMaybe (litView tcm) tys - , i2 > 0 - = Just (LitTy (NumTy (i1 `div` i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | i2 > 0 + -> Just (LitTy (NumTy (i1 `div` i2))) + _ -> Nothing | nameOcc tc `elem` ["GHC.TypeLits.Extra.Mod", "GHC.TypeNats.Mod"] - , [i1, i2] <- mapMaybe (litView tcm) tys - , i2 > 0 - = Just (LitTy (NumTy (i1 `mod` i2))) + = case mapMaybe (litView tcm) tys of + [i1, i2] + | i2 > 0 + -> Just (LitTy (NumTy (i1 `mod` i2))) + _ -> Nothing | Just (FunTyCon {tyConSubst = tcSubst}) <- lookupUniqMap tc tcm - = findFunSubst tcm tcSubst tys + = let -- See [Note: Eager type families] + tysR = map (argView tcm) tys + in findFunSubst tcm tcSubst tysR reduceTypeFamily _ _ = Nothing @@ -595,6 +637,11 @@ isTypeFamilyApplication tcm (tyView -> TyConApp tcNm _args) | Just (FunTyCon {}) <- lookupUniqMap tcNm tcm = True isTypeFamilyApplication _tcm _type = False + +argView :: TyConMap -> Type -> Type +argView m t = case reduceTypeFamily m t of + Nothing -> t + Just tR -> argView m tR litView :: TyConMap -> Type -> Maybe Integer litView _ (LitTy (NumTy i)) = Just i diff --git a/src/Clash/Core/TysPrim.hs b/src/Clash/Core/TysPrim.hs --- a/src/Clash/Core/TysPrim.hs +++ b/src/Clash/Core/TysPrim.hs @@ -32,8 +32,13 @@ import qualified Data.List as List +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names +import GHC.Types.Unique (getKey) +#else import PrelNames import Unique (getKey) +#endif import Clash.Core.Name import Clash.Core.TyCon @@ -66,8 +71,13 @@ naturalPrimTyConName, byteArrayPrimTyConName :: TyConName intPrimTyConName = mkUnsafeSystemName "GHC.Prim.Int#" (getKey intPrimTyConKey) +#if MIN_VERSION_base(4,15,0) +integerPrimTyConName = mkUnsafeSystemName "GHC.Num.Integer.Integer" + (getKey integerTyConKey) +#else integerPrimTyConName = mkUnsafeSystemName "GHC.Integer.Type.Integer" (getKey integerTyConKey) +#endif stringPrimTyConName = mkUnsafeSystemName "GHC.Prim.Addr#" (getKey addrPrimTyConKey) charPrimTyConName = mkUnsafeSystemName "GHC.Prim.Char#" (getKey charPrimTyConKey) @@ -82,8 +92,13 @@ (getKey floatPrimTyConKey) doublePrimTyConName = mkUnsafeSystemName "GHC.Prim.Double#" (getKey doublePrimTyConKey) +#if MIN_VERSION_base(4,15,0) +naturalPrimTyConName = mkUnsafeSystemName "GHC.Num.Natural.Natural" + (getKey naturalTyConKey) +#else naturalPrimTyConName = mkUnsafeSystemName "GHC.Natural.Natural" (getKey naturalTyConKey) +#endif byteArrayPrimTyConName = mkUnsafeSystemName "GHC.Prim.ByteArray#" (getKey byteArrayPrimTyConKey) diff --git a/src/Clash/Core/Util.hs b/src/Clash/Core/Util.hs --- a/src/Clash/Core/Util.hs +++ b/src/Clash/Core/Util.hs @@ -30,8 +30,13 @@ import Data.Semigroup #endif +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names (ipClassKey) +import GHC.Types.Unique (getKey) +#else import PrelNames (ipClassKey) import Unique (getKey) +#endif import Clash.Core.DataCon import Clash.Core.EqSolver @@ -418,13 +423,15 @@ primCo :: Type -> Term -primCo ty = Prim (PrimInfo "_CO_" ty WorkNever) +primCo ty = Prim (PrimInfo "_CO_" ty WorkNever SingleResult) -- | Make an undefined term undefinedTm :: Type -> Term -undefinedTm = TyApp (Prim (PrimInfo "Clash.Transformations.undefined" undefinedTy WorkNever)) +undefinedTm = + let undefinedNm = "Clash.Transformations.undefined" in + TyApp (Prim (PrimInfo undefinedNm undefinedTy WorkNever SingleResult)) substArgTys :: DataCon diff --git a/src/Clash/Core/Var.hs b/src/Clash/Core/Var.hs --- a/src/Clash/Core/Var.hs +++ b/src/Clash/Core/Var.hs @@ -36,7 +36,7 @@ import Control.DeepSeq (NFData (..)) import Data.Binary (Binary) import Data.Function (on) -import Data.Hashable (Hashable) +import Data.Hashable (Hashable(hashWithSalt)) import GHC.Generics (Generic) import Clash.Core.Name (Name (..)) import {-# SOURCE #-} Clash.Core.Term (Term, TmName) @@ -78,13 +78,16 @@ , varType :: Type , idScope :: IdScope } - deriving (Show,Generic,NFData,Hashable,Binary) + deriving (Show,Generic,NFData,Binary) -- | Gets a _key_ in the DBMS sense: a value that uniquely identifies a -- Var. In case of a "Var" that is its unique and (if applicable) scope varKey :: Var a -> (Unique, Maybe IdScope) varKey TyVar{varUniq} = (varUniq, Nothing) varKey Id{varUniq,idScope} = (varUniq, Just idScope) + +instance Hashable (Var a) where + hashWithSalt salt a = hashWithSalt salt (varKey a) instance Eq (Var a) where (==) = (==) `on` varKey diff --git a/src/Clash/Core/VarEnv.hs b/src/Clash/Core/VarEnv.hs --- a/src/Clash/Core/VarEnv.hs +++ b/src/Clash/Core/VarEnv.hs @@ -93,6 +93,7 @@ ) where +import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Coerce (coerce) import qualified Data.List as List @@ -144,7 +145,8 @@ -- -- Errors out when the variable is not present lookupVarEnv' - :: VarEnv a + :: HasCallStack + => VarEnv a -> Var b -> a lookupVarEnv' = lookupUniqMap' @@ -350,7 +352,7 @@ -- See "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 for the -- motivation data InScopeSet = InScopeSet VarSet {-# UNPACK #-} !Int - deriving (Generic, Binary) + deriving (Generic, NFData, Binary) instance ClashPretty InScopeSet where clashPretty (InScopeSet s _) = clashPretty s diff --git a/src/Clash/Debug.hs b/src/Clash/Debug.hs --- a/src/Clash/Debug.hs +++ b/src/Clash/Debug.hs @@ -28,4 +28,3 @@ traceShowWith :: Show b => (a -> b) -> a -> a traceShowWith f a = trace (show (f a)) a - diff --git a/src/Clash/Driver.hs b/src/Clash/Driver.hs --- a/src/Clash/Driver.hs +++ b/src/Clash/Driver.hs @@ -2,67 +2,89 @@ Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , QBayLogic, Google Inc. + 2020 QBayLogic + License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. Module that connects all the parts of the Clash compiler library -} +{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Clash.Driver where import qualified Control.Concurrent.Supply as Supply import Control.DeepSeq -import Control.Exception (tryJust, bracket, throw) -import Control.Lens (view, _4) +import Control.Exception (throw) import qualified Control.Monad as Monad -import Control.Monad (guard, when, unless, foldM) +import Control.Monad (unless, foldM, forM, filterM) import Control.Monad.Catch (MonadMask) +import Control.Monad.Extra (whenM, ifM, unlessM) import Control.Monad.IO.Class (MonadIO) import Control.Monad.State (evalState, get) import Control.Monad.State.Strict (State) +import qualified Control.Monad.State.Strict as State +import qualified Crypto.Hash.SHA256 as Sha256 +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as ByteStringLazy +import qualified Data.ByteString.Lazy.Char8 as ByteStringLazyChar8 +import Data.Char (isAscii, isAlphaNum) +import Data.Coerce (coerce) +import Data.Default import Data.Hashable (hash) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet +import Data.Proxy (Proxy(..)) import Data.IntMap (IntMap) import Data.List (intercalate) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList, mapMaybe) +import qualified Data.Map.Ordered as OMap +import Data.Map.Ordered.Extra () import Data.Semigroup.Monad -import qualified Data.Set as Set import qualified Data.Text import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as Text +import Data.Text.Lazy.Encoding as Text import qualified Data.Text.Lazy.IO as Text -import Data.Text.Prettyprint.Doc (pretty) import Data.Text.Prettyprint.Doc.Extra - (Doc, LayoutOptions (..), PageWidth (..) , layoutPretty, renderLazy, - renderOneLine) + (Doc, LayoutOptions (..), PageWidth (..) , layoutPretty, renderLazy) import qualified Data.Time.Clock as Clock import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Extension as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint import qualified System.Directory as Directory +import System.Directory + (doesPathExist, listDirectory, doesDirectoryExist, createDirectoryIfMissing, + removeDirectoryRecursive, doesFileExist) import System.Environment (getExecutablePath) -import System.FilePath ((), (<.>)) +import System.FilePath ((), (<.>), takeDirectory, takeFileName, isAbsolute) import qualified System.FilePath as FilePath import qualified System.IO as IO -import System.IO.Error (isDoesNotExistError) import System.IO.Temp (getCanonicalTemporaryDirectory, withTempDirectory) import Text.Trifecta.Result (Result(Success, Failure), _errDoc) -import Text.Read (readMaybe) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names (eqTyConKey, ipClassKey) +import GHC.Types.Unique (getKey) + +import GHC.Types.SrcLoc (SrcSpan) +#else import PrelNames (eqTyConKey, ipClassKey) import Unique (getKey) import SrcLoc (SrcSpan) -import Util (OverridingBool(Auto)) +#endif import GHC.BasicTypes.Extra () import Clash.Annotations.Primitive @@ -73,10 +95,15 @@ (TopEntity (..), PortName(PortName, PortProduct)) import Clash.Annotations.TopEntity.Extra () import Clash.Backend -import Clash.Core.Evaluator.Types (PrimStep, PrimUnwind) + +#if EXPERIMENTAL_EVALUATOR +import Clash.Core.PartialEval (Evaluator) +#else +import Clash.Core.Evaluator.Types (Evaluator) +#endif + import Clash.Core.Name (Name (..)) import Clash.Core.Pretty (PrettyOptions(..), showPpr') -import Clash.Core.Term (Term) import Clash.Core.Type (Type(ForAllTy, LitTy, AnnType), TypeView(..), tyView, mkFunTy, LitTy(SymTy)) import Clash.Core.TyCon (TyConMap, TyConName) @@ -84,16 +111,18 @@ import Clash.Core.Var (Id, varName, varUniq, varType) import Clash.Core.VarEnv - (VarEnv, elemVarEnv, eltsVarEnv, emptyVarEnv, lookupVarEnv, lookupVarEnv') + (elemVarEnv, emptyVarEnv, lookupVarEnv, lookupVarEnv', mkVarEnv, lookupVarEnvDirectly) import Clash.Debug (debugIsOn) import Clash.Driver.Types -import Clash.Netlist (genNetlist) -import Clash.Netlist.Util (genComponentName, genTopComponentName) +import Clash.Driver.Manifest (Manifest(..), readFreshManifest, UnexpectedModification, pprintUnexpectedModifications, mkManifest, writeManifest, manifestFilename) +import Clash.Edalize.Edam +import Clash.Netlist (genNetlist, genTopNames) import Clash.Netlist.BlackBox.Parser (runParse) import Clash.Netlist.BlackBox.Types (BlackBoxTemplate, BlackBoxFunction) +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types - (BlackBox (..), Component (..), Identifier, FilteredHWType, HWMap, - SomeBackend (..), TopEntityT(..), TemplateFunction, ComponentPrefix(..)) + (IdentifierText, BlackBox (..), Component (..), FilteredHWType, HWMap, SomeBackend (..), + TopEntityT(..), TemplateFunction, ComponentMap, findClocks, ComponentMeta(..)) import Clash.Normalize (checkNonRecursive, cleanupGraph, normalize, runNormalization) import Clash.Normalize.Util (callGraph, tvSubstWithTyEq) @@ -102,14 +131,16 @@ import qualified Clash.Primitives.GHC.Int as P import qualified Clash.Primitives.GHC.Word as P import qualified Clash.Primitives.Intel.ClockGen as P +import qualified Clash.Primitives.Verification as P import Clash.Primitives.Types -import Clash.Primitives.Util (hashCompiledPrimMap) -import Clash.Unique (keysUniqMap, lookupUniqMap') +import Clash.Signal.Internal +import Clash.Unique (Unique, getUnique) import Clash.Util.Interpolate (i) import Clash.Util (ClashException(..), HasCallStack, first, reportTimeDiff, - wantedLanguageExtensions, unwantedLanguageExtensions) + wantedLanguageExtensions, unwantedLanguageExtensions, curLoc) import Clash.Util.Graph (reverseTopSort) +import qualified Clash.Util.Interpolate as I -- | Worker function of 'splitTopEntityT' splitTopAnn @@ -154,7 +185,7 @@ to a malformed Synthesize annotation. All clocks, resets, and enables should be given a unique port name. Type to be split: - #{showPpr' (PrettyOptions False True False) a} + #{showPpr' (PrettyOptions False True False False) a} Given port annotation: #{p}. You might want to use the following instead: PortProduct #{show nm} []. This allows Clash to @@ -196,20 +227,44 @@ -> TopEntityT splitTopEntityT tcm bindingsMap tt@(TopEntityT id_ (Just t@(Synthesize {})) _) = case lookupVarEnv id_ bindingsMap of - Just (Binding _id sp _ _) -> + Just (Binding _id sp _ _ _) -> tt{topAnnotation=Just (splitTopAnn tcm sp (varType id_) t)} Nothing -> error "Internal error in 'splitTopEntityT'. Please report as a bug." splitTopEntityT _ _ t = t +-- | Remove constraints such as 'a ~ 3'. +removeForAll :: TopEntityT -> TopEntityT +removeForAll (TopEntityT var annM isTb) = + TopEntityT var{varType=tvSubstWithTyEq (varType var)} annM isTb + +-- | Given a list of all found top entities and _maybe_ a top entity (+dependencies) +-- passed in by '-main-is', return the list of top entities Clash needs to +-- compile. +selectTopEntities :: [TopEntityT] -> Maybe (TopEntityT, [TopEntityT]) -> [TopEntityT] +selectTopEntities topEntities mainTopEntity = + maybe topEntities (uncurry (:)) mainTopEntity + -- | Get modification data of current clash binary. getClashModificationDate :: IO Clock.UTCTime getClashModificationDate = Directory.getModificationTime =<< getExecutablePath +hdlFromBackend :: forall backend. Backend backend => Proxy backend -> HDL +hdlFromBackend _ = hdlKind (undefined :: backend) + +replaceChar :: Char -> Char -> String -> String +replaceChar a b = map go + where + go c + | c == a = b + | otherwise = c + -- | Create a set of target HDL files for a set of functions generateHDL :: forall backend . Backend backend => CustomReprs + -> HashMap Data.Text.Text VDomainConfiguration + -- ^ Known domains to configurations -> BindingMap -- ^ Set of functions -> Maybe backend @@ -222,10 +277,10 @@ -> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -- ^ Hardcoded 'Type' -> 'HWType' translator - -> (PrimStep, PrimUnwind) - -- ^ Hardcoded evaluator (delta-reduction) + -> Evaluator + -- ^ Hardcoded evaluator for partial evaluation -> [TopEntityT] - -- ^ All topentities and associated testbench + -- ^ All topentities -> Maybe (TopEntityT, [TopEntityT]) -- ^ Main top entity to compile. If Nothing, all top entities in previous -- argument will be compiled. @@ -233,244 +288,173 @@ -- ^ Debug information level for the normalization process -> (Clock.UTCTime,Clock.UTCTime) -> IO () -generateHDL reprs bindingsMap hdlState primMap tcm tupTcm typeTrans eval - topEntities0 mainTopEntity opts (startTime,prepTime) = - let todo = maybe topEntities2 (uncurry (:)) mainTopEntity in - go prepTime HashMap.empty (sortTop bindingsMap todo) +generateHDL reprs domainConfs bindingsMap hdlState primMap tcm tupTcm typeTrans eval + topEntities0 mainTopEntity opts (startTime,prepTime) = do + case opt_dbgRewriteHistoryFile opts of + Nothing -> pure () + Just histFile -> whenM (Directory.doesFileExist histFile) (Directory.removeFile histFile) + let (tes, deps) = sortTop bindingsMap topEntities1 + in go prepTime initIs HashMap.empty deps tes where - topEntities1 = map (splitTopEntityT tcm bindingsMap) topEntities0 - -- Remove forall's used in type equality constraints - topEntities2 = map (\(TopEntityT var annM tbM) -> TopEntityT var{varType=tvSubstWithTyEq (varType var)} annM tbM) topEntities1 + (compNames, initIs) = genTopNames topPrefixM escpIds lwIds hdl topEntities1 + topEntityMap = mkVarEnv (fmap (\x -> (topId x, x)) topEntities1) + topPrefixM = opt_componentPrefix opts + hdl = hdlFromBackend (Proxy @backend) + escpIds = opt_escapedIds opts + lwIds = opt_lowerCaseBasicIds opts + topEntities1 = + map + (removeForAll . splitTopEntityT tcm bindingsMap) + (selectTopEntities topEntities0 mainTopEntity) - go prevTime _ [] = putStrLn $ "Clash: Total compilation took " ++ - reportTimeDiff prevTime startTime + go + :: Clock.UTCTime + -> Id.IdentifierSet + -> HashMap Unique [EdamFile] + -> HashMap Unique [Unique] + -> [TopEntityT] + -> IO () + go prevTime _ _ _ [] = + putStrLn $ "Clash: Total compilation took " ++ reportTimeDiff prevTime startTime -- Process the next TopEntity - go prevTime seen (TopEntityT topEntity annM benchM:topEntities') = do + go prevTime seen0 edamFiles0 deps (TopEntityT topEntity annM isTb:topEntities') = do let topEntityS = Data.Text.unpack (nameOcc (varName topEntity)) putStrLn $ "Clash: Compiling " ++ topEntityS -- Some initial setup - let modName1 = takeWhile (/= '.') topEntityS - (modName,prefixM) = case opt_componentPrefix opts of - Just p + let -- TODO: 'modName1' should be run through 'seen0' + modName1 = filter (\c -> isAscii c && (isAlphaNum c || c == '_')) (replaceChar '.' '_' topEntityS) + topNm = lookupVarEnv' compNames topEntity + (modNameS, fmap Data.Text.pack -> prefixM) = case topPrefixM of + Just (Data.Text.unpack -> p) | not (null p) -> case annM of -- Prefix top names with 'p', prefix other with 'p_tname' Just ann -> - let nm = p ++ ('_':t_name ann) - in (nm,ComponentPrefix (Just (Data.Text.pack p)) (Just (Data.Text.pack nm))) + let nm = p <> "_" <> t_name ann in + (nm, Just nm) -- Prefix top names with 'p', prefix other with 'p' - _ -> (p ++ '_':modName1,ComponentPrefix (Just (Data.Text.pack p)) (Just (Data.Text.pack p))) - | Just ann <- annM -> case hdlKind (undefined :: backend) of + _ -> (p <> "_" <> modName1, Just p) + | Just ann <- annM -> case hdl of -- Prefix other with 't_name' - VHDL -> (t_name ann,ComponentPrefix Nothing (Just (Data.Text.pack (t_name ann)))) - _ -> (t_name ann,ComponentPrefix Nothing Nothing) + VHDL -> (t_name ann, Just modNameS) + _ -> (t_name ann, Nothing) _ -> case annM of Just ann -> case hdlKind (undefined :: backend) of - VHDL -> (t_name ann, ComponentPrefix Nothing Nothing) + VHDL -> (t_name ann, Nothing) -- Prefix other with 't_name' - _ -> (t_name ann, ComponentPrefix Nothing (Just (Data.Text.pack (t_name ann)))) - _ -> (modName1, ComponentPrefix Nothing Nothing) + _ -> (t_name ann, Just modNameS) + _ -> (modName1, Nothing) + modNameT = Data.Text.pack modNameS iw = opt_intWidth opts hdlsyn = opt_hdlSyn opts - escpIds = opt_escapedIds opts forceUnd = opt_forceUndefined opts - hdlState' = setModName (Data.Text.pack modName) - $ fromMaybe (initBackend iw hdlsyn escpIds forceUnd :: backend) hdlState - hdlDir = fromMaybe "." (opt_hdlDir opts) - Clash.Backend.name hdlState' - takeWhile (/= '.') topEntityS - mkId = evalState mkIdentifier hdlState' - extId = evalState extendIdentifier hdlState' + xOpt = coerce (opt_aggressiveXOptBB opts) + hdlState' = setModName modNameT + $ fromMaybe (initBackend iw hdlsyn escpIds lwIds forceUnd xOpt :: backend) hdlState + hdlDir = fromMaybe (Clash.Backend.name hdlState') (opt_hdlDir opts) topEntityS + manPath = hdlDir manifestFilename ite = ifThenElseExpr hdlState' - topNm = genTopComponentName (opt_newInlineStrat opts) mkId prefixM - annM topEntity - topNmU = Data.Text.unpack topNm - - unless (opt_cachehdl opts) $ putStrLn "Clash: Ignoring .manifest files" - - -- Calculate the hash over the callgraph and the topEntity annotation - (useCacheTop,useCacheBench,manifest) <- do - clashModDate <- getClashModificationDate + topNmT = Id.toText topNm - let primMapHash = hashCompiledPrimMap primMap + unless (opt_cachehdl opts) $ putStrLn "Clash: Ignoring previously made caches" - let optsHash = hash opts { -- Ignore the following settings, they don't - -- affect the generated HDL: - -- 1. Debug - opt_dbgLevel = DebugNone - , opt_dbgTransformations = Set.empty - -- 2. Caching - , opt_cachehdl = True - -- 3. Warnings - , opt_primWarn = True - , opt_color = Auto - , opt_errorExtra = False - , opt_checkIDir = True - -- Ignore the following settings, they don't - -- affect the generated HDL. However, they do - -- influence whether HDL can be generated at all. - -- - -- So later on we check whether the new flags - -- changed in such a way that they could affect - -- successful compilation, and use that information - -- to decide whether to use caching or not. - -- - -- 1. termination measures - , opt_inlineLimit = 20 - , opt_specLimit = 20 - -- 2. Float support - , opt_floatSupport = False - -- Finally, also ignore the HDL dir setting, - -- because when a user moves the entire dir - -- with generated HDL, they probably still want - -- to use that as a cache - , opt_hdlDir = Nothing - } + -- Get manifest file if cache is not stale and caching is enabled. This is used + -- to prevent unnecessary recompilation. + clashModDate <- getClashModificationDate + (userModifications, maybeManifest, topHash) <- + readFreshManifest topEntities0 (bindingsMap, topEntity) primMap opts clashModDate manPath - let - topHash = - hash ( annM - , primMapHash - , show clashModDate - , callGraphBindings bindingsMap topEntity - , optsHash - ) + supplyN <- Supply.newSupply + let topEntityNames = map topId topEntities1 - let - benchHashM = - case benchM of - Nothing -> Nothing - Just bench -> - let terms = callGraphBindings bindingsMap bench in - Just (hash (annM, primMapHash, show clashModDate, terms, optsHash)) + (topTime, seen2, edamFiles2) <- case maybeManifest of + Just manifest0@Manifest{fileNames} | Just [] <- userModifications -> do + -- Found a 'manifest' files. Use it to extend "seen" set. Generate EDAM + -- files if necessary. + putStrLn ("Clash: Using cached result for: " ++ topEntityS) + topTime <- Clock.getCurrentTime + let seen1 = State.execState (mapM_ Id.addRaw (componentNames manifest0)) seen0 - let successFlagsI = (opt_inlineLimit opts,opt_specLimit opts,opt_floatSupport opts) - manifestI = Manifest (topHash,benchHashM) successFlagsI [] [] [] [] [] + (edamFiles1, fileNames1) <- + if opt_edalize opts + then writeEdam hdlDir (topNm, varUniq topEntity) deps edamFiles0 fileNames + else pure (edamFiles0, fileNames) - let - manFile = - case annM of - Nothing -> hdlDir topNmU <.> "manifest" - _ -> hdlDir topNmU topNmU <.> "manifest" + writeManifest manPath manifest0{fileNames=fileNames1} - manM <- if not (opt_cachehdl opts) - then return Nothing -- ignore manifest file because -fclash-nocache - else (>>= readMaybe) . either (const Nothing) Just <$> - tryJust (guard . isDoesNotExistError) (readFile manFile) - return (maybe (False,False,manifestI) - (\man -> - let allowCache (inl0,spec0,fl0) (inl1,spec1,fl1) = - inl0 <= inl1 && spec0 <= spec1 && (not (fl0 && not fl1)) - flagsAllowCache = allowCache (successFlags man) successFlagsI - in (flagsAllowCache && fst (manifestHash man) == topHash - ,flagsAllowCache && snd (manifestHash man) == benchHashM - ,man { manifestHash = (topHash,benchHashM) - , successFlags = if flagsAllowCache - then successFlags man - else successFlagsI - } - )) - manM) + return + ( topTime + , seen1 + , edamFiles1 + ) - (supplyN,supplyTB) <- Supply.splitSupply - . snd - . Supply.freshId - <$> Supply.newSupply - let topEntityNames = map topId topEntities2 + _ -> do + -- 1. Prepare HDL directory + -- + -- [Note] Create HDL dir before netlist generation + -- + -- Already create the directory where the HDL ends up being generated, as + -- we use directories relative to this final directory to find manifest + -- files belonging to other top entities. Failing to do so leads to #463 + () <- prepareDir hdlDir opts userModifications - (topTime,manifest',seen') <- if useCacheTop - then do - putStrLn ("Clash: Using cached result for: " ++ Data.Text.unpack (nameOcc (varName topEntity))) - topTime <- Clock.getCurrentTime - return (topTime,manifest,HashMap.unionWith max (HashMap.fromList (map (,0) (componentNames manifest))) seen) - else do - -- 1. Normalise topEntity + -- 2. Normalize topEntity let transformedBindings = normalizeEntity reprs bindingsMap primMap tcm tupTcm typeTrans eval topEntityNames opts supplyN topEntity normTime <- transformedBindings `deepseq` Clock.getCurrentTime let prepNormDiff = reportTimeDiff normTime prevTime - putStrLn $ "Clash: Normalisation took " ++ prepNormDiff - - -- 2. Generate netlist for topEntity + putStrLn $ "Clash: Normalization took " ++ prepNormDiff - -- [Note] Create HDL dir before netlist generation - -- - -- Already create the directory where the HDL ends up being generated, as - -- we use directories relative to this final directory to find manifest - -- files belonging to other top entities. Failing to do so leads to #463 - let dir = hdlDir maybe "" (const modName) annM - prepareDir (opt_cleanhdl opts) (extension hdlState') dir - -- Now start the netlist generation - (netlist,seen') <- - genNetlist False opts reprs transformedBindings topEntities2 primMap - tcm typeTrans iw mkId extId ite (SomeBackend hdlState') seen hdlDir prefixM topEntity + -- 3. Generate netlist for topEntity + (topComponent, netlist, seen2) <- + genNetlist isTb opts reprs transformedBindings topEntityMap compNames primMap + tcm typeTrans iw ite (SomeBackend hdlState') seen0 hdlDir prefixM topEntity netlistTime <- netlist `deepseq` Clock.getCurrentTime let normNetDiff = reportTimeDiff netlistTime normTime putStrLn $ "Clash: Netlist generation took " ++ normNetDiff - -- 3. Generate topEntity wrapper - let topComponent = view _4 (lookupVarEnv' netlist topEntity) - (hdlDocs,manifest',dfiles,mfiles) = createHDL hdlState' (Data.Text.pack modName) seen' netlist topComponent - (topNm, Right manifest) - mapM_ (writeHDL dir) hdlDocs - copyDataFiles (opt_importPaths opts) dir dfiles - writeMemoryDataFiles dir mfiles - - topTime <- hdlDocs `seq` Clock.getCurrentTime - return (topTime,manifest',seen') - - benchTime <- case benchM of - Just tb | not useCacheBench -> do - putStrLn $ "Clash: Compiling " ++ Data.Text.unpack (nameOcc (varName tb)) - - let modName' = genComponentName (opt_newInlineStrat opts) HashMap.empty - mkId prefixM tb - hdlState2 = setModName modName' hdlState' - - -- 1. Normalise testBench - let transformedBindings = normalizeEntity reprs bindingsMap primMap tcm tupTcm - typeTrans eval topEntityNames opts supplyTB tb - normTime <- transformedBindings `deepseq` Clock.getCurrentTime - let prepNormDiff = reportTimeDiff normTime topTime - putStrLn $ "Clash: Testbench normalization took " ++ prepNormDiff - - -- 2. Generate netlist for topEntity + -- 4. Generate topEntity wrapper + let + (hdlDocs, dfiles, mfiles) = + createHDL hdlState' modNameT seen2 netlist domainConfs topComponent topNmT - -- See [Note] Create HDL dir before netlist generation - let dir = hdlDir maybe "" t_name annM Data.Text.unpack modName' - prepareDir (opt_cleanhdl opts) (extension hdlState2) dir - -- Now start the netlist generation - (netlist,seen'') <- - genNetlist True opts reprs transformedBindings topEntities2 primMap - tcm typeTrans iw mkId extId ite (SomeBackend hdlState') seen' hdlDir prefixM tb + -- TODO: Data files should go into their own directory + -- FIXME: Files can silently overwrite each other + hdlDocDigests <- mapM (writeHDL hdlDir) hdlDocs + dataFilesDigests <- copyDataFiles (opt_importPaths opts) hdlDir dfiles + memoryFilesDigests <- writeMemoryDataFiles hdlDir mfiles - netlistTime <- netlist `deepseq` Clock.getCurrentTime - let normNetDiff = reportTimeDiff netlistTime normTime - putStrLn $ "Clash: Testbench netlist generation took " ++ normNetDiff + let + components = map (snd . snd) (OMap.assocs netlist) + filesAndDigests0 = + zip (map fst hdlDocs) hdlDocDigests + <> zip (map fst dfiles) dataFilesDigests + <> zip (map fst mfiles) memoryFilesDigests - -- 3. Write HDL - let (hdlDocs,_,dfiles,mfiles) = createHDL hdlState2 modName' seen'' netlist undefined - (topNm, Left manifest') - writeHDL (hdlDir maybe "" t_name annM) (head hdlDocs) - mapM_ (writeHDL dir) (tail hdlDocs) - copyDataFiles (opt_importPaths opts) dir dfiles - writeMemoryDataFiles dir mfiles + (edamFiles1, filesAndDigests1) <- + if opt_edalize opts + then writeEdam hdlDir (topNm, varUniq topEntity) deps edamFiles0 filesAndDigests0 + else pure (edamFiles0, filesAndDigests0) - hdlDocs `seq` Clock.getCurrentTime + let + depUniques = fromMaybe [] (HashMap.lookup (getUnique topEntity) deps) + depBindings = mapMaybe (flip lookupVarEnvDirectly bindingsMap) depUniques + depIds = map bindingId depBindings - Just tb -> do - let tb' = Data.Text.unpack (nameOcc (varName tb)) - putStrLn ("Clash: Compiling: " ++ tb') - putStrLn ("Clash: Using cached result for: " ++ tb') - return topTime + manifest = + mkManifest + hdlState' domainConfs opts topComponent components depIds + filesAndDigests1 topHash + writeManifest manPath manifest - Nothing -> return topTime + topTime <- hdlDocs `seq` Clock.getCurrentTime + return (topTime, seen2, edamFiles1) - go benchTime seen' topEntities' + go topTime seen2 edamFiles2 deps topEntities' -- | Interpret a specific function from a specific module. This action tries -- two things: @@ -496,7 +480,7 @@ -> String -- ^ Function name -> String - -- ^ Type name ("BlackBoxFunction" or "TemplateFunction") + -- ^ Type name ('BlackBoxFunction' or 'TemplateFunction') -> m (Either Hint.InterpreterError a) loadImportAndInterpret iPaths0 interpreterArgs topDir qualMod funcName typ = do Hint.liftIO $ Monad.when debugIsOn $ @@ -533,13 +517,15 @@ knownBlackBoxFunctions :: HashMap String BlackBoxFunction knownBlackBoxFunctions = HashMap.fromList $ map (first show) $ - [ ('P.bvToIntegerVHDL, P.bvToIntegerVHDL) + [ ('P.checkBBF, P.checkBBF) + , ('P.bvToIntegerVHDL, P.bvToIntegerVHDL) , ('P.bvToIntegerVerilog, P.bvToIntegerVerilog) , ('P.foldBBF, P.foldBBF) , ('P.indexIntVerilog, P.indexIntVerilog) , ('P.indexToIntegerVerilog, P.indexToIntegerVerilog) , ('P.indexToIntegerVHDL, P.indexToIntegerVHDL) , ('P.intTF, P.intTF) + , ('P.iterateBBF, P.iterateBBF) , ('P.signedToIntegerVerilog, P.signedToIntegerVerilog) , ('P.signedToIntegerVHDL, P.signedToIntegerVHDL) , ('P.unsignedToIntegerVerilog, P.unsignedToIntegerVerilog) @@ -570,7 +556,7 @@ -> ResolvedPrimitive -- ^ Primitive to compile -> IO CompiledPrimitive -compilePrimitive idirs pkgDbs topDir (BlackBoxHaskell bbName wf usedArgs bbGenName source) = do +compilePrimitive idirs pkgDbs topDir (BlackBoxHaskell bbName wf usedArgs multiRes bbGenName source) = do bbFunc <- -- TODO: Use cache for hint targets. Right now Hint will fire multiple times -- TODO: if multiple functions use the same blackbox haskell function. @@ -587,7 +573,7 @@ id r - pure (BlackBoxHaskell bbName wf usedArgs bbGenName (hash source, bbFunc)) + pure (BlackBoxHaskell bbName wf usedArgs multiRes bbGenName (hash source, bbFunc)) where fullName = qualMod ++ "." ++ funcName qualMod = intercalate "." modNames @@ -621,14 +607,14 @@ loadImportAndInterpret idirs args topDir qualMod funcName "BlackBoxFunction" compilePrimitive idirs pkgDbs topDir - (BlackBox pNm wf rVoid tkind () oReg libM imps fPlural incs rM riM templ) = do + (BlackBox pNm wf rVoid multiRes tkind () oReg libM imps fPlural incs rM riM templ) = do libM' <- mapM parseTempl libM imps' <- mapM parseTempl imps incs' <- mapM (traverse parseBB) incs templ' <- parseBB templ rM' <- traverse parseBB rM riM' <- traverse parseBB riM - return (BlackBox pNm wf rVoid tkind () oReg libM' imps' fPlural incs' rM' riM' templ') + return (BlackBox pNm wf rVoid multiRes tkind () oReg libM' imps' fPlural incs' rM' riM' templ') where iArgs = concatMap (("-package-db":) . (:[])) pkgDbs @@ -706,137 +692,268 @@ :: Backend backend => backend -- ^ Backend - -> Identifier + -> IdentifierText -- ^ Module hierarchy root - -> HashMap Identifier Word + -> Id.IdentifierSet -- ^ Component names - -> VarEnv ([Bool],SrcSpan,HashMap Identifier Word,Component) + -> ComponentMap -- ^ List of components + -> HashMap Data.Text.Text VDomainConfiguration + -- ^ Known domains to configurations -> Component -- ^ Top component - -> (Identifier, Either Manifest Manifest) + -> IdentifierText -- ^ Name of the manifest file - -- + Either: - -- * Left manifest: Only write/update the hashes of the @manifest@ - -- * Right manifest: Update all fields of the @manifest@ - -> ([(String,Doc)],Manifest,[(String,FilePath)],[(String,String)]) + -> ([(String,Doc)],[(String,FilePath)],[(String,String)]) -- ^ The pretty-printed HDL documents - -- + The update manifest file -- + The data files that need to be copied -createHDL backend modName seen components top (topName,manifestE) = flip evalState backend $ getMon $ do - let componentsL = eltsVarEnv components +createHDL backend modName seen components domainConfs top topName = flip evalState backend $ getMon $ do + let componentsL = map snd (OMap.assocs components) (hdlNmDocs,incs) <- - unzip <$> mapM (\(_wereVoids,sp,ids,comp) -> - genHDL modName sp (HashMap.unionWith max seen ids) comp) - componentsL + fmap unzip $ + forM componentsL $ \(ComponentMeta{cmLoc, cmScope}, comp) -> + genHDL modName cmLoc (Id.union seen cmScope) comp + hwtys <- HashSet.toList <$> extractTypes <$> Mon get typesPkg <- mkTyPackage modName hwtys dataFiles <- Mon getDataFiles memFiles <- Mon getMemoryDataFiles - let hdl = map (first (<.> Clash.Backend.extension backend)) (typesPkg ++ hdlNmDocs) - qincs = concat incs - topFiles = hdl ++ qincs - manifest <- either return (\m -> do - let topInNames = map fst (inputs top) - topInTypes <- mapM (fmap (Text.toStrict . renderOneLine) . - hdlType (External topName) . snd) (inputs top) - let topOutNames = map (fst . (\(_,x,_) -> x)) (outputs top) - topOutTypes <- mapM (fmap (Text.toStrict . renderOneLine) . - hdlType (External topName) . snd . (\(_,x,_) -> x)) (outputs top) - let compNames = map (componentName . view _4) componentsL - return (m { portInNames = topInNames - , portInTypes = topInTypes - , portOutNames = topOutNames - , portOutTypes = topOutTypes - , componentNames = compNames - }) - ) manifestE - let manDoc = ( Data.Text.unpack topName <.> "manifest" - , pretty (Text.pack (show manifest))) - return (manDoc:topFiles,manifest,dataFiles,memFiles) + let + hdl = map (first (<.> Clash.Backend.extension backend)) (typesPkg ++ hdlNmDocs) + qincs = concat incs + topFiles = hdl ++ qincs --- | Prepares the directory for writing HDL files. This means creating the --- dir if it does not exist and removing all existing .hdl files from it. -prepareDir :: Bool -- ^ Remove existing HDL files - -> String -- ^ File extension of the HDL files. - -> String - -> IO () -prepareDir cleanhdl ext dir = do - -- Create the dir if needed - Directory.createDirectoryIfMissing True dir - -- Clean the directory when needed - when cleanhdl $ do - -- Find all HDL files in the directory - files <- Directory.getDirectoryContents dir - let to_remove = filter ((==ext) . FilePath.takeExtension) files - -- Prepend the dirname to the filenames - let abs_to_remove = map (FilePath.combine dir) to_remove - -- Remove the files - mapM_ Directory.removeFile abs_to_remove + topClks = findClocks top + sdcInfo = fmap findDomainConfig <$> topClks + sdcFile = Data.Text.unpack topName <.> "sdc" + sdcDoc = (sdcFile, pprSDC (SdcInfo sdcInfo)) + sdc = if null sdcInfo then Nothing else Just sdcDoc --- | Writes a HDL file to the given directory -writeHDL :: FilePath -> (String, Doc) -> IO () + return (maybeToList sdc <> topFiles, dataFiles, memFiles) + where + findDomainConfig dom = + HashMap.lookupDefault + (error $ $(curLoc) ++ "Unknown synthesis domain: " ++ show dom) + dom + domainConfs + +writeEdam :: + FilePath -> + (Id.Identifier, Unique) -> + HashMap Unique [Unique] -> + HashMap Unique [EdamFile] -> + [(FilePath, ByteString)] -> + IO (HashMap Unique [EdamFile], [(FilePath, ByteString)]) +writeEdam hdlDir (topNm, topEntity) deps edamFiles0 filesAndDigests = do + let + (edamFiles1, edamInfo) = + createEDAM (topNm, topEntity) deps edamFiles0 (map fst filesAndDigests) + edamDigest <- writeHDL hdlDir ("edam.py", pprEdam edamInfo) + pure (edamFiles1, ("edam.py", edamDigest) : filesAndDigests) + +-- | Create an Edalize metadata file for using Edalize to build the project. +-- +-- TODO: Handle libraries. Also see: https://github.com/olofk/edalize/issues/220 +createEDAM :: + -- Top entity name and unique + (Id.Identifier, Unique) -> + -- | Top entity dependency map + HashMap Unique [Unique] -> + -- | Edam files of each top entity + HashMap Unique [EdamFile] -> + -- | Files to include in Edam file + [FilePath] -> + -- | (updated map, edam) + (HashMap Unique [EdamFile], Edam) +createEDAM (topName, topUnique) deps edamFileMap files = + (HashMap.insert topUnique (edamFiles edam) edamFileMap, edam) + where + edam = Edam + { edamProjectName = Id.toText topName + , edamTopEntity = Id.toText topName + , edamFiles = fmap (asEdamFile topName) files <> fmap asIncFile incFiles + , edamToolOptions = def + } + + incFiles = + concatMap + (\u -> HashMap.lookupDefault [] u edamFileMap) + (HashMap.lookupDefault [] topUnique deps) + + asIncFile f = + f { efName = ".." Data.Text.unpack (efLogicalName f) efName f } + +asEdamFile :: Id.Identifier -> FilePath -> EdamFile +asEdamFile topName path = + EdamFile path edamFileType (Id.toText topName) + where + edamFileType = + case FilePath.takeExtension path of + ".vhdl" -> VhdlSource + ".v" -> VerilogSource + ".sv" -> SystemVerilogSource + ".tcl" -> TclSource + ".qsys" -> QSYS + ".sdc" -> SDC + _ -> Clash.Edalize.Edam.Unknown + +-- | Prepares directory for writing HDL files. +prepareDir :: + -- | HDL directory to prepare + FilePath -> + -- | Relevant options: @-fclash-no-clean@ + ClashOpts -> + -- | Did directory contain unexpected modifications? See 'readFreshManifest' + Maybe [UnexpectedModification] -> + IO () +prepareDir hdlDir ClashOpts{opt_clear} mods = do + ifM + (doesPathExist hdlDir) + (ifM + (doesDirectoryExist hdlDir) + (detectCaseIssues >> clearOrError >> createDir) + (error [I.i|Tried to write HDL files to #{hdlDir}, but it wasn't a directory.|])) + createDir + + where + createDir = createDirectoryIfMissing True hdlDir + + -- Windows considers 'foo' and 'FOO' the same directory. Error if users tries + -- to synthesize two top entities with conflicting (in this sense) names. + detectCaseIssues = do + allPaths <- listDirectory (takeDirectory hdlDir) + unless (takeFileName hdlDir `elem` allPaths) (error [I.i| + OS indicated #{hdlDir} existed, but Clash could not find it among the + list of existing directories in #{takeDirectory hdlDir}: + + #{allPaths} + + This probably means your OS or filesystem is case-insensitive. Rename your + top level binders in order to prevent this error message. + |]) + + clearOrError = + case mods of + Just [] -> + -- No unexpected changes, so no user work will get lost + removeDirectoryRecursive hdlDir + _ | opt_clear -> + -- Unexpected changes / non-empty directory, but @-fclash-clear@ was + -- set, so remove directory anyway. + removeDirectoryRecursive hdlDir + Just unexpected -> + -- Unexpected changes; i.e. modifications were made after last Clash run + error [I.i| + Changes were made to #{hdlDir} after last Clash run: + + #{pprintUnexpectedModifications 5 unexpected} + + Use '-fclash-clear' if you want Clash to clear out the directory. + Warning: this will remove the complete directory, be cautious of data + loss. + |] + Nothing -> + -- No manifest file was found. Refuse to write if directory isn't empty. + unlessM + (null <$> listDirectory hdlDir) + (error [I.i| + Tried to write HDL files to #{hdlDir}, but directory wasn't empty. This + message will be supressed if Clash can detect that no files have + changed since it was last run. If you're seeing this message even + though you haven't modified any files, Clash encountered a problem + reading "#{manifestFilename :: String}". This can happen when upgrading + Clash. + + Use '-fclash-clear' if you want Clash to clear out the directory. + Warning: this will remove the complete directory, be cautious of data + loss. + |]) + +-- | Write a file to disk in chunks. Returns SHA256 sum of file contents. +writeAndHash :: FilePath -> ByteStringLazy.ByteString -> IO ByteString +writeAndHash path bs = + IO.withFile path IO.WriteMode $ \handle -> + fmap Sha256.finalize + $ foldM (writeChunk handle) Sha256.init + $ ByteStringLazy.toChunks bs + where + writeChunk :: IO.Handle -> Sha256.Ctx -> ByteString -> IO Sha256.Ctx + writeChunk h !ctx chunk = do + ByteString.hPut h chunk + pure (Sha256.update ctx chunk) + +-- | Writes a HDL file to the given directory. Returns SHA256 hash of written +-- file. +writeHDL :: FilePath -> (FilePath, Doc) -> IO ByteString writeHDL dir (cname, hdl) = do - let rendered = renderLazy (layoutPretty (LayoutOptions (AvailablePerLine 120 0.4)) hdl) - -- remove blank lines to keep things clean - clean = Text.unlines - . map (\t -> if Text.all (==' ') t then Text.empty else t) - . Text.lines - bracket (IO.openFile (dir cname) IO.WriteMode) IO.hClose $ \h -> do - Text.hPutStr h (clean rendered) - Text.hPutStr h (Text.pack "\n") + let + layout = LayoutOptions (AvailablePerLine 120 0.4) + rendered0 = renderLazy (layoutPretty layout hdl) + rendered1 = Text.unlines (map Text.stripEnd (Text.lines rendered0)) + writeAndHash (dir cname) (Text.encodeUtf8 (rendered1 <> "\n")) -- | Copy given files writeMemoryDataFiles :: FilePath -- ^ Directory to copy files to - -> [(String, String)] + -> [(FilePath, String)] -- ^ (filename, content) - -> IO () + -> IO [ByteString] writeMemoryDataFiles dir files = - mapM_ - (uncurry writeFile) - [(dir fname, content) | (fname, content) <- files] + forM files $ \(fname, content) -> + writeAndHash (dir fname) (ByteStringLazyChar8.pack content) +-- | Copy data files added with ~FILEPATH copyDataFiles - :: [FilePath] - -> FilePath - -> [(String,FilePath)] - -> IO () -copyDataFiles idirs dir = mapM_ (copyFile' idirs) - where - copyFile' dirs (nm,old) = do - oldExists <- Directory.doesFileExist old - if oldExists - then Directory.copyFile old new - else goImports dirs - where - new = dir FilePath. nm + :: [FilePath] + -- ^ Import directories passed in with @-i@ + -> FilePath + -- ^ Directory to copy to + -> [(FilePath,FilePath)] + -- ^ [(name of newly made file in HDL output dir, file to copy)] + -> IO [ByteString] + -- ^ SHA256 hashes of written files +copyDataFiles idirs targetDir = mapM copyDataFile + where + copyDataFile :: (FilePath, FilePath) -> IO ByteString + copyDataFile (newName, toCopy) + | isAbsolute toCopy = do + ifM + (doesFileExist toCopy) + (copyAndHash toCopy (targetDir newName)) + (error [I.i|Could not find data file #{show toCopy}. Does it exist?|]) + | otherwise = do + let candidates = map ( toCopy) idirs + found <- filterM doesFileExist candidates + case found of + [] -> error [I.i| + Could not find data file #{show toCopy}. The following directories were + searched: - goImports [] = do - oldExists <- Directory.doesFileExist old - if oldExists - then Directory.copyFile old new - else unless (null old) (putStrLn ("WARNING: file " ++ show old ++ " does not exist")) - goImports (d:ds) = do - let old2 = d FilePath. old - old2Exists <- Directory.doesFileExist old2 - if old2Exists - then Directory.copyFile old2 new - else goImports ds + #{idirs} --- | Get all the terms corresponding to a call graph -callGraphBindings - :: BindingMap - -- ^ All bindings - -> Id - -- ^ Root of the call graph - -> [Term] -callGraphBindings bindingsMap tm = - map (bindingTerm . (bindingsMap `lookupUniqMap'`)) (keysUniqMap cg) - where - cg = callGraph bindingsMap tm + You can add directories Clash will look in using `-i`. + |] + (_:_:_) -> error [I.i| + Multiple data files for #{show toCopy} found. The following candidates + were found: + #{found} + + Please disambiguate data files. + |] + [c] -> + copyAndHash c (targetDir newName) + + copyAndHash src dst = do + ifM + (doesPathExist dst) + (error [I.i| + Tried to copy data file #{src} to #{dst} but a file or directory with + that name already existed. This is a bug in Clash, please report it. + |]) + (ByteStringLazy.readFile src >>= writeAndHash dst) + -- | Normalize a complete hierarchy normalizeEntity :: CustomReprs @@ -851,8 +968,8 @@ -> (CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))) -- ^ Hardcoded 'Type' -> 'HWType' translator - -> (PrimStep, PrimUnwind) - -- ^ Hardcoded evaluator (delta-reduction) + -> Evaluator + -- ^ Hardcoded evaluator for partial evaluation -> [Id] -- ^ TopEntities -> ClashOpts @@ -877,18 +994,18 @@ sortTop :: BindingMap -> [TopEntityT] - -> [TopEntityT] + -> ([TopEntityT], HashMap Unique [Unique]) sortTop bindingsMap topEntities = let (nodes,edges) = unzip (map go topEntities) - in case reverseTopSort nodes (concat edges) of + edges' = concat edges + in case reverseTopSort nodes edges' of Left msg -> error msg - Right tops -> tops + Right tops -> (tops, mapFrom edges') where - go t@(TopEntityT topE _ tbM) = + go t@(TopEntityT topE _ _) = let topRefs = goRefs topE topE - tbRefs = maybe [] (goRefs topE) tbM in ((varUniq topE,t) - ,map ((\top -> (varUniq topE, varUniq (topId top)))) (tbRefs ++ topRefs)) + ,map ((\top -> (varUniq topE, varUniq (topId top)))) topRefs) goRefs top i_ = let cg = callGraph bindingsMap i_ @@ -896,3 +1013,5 @@ filter (\t -> topId t /= top && topId t /= i_ && topId t `elemVarEnv` cg) topEntities + + mapFrom = HashMap.fromListWith mappend . fmap (fmap pure) diff --git a/src/Clash/Driver/Manifest.hs b/src/Clash/Driver/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Driver/Manifest.hs @@ -0,0 +1,457 @@ +{-| +Functions to read, write, and handle manifest files. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +module Clash.Driver.Manifest where + +import Control.Exception (tryJust) +import Control.Monad (guard, forM) +import Control.Monad.State (evalState) +import qualified Crypto.Hash.SHA256 as Sha256 +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson +import Data.Aeson + (ToJSON(toJSON), FromJSON(parseJSON), KeyValue ((.=)), (.:), (.:?)) +import Data.Aeson.Types (Parser) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Lazy as ByteStringLazy +import Data.ByteString (ByteString) +import Data.Hashable (hash) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe (catMaybes) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Encoding as LText +import Data.Text (Text) +import Data.Text.Prettyprint.Doc.Extra (renderOneLine) +import Data.Time (UTCTime) +import qualified Data.Set as Set +import Data.Semigroup.Monad (getMon) +import Data.String (IsString) +import System.IO.Error (isDoesNotExistError) +import System.FilePath (takeDirectory, ()) +import System.Directory (listDirectory, doesFileExist) +import Text.Read (readMaybe) + +import Clash.Annotations.TopEntity.Extra () +import Clash.Backend (Backend (hdlType), Usage (External)) +import Clash.Core.Name (nameOcc) +import Clash.Driver.Types +import Clash.Primitives.Types +import Clash.Core.Var (Id, varName) +import Clash.Netlist.Types + (TopEntityT, Component(..), HWType (Clock), hwTypeDomain) +import qualified Clash.Netlist.Types as Netlist +import qualified Clash.Netlist.Id as Id +import Clash.Netlist.Util (typeSize) +import Clash.Primitives.Util (hashCompiledPrimMap) +import Clash.Signal (VDomainConfiguration(..)) +import Clash.Util.Graph (callGraphBindings) + +#if MIN_VERSION_ghc(9,0,0) +import GHC.Utils.Misc (OverridingBool(..)) +#else +import Util (OverridingBool(..)) +#endif + +data ManifestPort = ManifestPort + { mpName :: Text + -- ^ Port name (as rendered in HDL) + , mpTypeName :: Text + -- ^ Type name (as rendered in HDL) + , mpWidth :: Int + -- ^ Port width in bits + , mpIsClock :: Bool + -- ^ Is this port a clock? + , mpDomain :: Maybe Text + -- ^ Domain this port belongs to. This is currently only included for clock, + -- reset, and enable ports. TODO: add to all ports originally defined as a + -- @Signal@ too. + } deriving (Show,Read,Eq) + +instance ToJSON ManifestPort where + toJSON (ManifestPort{..}) = + Aeson.object $ + [ "name" .= mpName + , "type_name" .= mpTypeName + , "width" .= mpWidth + , "is_clock" .= mpIsClock + ] <> + (case mpDomain of + Just dom -> ["domain" .= dom] + Nothing -> [] ) + +instance FromJSON ManifestPort where + parseJSON = Aeson.withObject "ManifestPort" $ \v -> + ManifestPort + <$> v .: "name" + <*> v .: "type_name" + <*> v .: "width" + <*> v .: "is_clock" + <*> v .:? "domain" + +-- | Information about the generated HDL between (sub)runs of the compiler +data Manifest + = Manifest + { manifestHash :: Int + -- ^ Hash of the TopEntity and all its dependencies. + -- + -- TODO: This is currently calculated using 'hash', but this function wasn't + -- really designed to give any performance (in the collision / crypto + -- sense) guarantees. We should switch to a proper hashing algo like + -- SHA256. + , successFlags :: (Int,Int,Bool) + -- ^ Compiler flags used to achieve successful compilation: + -- + -- * opt_inlineLimit + -- * opt_specLimit + -- * opt_floatSupport + , inPorts :: [ManifestPort] + , outPorts :: [ManifestPort] + , componentNames :: [Text] + -- ^ Names of all the generated components for the @TopEntity@ (does not + -- include the names of the components of the @TestBench@ accompanying + -- the @TopEntity@). + -- + -- This list is reverse topologically sorted. I.e., a component might depend + -- on any component listed before it, but not after it. + , topComponent :: Text + -- ^ Design entry point. This is usually the component annotated with a + -- @TopEntity@ annotation. + , fileNames :: [(FilePath, ByteString)] + -- ^ Names and hashes of all the generated files for the @TopEntity@. Hashes + -- are SHA256. + , domains :: HashMap Text VDomainConfiguration + -- ^ Domains encountered in design + , transitiveDependencies :: [Text] + -- ^ Dependencies of this design (fully qualified binder names). Is a + -- transitive closure of all dependencies. + } deriving (Show,Read,Eq) + +instance ToJSON Manifest where + toJSON (Manifest{..}) = + Aeson.object + [ "version" .= ("unstable" :: Text) + , "hash" .= manifestHash + , "flags" .= successFlags + -- TODO: add nested ports (i.e., how Clash split/filtered arguments) + , "components" .= componentNames + , "top_component" .= Aeson.object + [ "name" .= topComponent + , "ports_flat" .= Aeson.object + [ "in" .= inPorts + , "out" .= outPorts ] + ] + , "files" .= + [ Aeson.object + [ "name" .= fName + , "sha256" .= Text.decodeUtf8 (Base16.encode fHash) + -- TODO: Add Edam like fields + ] + | (fName, fHash) <- fileNames] + , "domains" .= HashMap.fromList + [ ( domNm + , Aeson.object + [ "period" .= vPeriod + , "active_edge" .= show vActiveEdge + , "reset_kind" .= show vResetKind + , "init_behavior" .= show vInitBehavior + , "reset_polarity" .= show vResetPolarity + ] + ) + | (domNm, VDomainConfiguration{..}) <- HashMap.toList domains ] + , "dependencies" .= Aeson.object + [ "transitive" .= transitiveDependencies ] + ] + +instance FromJSON Manifest where + parseJSON = Aeson.withObject "Manifest" $ \v -> + let + topComponent = v .: "top_component" + portsFlat = topComponent >>= (.: "ports_flat") + in + Manifest + <$> v .: "hash" + <*> v .: "flags" + <*> (portsFlat >>= (.: "in")) + <*> (portsFlat >>= (.: "out")) + <*> v .: "components" + <*> (topComponent >>= (.: "name")) + <*> do + files <- v .: "files" + forM files $ \obj -> do + fName <- obj .: "name" + sha256 <- obj .: "sha256" + -- Note that we don't particularly care about hash decode + -- failures. Realistically it shouldn't happen, and if it does + -- there's almost no chance it would result in accidental caching. +#if MIN_VERSION_base16_bytestring(1,0,0) + pure (fName, Base16.decodeLenient (Text.encodeUtf8 sha256)) +#else + pure (fName, fst (Base16.decode (Text.encodeUtf8 sha256))) +#endif + <*> (v .: "domains" >>= HashMap.traverseWithKey parseDomain) + <*> (v .: "dependencies" >>= (.: "transitive")) + where + parseDomain :: Text -> Aeson.Object -> Parser VDomainConfiguration + parseDomain nm v = + VDomainConfiguration + <$> pure (Text.unpack nm) + <*> (v .: "period") + <*> parseWithRead "active_edge" v + <*> parseWithRead "reset_kind" v + <*> parseWithRead "init_behavior" v + <*> parseWithRead "reset_polarity" v + + parseWithRead :: Read a => Text -> Aeson.Object -> Parser a + parseWithRead field obj = do + v <- obj .:? field + case readMaybe =<< v of + Just a -> pure a + Nothing -> fail $ "Could not read field: " <> Text.unpack field + +data UnexpectedModification + -- | Clash generated file was modified + = Modified FilePath + -- | Non-clash generated file was added + | Added FilePath + -- | Clash generated file was removed + | Removed FilePath + deriving (Show) + +mkManifestPort :: + Backend backend => + -- | Backend used to lookup port type names + backend -> + -- | Port name + Id.Identifier -> + -- | Port type + HWType -> + ManifestPort +mkManifestPort backend portId portType = ManifestPort{..} + where + mpName = Id.toText portId + mpWidth = typeSize portType + mpIsClock = case portType of {Clock _ -> True; _ -> False} + mpDomain = hwTypeDomain portType + mpTypeName = flip evalState backend $ getMon $ do + LText.toStrict . renderOneLine <$> hdlType (External mpName) portType + +-- | Filename manifest file should be written to and read from +manifestFilename :: IsString a => a +manifestFilename = "clash-manifest.json" + +mkManifest :: + Backend backend => + -- | Backend used to lookup port type names + backend -> + -- | Domains encountered in design + HashMap Text VDomainConfiguration -> + -- | Options Clash was run with + ClashOpts -> + -- | Component of top entity + Component -> + -- | All other entities + [Component] -> + -- | Names of dependencies (transitive closure) + [Id] -> + -- | Files and their hashes + [(FilePath, ByteString)] -> + -- | Hash returned by 'readFreshManifest' + Int -> + -- | New manifest + Manifest +mkManifest backend domains ClashOpts{..} Component{..} components deps files topHash = Manifest + { manifestHash = topHash + , inPorts = [mkManifestPort backend pName pType | (pName, pType) <- inputs] + , outPorts = [mkManifestPort backend pName pType | (_, (pName, pType), _) <- outputs] + , componentNames = map Id.toText compNames + , topComponent = Id.toText componentName + , fileNames = files + , successFlags = (opt_inlineLimit, opt_specLimit, opt_floatSupport) + , domains = domains + , transitiveDependencies = map (nameOcc . varName) deps + } + where + compNames = map Netlist.componentName components + +-- | Pretty print an unexpected modification as a list item. +pprintUnexpectedModification :: UnexpectedModification -> String +pprintUnexpectedModification = \case + Modified p -> "Unexpected modification in " <> p + Added p -> "Unexpected extra file " <> p + Removed p -> "Unexpected removed file " <> p + +-- | Pretty print a list of unexpected modifications. Print a maximum of /n/ +-- modifications. +pprintUnexpectedModifications :: Int -> [UnexpectedModification] -> String +pprintUnexpectedModifications 0 us = pprintUnexpectedModifications maxBound us +pprintUnexpectedModifications _ [] = [] +pprintUnexpectedModifications _ [u] = "* " <> pprintUnexpectedModification u +pprintUnexpectedModifications 1 (u:us) = + "* and " <> show (length (u:us)) <> " more unexpected changes" +pprintUnexpectedModifications n (u:us) = + "* " <> pprintUnexpectedModification u + <> "\n" <> pprintUnexpectedModifications (n-1) us + +-- | Reads a manifest file. Does not return manifest file if: +-- +-- * Caching is disabled through @-fclash-no-cache@. +-- * Manifest could not be found. +-- * Cache is stale. This could be triggered by any of the given arguments. +-- +-- Raises an exception if the manifest file or any of the files it is referring +-- to was inaccessible. +-- +readFreshManifest :: + -- | "This" top entity plus all that depend on it. + [TopEntityT] -> + -- | Core expressions and entry point. Any changes in the call graph will + -- trigger a recompile. + (BindingMap, Id) -> + -- | Any changes in any primitive will trigger a recompile. + CompiledPrimMap -> + -- | Certain options will trigger recompiles if changed + ClashOpts -> + -- | Clash modification date + UTCTime -> + -- | Path to manifest file. + FilePath -> + -- | ( Nothing if no manifest file was found + -- , Nothing on stale cache, disabled cache, or not manifest file found ) + IO (Maybe [UnexpectedModification], Maybe Manifest, Int) +readFreshManifest tops (bindingsMap, topId) primMap opts@(ClashOpts{..}) clashModDate path = do + manifestM <- readManifest path + modificationsM <- traverse (isUserModified path) manifestM + + pure + ( modificationsM + , checkManifest =<< if opt_cachehdl then manifestM else Nothing + , topHash + ) + + where + optsHash = hash opts { + -- Ignore the following settings, they don't affect the generated HDL: + + -- 1. Debug + opt_dbgLevel = DebugNone + , opt_dbgTransformations = Set.empty + , opt_dbgRewriteHistoryFile = Nothing + + -- 2. Caching + , opt_cachehdl = True + + -- 3. Warnings + , opt_primWarn = True + , opt_color = Auto + , opt_errorExtra = False + , opt_checkIDir = True + + -- 4. Optional output + , opt_edalize = False + + -- Ignore the following settings, they don't affect the generated HDL. However, + -- they do influence whether HDL can be generated at all. + -- + -- We therefore check whether the new flags changed in such a way that + -- they could affect successful compilation, and use that information + -- to decide whether to use caching or not (see: XXXX). + -- + -- 1. termination measures + , opt_inlineLimit = 20 + , opt_specLimit = 20 + + -- 2. Float support + , opt_floatSupport = False + + -- Finally, also ignore the HDL dir setting, because when a user moves the + -- entire dir with generated HDL, they probably still want to use that as + -- a cache + , opt_hdlDir = Nothing + } + + topHash = hash + ( tops + , hashCompiledPrimMap primMap + , show clashModDate + , callGraphBindings bindingsMap topId + , optsHash + ) + + checkManifest manifest@Manifest{manifestHash,successFlags} + | (cachedInline, cachedSpec, cachedFloat) <- successFlags + + -- Higher limits shouldn't affect HDL + , cachedInline <= opt_inlineLimit + , cachedSpec <= opt_specLimit + + -- /Enabling/ float support should compile more designs. Of course, keeping + -- the same value for float support shouldn't invalidate caches either. + , ((cachedFloat && not opt_floatSupport) || (cachedFloat == opt_floatSupport)) + + -- Callgraph hashes should correspond + , manifestHash == topHash + = Just manifest + + -- One or more checks failed + | otherwise = Nothing + +-- | Determines whether the HDL directory the given 'LocatedManifest' was found +-- in contains any user made modifications. This is used by Clash to protect the +-- user against lost work. +isUserModified :: FilePath -> Manifest -> IO [UnexpectedModification] +isUserModified (takeDirectory -> topDir) Manifest{fileNames} = do + let + manifestFiles = Set.fromList (map fst fileNames) + + currentFiles <- (Set.delete manifestFilename . Set.fromList) <$> listDirectory topDir + + let + removedFiles = Set.toList (manifestFiles `Set.difference` currentFiles) + addedFiles = Set.toList (currentFiles `Set.difference` manifestFiles) + + changedFiles <- catMaybes <$> mapM detectModification fileNames + + pure + ( map Removed removedFiles + <> map Added addedFiles + <> map Modified changedFiles ) + where + detectModification :: (FilePath, ByteString) -> IO (Maybe FilePath) + detectModification (filename, manifestDigest) = do + let fullPath = topDir filename + fileExists <- doesFileExist fullPath + if fileExists then do + contents <- ByteStringLazy.readFile fullPath + if manifestDigest == Sha256.hashlazy contents + then pure Nothing + else pure (Just filename) + else + -- Will be caught by @removedFiles@ + pure Nothing + +-- | Read a manifest file from disk. Returns 'Nothing' if file does not exist. +-- Any other IO exception is re-raised. +readManifest :: FilePath -> IO (Maybe Manifest) +readManifest path = do + contentsE <- tryJust (guard . isDoesNotExistError) (Aeson.decodeFileStrict path) + pure (either (const Nothing) id contentsE) + +-- | Write manifest file to disk +writeManifest :: FilePath -> Manifest -> IO () +writeManifest path = ByteStringLazy.writeFile path . Aeson.encodePretty + +-- | Serialize a manifest. +-- +-- TODO: This should really yield a 'ByteString'. +serializeManifest :: Manifest -> Text +serializeManifest = LText.toStrict . LText.decodeUtf8 . Aeson.encodePretty diff --git a/src/Clash/Driver/Types.hs b/src/Clash/Driver/Types.hs --- a/src/Clash/Driver/Types.hs +++ b/src/Clash/Driver/Types.hs @@ -2,8 +2,9 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , QBayLogic, Google Inc. + 2020 , QBayLogic License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. Type definitions used by the Driver module -} @@ -11,6 +12,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Clash.Driver.Types where @@ -20,34 +22,61 @@ import Control.DeepSeq (NFData) import Data.Binary (Binary) +import Data.Fixed import Data.Hashable import qualified Data.Set as Set import Data.Text (Text) +import Data.Text.Prettyprint.Doc import GHC.Generics (Generic) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Basic (InlineSpec) +import GHC.Types.SrcLoc (SrcSpan) +import GHC.Utils.Misc (OverridingBool(..)) +#else import BasicTypes (InlineSpec) import SrcLoc (SrcSpan) import Util (OverridingBool(..)) +#endif +import Clash.Signal.Internal + import Clash.Core.Term (Term) import Clash.Core.Var (Id) import Clash.Core.VarEnv (VarEnv) import Clash.Netlist.BlackBox.Types (HdlSyn (..)) +import {-# SOURCE #-} Clash.Netlist.Types (PreserveCase(..)) +data IsPrim + = IsPrim + -- ^ The binding is the unfolding for a primitive. + | IsFun + -- ^ The binding is an ordinary function. + deriving (Binary, Eq, Generic, NFData, Show) -- A function binder in the global environment. -- -data Binding = Binding +data Binding a = Binding { bindingId :: Id + -- ^ The core identifier for this binding. , bindingLoc :: SrcSpan + -- ^ The source location of this binding in the original source code. , bindingSpec :: InlineSpec - , bindingTerm :: Term - } deriving (Binary, Generic, NFData, Show) + -- ^ the inline specification for this binding, in the original source code. + , bindingIsPrim :: IsPrim + -- ^ Is the binding a core term corresponding to a primitive with a known + -- implementation? If so, it can potentially be inlined despite being + -- marked as NOINLINE in source. + , bindingTerm :: a + -- ^ The term representation for this binding. This is polymorphic so + -- alternate representations can be used if more appropriate (i.e. in the + -- evaluator this can be Value for evaluated bindings). + } deriving (Binary, Functor, Generic, NFData, Show) -- | Global function binders -- -- Global functions cannot be mutually recursive, only self-recursive. -type BindingMap = VarEnv Binding +type BindingMap = VarEnv (Binding Term) -- | Debug Message Verbosity data DebugLevel @@ -67,61 +96,131 @@ -- ^ Show all sub-expressions on which a rewrite is attempted deriving (Eq,Ord,Read,Enum,Generic,Hashable) -data ClashOpts = ClashOpts { opt_inlineLimit :: Int - , opt_specLimit :: Int - , opt_inlineFunctionLimit :: Word - , opt_inlineConstantLimit :: Word - , opt_dbgLevel :: DebugLevel - , opt_dbgTransformations :: Set.Set String - , opt_dbgTransformationsFrom :: Int - -- ^ Only output debug information from (applied) - -- transformation n - , opt_dbgTransformationsLimit :: Int - -- ^ Only output debug information for n (applied) - -- transformations. If this limit is exceeded, Clash - -- will stop normalizing. - , opt_cachehdl :: Bool - , opt_cleanhdl :: Bool - , opt_primWarn :: Bool - , opt_color :: OverridingBool - , opt_intWidth :: Int - , opt_hdlDir :: Maybe String - -- ^ Directory to store temporary files in. Will be - -- cleaned after Clash has finished executing. - , opt_hdlSyn :: HdlSyn - , opt_errorExtra :: Bool - , opt_floatSupport :: Bool - , opt_importPaths :: [FilePath] - , opt_componentPrefix :: Maybe String - , opt_newInlineStrat :: Bool - , opt_escapedIds :: Bool - , opt_ultra :: Bool - -- ^ Perform a high-effort compile, trading improved - -- performance for potentially much longer compile - -- times. - -- - -- Name inspired by Design Compiler's /compile_ultra/ - -- flag. - , opt_forceUndefined :: Maybe (Maybe Int) - -- ^ - -- * /Nothing/: generate undefined's in the HDL - -- - -- * /Just Nothing/: replace undefined's by a - -- constant in the HDL; the compiler decides what's - -- best - -- - -- * /Just (Just x)/: replace undefined's by /x/ in - -- the HDL - , opt_checkIDir :: Bool - , opt_aggressiveXOpt :: Bool - -- ^ Enable aggressive X optimization, which may - -- remove undefineds from generated HDL by replaced - -- with defined alternatives. - , opt_inlineWFCacheLimit :: Word - -- ^ At what size do we cache normalized work-free - -- top-level binders. - } +-- | Options passed to Clash compiler +data ClashOpts = ClashOpts + { 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. + -- + -- Command line flag: -fclash-inline-limit + , opt_specLimit :: Int + -- ^ Change the number of times a function can undergo specialization. + -- + -- Command line flag: -fclash-spec-limit + , opt_inlineFunctionLimit :: Word + -- ^ Set the threshold for function size. Below this threshold functions are + -- always inlined (if it is not recursive). + -- + -- Command line flag: -fclash-inline-function-limit + , opt_inlineConstantLimit :: Word + -- ^ Set the threshold for constant size. Below this threshold constants are + -- always inlined. A value of 0 inlines all constants. + -- + -- Command line flag: -fclash-inline-constant-limit + , opt_evaluatorFuelLimit :: Word + -- ^ Set the threshold for maximum unfolding depth in the evaluator. A value + -- of zero means no potentially non-terminating binding is unfolded. + -- + -- Command line flag: -fclash-evaluator-fuel-limit + , opt_dbgLevel :: DebugLevel + -- ^ Set the debugging mode for the compiler, exposing additional output. See + -- "DebugLevel" for the available options. + -- + -- Command line flag: -fclash-debug + , opt_dbgTransformations :: Set.Set String + -- ^ List the transformations that are to be debugged. + -- + -- Command line flag: -fclash-debug-transformations + , opt_dbgTransformationsFrom :: Int + -- ^ Only output debug information from (applied) transformation n + -- + -- Command line flag: -fclash-debug-transformations-from + , opt_dbgTransformationsLimit :: Int + -- ^ Only output debug information for n (applied) transformations. If this + -- limit is exceeded, Clash will stop normalizing. + -- + -- Command line flag: -fclash-debug-transformations-limit + , opt_dbgRewriteHistoryFile :: Maybe FilePath + -- ^ Save all applied rewrites to a file + -- + -- Command line flag: -fclash-debug-history + + , opt_cachehdl :: Bool + -- ^ Reuse previously generated output from Clash. Only caches topentities. + -- + -- Command line flag: -fclash-no-cache + , opt_clear :: Bool + -- ^ Remove HDL directories before writing to them. By default, Clash will + -- only write to non-empty directories if it can prove all files in it are + -- generated by a previous run. This option applies to directories of the + -- various top entities, i.e., the subdirectories made in the directory passed + -- in with @-fclash-hdldir@. Note that Clash will still use a cache if it can. + -- + -- Command line flag: @-fclash-clear@ + , opt_primWarn :: Bool + -- ^ Disable warnings for primitives + -- + -- Command line flag: -fclash-no-prim-warn + , opt_color :: OverridingBool + -- ^ Show colors in debug output + -- + -- Command line flag: -fclash-no-prim-warn + , opt_intWidth :: Int + -- ^ Set the bit width for the Int/Word/Integer types. The only allowed values + -- are 32 or 64. + , opt_hdlDir :: Maybe String + -- ^ Directory to save HDL files to + , opt_hdlSyn :: HdlSyn + -- ^ Synthesis target. See "HdlSyn" for available options. + , opt_errorExtra :: Bool + -- ^ Show additional information in error messages + , opt_floatSupport :: Bool + -- ^ Treat floats as a BitVector. Note that operations on floating are still + -- not supported, use vendor primitives instead. + , opt_importPaths :: [FilePath] + -- ^ Paths where Clash should look for modules + , opt_componentPrefix :: Maybe Text + -- ^ Prefix components with given string + , opt_newInlineStrat :: Bool + -- ^ Use new inline strategy. Functions marked NOINLINE will get their own + -- HDL module. + , opt_escapedIds :: Bool + -- ^ Use escaped identifiers in HDL. See: + -- + -- * http://vhdl.renerta.com/mobile/source/vhd00037.htm + -- * http://verilog.renerta.com/source/vrg00018.htm + , opt_lowerCaseBasicIds :: PreserveCase + -- ^ Force all generated basic identifiers to lowercase. Among others, this + -- affects module and file names. + , opt_ultra :: Bool + -- ^ Perform a high-effort compile, trading improved performance for + -- potentially much longer compile times. + -- + -- Name inspired by Design Compiler's /compile_ultra/ flag. + , opt_forceUndefined :: Maybe (Maybe Int) + -- ^ + -- * /Nothing/: generate undefined's in the HDL + -- + -- * /Just Nothing/: replace undefined's by a constant in the HDL; the + -- compiler decides what's best + -- + -- * /Just (Just x)/: replace undefined's by /x/ in the HDL + , opt_checkIDir :: Bool + -- ^ Check whether paths specified in 'opt_importPaths' exists on the + -- filesystem. + , opt_aggressiveXOpt :: Bool + -- ^ Enable aggressive X optimization, which may remove undefineds from + -- generated HDL by replaced with defined alternatives. + , opt_aggressiveXOptBB :: Bool + -- ^ Enable aggressive X optimization, which may remove undefineds from + -- HDL generated by blackboxes. This enables the ~ISUNDEFINED template tag. + , opt_inlineWFCacheLimit :: Word + -- ^ At what size do we cache normalized work-free top-level binders. + , opt_edalize :: Bool + -- ^ Generate an EDAM file for use with Edalize. + } + instance Hashable ClashOpts where hashWithSalt s ClashOpts {..} = s `hashWithSalt` @@ -129,14 +228,15 @@ opt_specLimit `hashWithSalt` opt_inlineFunctionLimit `hashWithSalt` opt_inlineConstantLimit `hashWithSalt` + opt_evaluatorFuelLimit `hashWithSalt` opt_dbgLevel `hashSet` opt_dbgTransformations `hashWithSalt` opt_dbgTransformationsFrom `hashWithSalt` opt_dbgTransformationsLimit `hashWithSalt` + opt_dbgRewriteHistoryFile `hashWithSalt` opt_cachehdl `hashWithSalt` - opt_cleanhdl `hashWithSalt` - opt_primWarn `hashWithSalt` - opt_cleanhdl `hashOverridingBool` + opt_clear `hashWithSalt` + opt_primWarn `hashOverridingBool` opt_color `hashWithSalt` opt_intWidth `hashWithSalt` opt_hdlDir `hashWithSalt` @@ -147,11 +247,14 @@ opt_componentPrefix `hashWithSalt` opt_newInlineStrat `hashWithSalt` opt_escapedIds `hashWithSalt` + opt_lowerCaseBasicIds `hashWithSalt` opt_ultra `hashWithSalt` opt_forceUndefined `hashWithSalt` opt_checkIDir `hashWithSalt` opt_aggressiveXOpt `hashWithSalt` - opt_inlineWFCacheLimit + opt_aggressiveXOptBB `hashWithSalt` + opt_inlineWFCacheLimit `hashWithSalt` + opt_edalize where hashOverridingBool :: Int -> OverridingBool -> Int hashOverridingBool s1 Auto = hashWithSalt s1 (0 :: Int) @@ -167,6 +270,7 @@ defClashOpts = ClashOpts { opt_dbgLevel = DebugNone + , opt_dbgRewriteHistoryFile = Nothing , opt_dbgTransformations = Set.empty , opt_dbgTransformationsFrom = 0 , opt_dbgTransformationsLimit = maxBound @@ -174,8 +278,9 @@ , opt_specLimit = 20 , opt_inlineFunctionLimit = 15 , opt_inlineConstantLimit = 0 + , opt_evaluatorFuelLimit = 20 , opt_cachehdl = True - , opt_cleanhdl = True + , opt_clear = False , opt_primWarn = True , opt_color = Auto , opt_intWidth = WORD_SIZE_IN_BITS @@ -187,40 +292,40 @@ , opt_componentPrefix = Nothing , opt_newInlineStrat = True , opt_escapedIds = True + , opt_lowerCaseBasicIds = PreserveCase , opt_ultra = False , opt_forceUndefined = Nothing , opt_checkIDir = True , opt_aggressiveXOpt = False + , opt_aggressiveXOptBB = False , opt_inlineWFCacheLimit = 10 -- TODO: find "optimal" value + , opt_edalize = False } --- | Information about the generated HDL between (sub)runs of the compiler -data Manifest - = Manifest - { manifestHash :: (Int,Maybe Int) - -- ^ Hash of the TopEntity and all its dependencies - -- + (maybe) Hash of the TestBench and all its dependencies - , successFlags :: (Int,Int,Bool) - -- ^ Compiler flags used to achieve successful compilation: - -- - -- * opt_inlineLimit - -- * opt_specLimit - -- * opt_floatSupport - , portInNames :: [Text] - , portInTypes :: [Text] - -- ^ The rendered versions of the types of the input ports of the TopEntity - -- - -- Used when dealing with multiple @TopEntity@s who have different names - -- for types which are structurally equal - , portOutNames :: [Text] - , portOutTypes :: [Text] - -- ^ The rendered versions of the types of the output ports of the TopEntity - -- - -- Used when dealing with multiple @TopEntity@s who have different names - -- for types which are structurally equal - , componentNames :: [Text] - -- ^ Names of all the generated components for the @TopEntity@ (does not - -- include the names of the components of the @TestBench@ accompanying - -- the @TopEntity@). +-- | Synopsys Design Constraint (SDC) information for a component. +-- Currently this limited to the names and periods of clocks for create_clock. +-- +newtype SdcInfo = SdcInfo + { sdcClock :: [(Text, VDomainConfiguration)] } - deriving (Show,Read) + +-- | Render an SDC file from an SdcInfo. +-- The clock periods, waveforms, and targets are all hardcoded. +-- +pprSDC :: SdcInfo -> Doc () +pprSDC = vcat . fmap go . sdcClock + where + go (i, dom) = + -- VDomainConfiguration stores period in ps, SDC expects it in ns. + let p = MkFixed (toInteger $ vPeriod dom) :: Fixed E3 + name = braces (pretty i) + period = viaShow p + waveform = braces ("0.000" <+> viaShow (p / 2)) + targets = brackets ("get_ports" <+> name) + in hsep + [ "create_clock" + , "-name" <+> name + , "-period" <+> period + , "-waveform" <+> waveform + , targets + ] diff --git a/src/Clash/Edalize/Edam.hs b/src/Clash/Edalize/Edam.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Edalize/Edam.hs @@ -0,0 +1,319 @@ +{-| +Copyright : (C) 2020, QBayLogic +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +Data types and rendering for Edalize Metadata files (EDAM). +-} + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Clash.Edalize.Edam + ( Edam(..) + , EdamFile(..) + , EdamFileType(..) + , EdamTools(..) + , GhdlOptions(..) + , IcarusOptions(..) + , ModelsimOptions(..) + , QuartusOptions(..) + , VivadoOptions(..) + + , pprEdam + ) where + +import Data.Default +import Data.Maybe +import Data.Text (Text) +import Data.Text.Prettyprint.Doc + +-- | EDAM data structure to be given to an Edalize backend. This contains all +-- information needed to generate a project scaffolding. Note that hooks and +-- VPI modules are currently not specified by clash. +-- +data Edam = Edam + { edamProjectName :: Text + , edamTopEntity :: Text + , edamFiles :: [EdamFile] + , edamToolOptions :: EdamTools + } + +pprEdam :: Edam -> Doc ann +pprEdam (Edam n te fs ts) = vsep + [ pyPre + , hsep ["edam", equals, manifest] + , pyPost + ] + where + manifest = pyRecord + [ pyField "name" $ squotes (pretty n) + , pyField "toplevel" $ squotes (pretty te) + , pyField "files" $ pyList (fmap pprFile fs) + , pyField "tool_options" $ pprEdamTools ts + ] + +-- | Information about each file in the project. This does not include +-- is_include_file or include_path, as these are not currently used by Clash. +-- +data EdamFile = EdamFile + { efName :: FilePath + , efType :: EdamFileType + , efLogicalName :: Text + } + +pprFile :: EdamFile -> Doc ann +pprFile (EdamFile n ty ln) = + pyRecord + [ pyField "name" $ joinPath n + , pyField "file_type" $ squotes (pprFileType ty) + , pyField "logical_name" $ squotes (pretty ln) + ] + +-- | A subset of the file types recognized by Edalize. The supported formats +-- are largely from IP-XACT 2014 (IEEE 1685-2014), although Edalize extends +-- this with other types, e.g. QSYS. +-- +-- Only file types which are generated by Clash are listed. +-- +data EdamFileType + = Unknown + -- ^ Unknown file type. + | VhdlSource + -- ^ VHDL source. + | VerilogSource + -- ^ Verilog source. + | SystemVerilogSource + -- ^ SystemVerilog source. + | TclSource + -- ^ Tool Command Language source. + | QSYS + -- ^ QSys system source. + | SDC + -- ^ Synopsys Design Constraints source. + deriving (Eq, Show) + +pprFileType :: EdamFileType -> Doc ann +pprFileType = \case + Unknown -> "unknown" + VhdlSource -> "vhdlSource" + VerilogSource -> "verilogSource" + SystemVerilogSource -> "systemVerilogSource" + TclSource -> "tclSource" + QSYS -> "QSYS" + SDC -> "SDC" + +-- | Tool-specific configuration used by Edalize. +-- Currently only tools which are supported by Clash are provided. +-- +data EdamTools = EdamTools + { etGhdl :: Maybe GhdlOptions + , etIcarus :: Maybe IcarusOptions + , etModelsim :: Maybe ModelsimOptions + , etQuartus :: Maybe QuartusOptions + , etVivado :: Maybe VivadoOptions + } + +instance Default EdamTools where + def = EdamTools def def def def def + +pprEdamTools :: EdamTools -> Doc ann +pprEdamTools tools = + pyRecord + [ pyField "ghdl" $ pprGhdlOptions ghdl + , pyField "icarus" $ pprIcarusOptions icarus + , pyField "modelsim" $ pprModelsimOptions modelsim + , pyDocField + "quartus" + "TODO Specify options if using Quartus" + (pprQuartusOptions quartus) + + , pyDocField + "vivado" + "TODO Specify options if using Vivado" + (pprVivadoOptions vivado) + ] + where + ghdl = fromMaybe def (etGhdl tools) + icarus = fromMaybe def (etIcarus tools) + modelsim = fromMaybe def (etModelsim tools) + quartus = fromMaybe def (etQuartus tools) + vivado = fromMaybe def (etVivado tools) + +data GhdlOptions = GhdlOptions + { ghdlAnalyseOpts :: [Text] + , ghdlRunOpts :: [Text] + } + +instance Default GhdlOptions where + def = GhdlOptions [] [] + +pprGhdlOptions :: GhdlOptions -> Doc ann +pprGhdlOptions (GhdlOptions aOpts rOpts) = + pyRecord + [ pyDocField + "analyze_options" + "Command line arguments for analysis" + (flagList (fmap pretty aOpts)) + + , pyDocField + "run_options" + "Command line arguments for simulation" + (flagList (fmap pretty rOpts)) + ] + +data IcarusOptions = IcarusOptions + { icarusOpts :: [Text] + , icarusTimeScale :: Text + } + +instance Default IcarusOptions where + def = IcarusOptions [] "100fs/100fs" + +pprIcarusOptions :: IcarusOptions -> Doc ann +pprIcarusOptions (IcarusOptions opts ts) = + pyRecord + [ pyDocField + "iverilog_options" + "Command line options for iverilog" + (flagList (fmap pretty opts)) + + , pyDocField + "timescale" + "Default timescale for simulation" + (squotes (pretty ts)) + ] + +data ModelsimOptions = ModelsimOptions + { msVlogOpts :: [Text] + , msVsimOpts :: [Text] + } + +instance Default ModelsimOptions where + def = ModelsimOptions [] [] + +pprModelsimOptions :: ModelsimOptions -> Doc ann +pprModelsimOptions (ModelsimOptions vlog vsim) = + pyRecord + [ pyDocField + "vlog_options" + "Command line arguments for vlog" + (flagList (fmap pretty vlog)) + + , pyDocField + "vsim_options" + "Command line arguments for vsim" + (flagList (fmap pretty vsim)) + ] + +data QuartusOptions = QuartusOptions + { quartusBoardDevIndex :: Int + , quartusFamily :: Text + , quartusDevice :: Text + , quartusOpts :: [Text] + , quartusDseOpts :: [Text] + } + +instance Default QuartusOptions where + def = QuartusOptions 1 "" "" [] [] + +pprQuartusOptions :: QuartusOptions -> Doc ann +pprQuartusOptions (QuartusOptions bdi fam dev opts dse) = + pyRecord + [ pyDocField + "board_device_index" + "Specify the FPGA's device number in the JTAG chain" + (squotes (pretty bdi)) + + , pyDocField + "family" + "FPGA family, e.g. Cyclone IV E" + (squotes (pretty fam)) + + , pyDocField + "device" + "Device identifier, e.g. EP4CE55F23C8" + (squotes (pretty dev)) + + , pyDocField + "quartus_options" + "Command line arguments for Quartus" + (flagList (fmap pretty opts)) + + , pyDocField + "dse_options" + "Command line arguments for Design Space Explorer" + (flagList (fmap pretty dse)) + ] + +data VivadoOptions = VivadoOptions + { vivadoPart :: Text + } + +instance Default VivadoOptions where + def = VivadoOptions "" + +pprVivadoOptions :: VivadoOptions -> Doc ann +pprVivadoOptions (VivadoOptions part) = + pyRecord + [ pyDocField + "part" + "Specify target part by ID, e.g. xc7z020-1clg400c" + (squotes (pretty part)) + ] + +-- Helpers; don't export + +pyPre :: Doc ann +pyPre = vsep + [ "import os" + , "" + , "edam_root = os.path.dirname(os.path.realpath(__file__))" + , "work_root = 'build'" + , "" + , "# TODO Specify the EDA tool to use" + , "tool = ''" + , "" + ] + +pyPost :: Doc ann +pyPost = vsep + [ "" + , "if __name__ == '__main__':" + , indent 4 $ vsep + [ "from edalize import *" + , "" + , "tool = get_edatool(tool)(edam=edam, work_root=work_root)" + , "os.makedirs(work_root)" + , "tool.configure()" + , "tool.build()" + ] + ] + +pyList :: [Doc ann] -> Doc ann +pyList xs = vsep [lbracket, indent 4 (commaList xs), rbracket] + +pyRecord :: [Doc ann] -> Doc ann +pyRecord xs = vsep [lbrace, indent 4 (commaList xs), rbrace] + +pyComment :: Text -> Doc ann +pyComment x = hsep ["#", pretty x] + +pyField :: Text -> Doc ann -> Doc ann +pyField n x = hcat [squotes (pretty n), colon, space, x] + +pyDocField :: Text -> Text -> Doc ann -> Doc ann +pyDocField n d x = vsep [pyComment d, pyField n x] + +joinPath :: FilePath -> Doc ann +joinPath x = hcat + [ "os.path.join" + , parens (hsep $ punctuate comma ["edam_root", squotes (pretty x)]) + ] + +flagList :: [Doc ann] -> Doc ann +flagList = squotes . hsep + +commaList :: [Doc ann] -> Doc ann +commaList = vsep . punctuate comma + diff --git a/src/Clash/Netlist.hs b/src/Clash/Netlist.hs --- a/src/Clash/Netlist.hs +++ b/src/Clash/Netlist.hs @@ -8,6 +8,7 @@ Create Netlists out of normalized CoreHW Terms -} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiWayIf #-} @@ -20,48 +21,54 @@ module Clash.Netlist where import Control.Exception (throw) -import Control.Lens ((.=)) +import Control.Lens ((.=), (<~)) import qualified Control.Lens as Lens -import Control.Monad (join) -import Control.Monad.IO.Class (liftIO) +import Control.Monad.Extra (concatMapM) import Control.Monad.Reader (runReaderT) -import Control.Monad.State.Strict (State, runStateT) +import Control.Monad.State.Strict (State, runStateT, runState) import Data.Binary.IEEE754 (floatToWord, doubleToWord) import Data.Char (ord) import Data.Either (partitionEithers, rights) -import Data.HashMap.Strict (HashMap) +import Data.Foldable (foldlM) import qualified Data.HashMap.Strict as HashMapS import qualified Data.HashMap.Lazy as HashMap import Data.List (elemIndex, partition, sortOn) import Data.List.Extra (zipEqual) import Data.Maybe - (catMaybes, listToMaybe, mapMaybe, fromMaybe) + (listToMaybe, mapMaybe, fromMaybe) +import qualified Data.Map.Ordered as OMap import qualified Data.Set as Set import Data.Primitive.ByteArray (ByteArray (..)) import qualified Data.Text as StrictText -import qualified Data.Vector.Primitive as PV +#if MIN_VERSION_base(4,15,0) +import GHC.Num.Integer (Integer (..)) +#else import GHC.Integer.GMP.Internals (Integer (..), BigNat (..)) -import System.FilePath ((), (<.>)) -import Text.Read (readMaybe) +#endif +#if MIN_VERSION_ghc(9,0,0) +import GHC.Utils.Outputable (ppr, showSDocUnsafe) +import GHC.Types.SrcLoc (isGoodSrcSpan) +#else import Outputable (ppr, showSDocUnsafe) import SrcLoc (isGoodSrcSpan) +#endif -import Clash.Annotations.Primitive (extractPrim) +import Clash.Annotations.Primitive (extractPrim, HDL) import Clash.Annotations.BitRepresentation.ClashLib (coreToType') import Clash.Annotations.BitRepresentation.Internal (CustomReprs, DataRepr'(..), ConstrRepr'(..), getDataRepr, getConstrRepr) -import Clash.Annotations.TopEntity (TopEntity (..)) import Clash.Core.DataCon (DataCon (..)) import Clash.Core.Literal (Literal (..)) import Clash.Core.Name (Name(..)) import Clash.Core.Pretty (showPpr) import Clash.Core.Term - ( Alt, Pat (..), Term (..), TickInfo (..), PrimInfo(primName), collectArgs - , collectArgsTicks, collectTicks, mkApps, mkTicks, stripTicks) + (IsMultiPrim (..), PrimInfo (..), mpi_resultTypes, Alt, Pat (..), Term (..), + TickInfo (..), collectArgs, collectArgsTicks, + collectTicks, mkApps, mkTicks, stripTicks) import qualified Clash.Core.Term as Core -import Clash.Core.TermInfo (termType) +import Clash.Core.TermInfo (multiPrimInfo', splitMultiPrimArgs, termType) import Clash.Core.Type (Type (..), coreView1, splitFunForallTy, splitCoreFunForallTy) import Clash.Core.TyCon (TyConMap) @@ -69,10 +76,10 @@ import Clash.Core.Var (Id, Var (..), isGlobalId) import Clash.Core.VarEnv (VarEnv, emptyInScopeSet, emptyVarEnv, extendVarEnv, lookupVarEnv, - lookupVarEnv', mkVarEnv) + lookupVarEnv') import Clash.Driver.Types (BindingMap, Binding(..), ClashOpts (..)) import Clash.Netlist.BlackBox -import Clash.Netlist.Id +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types as HW import Clash.Netlist.Util import Clash.Primitives.Types as P @@ -90,8 +97,10 @@ -- ^ Custom bit representations for certain types -> BindingMap -- ^ Global binders - -> [TopEntityT] - -- ^ All the TopEntities + -> VarEnv TopEntityT + -- ^ TopEntity annotations + -> VarEnv Identifier + -- ^ Top entity names -> CompiledPrimMap -- ^ Primitive definitions -> TyConMap @@ -101,33 +110,27 @@ -- ^ Hardcoded Type -> HWType translator -> Int -- ^ Int/Word/Integer bit-width - -> (IdType -> Identifier -> Identifier) - -- ^ valid identifiers - -> (IdType -> Identifier -> Identifier -> Identifier) - -- ^ extend valid identifiers -> Bool -- ^ Whether the backend supports ifThenElse expressions -> SomeBackend -- ^ The current HDL backend - -> HashMap Identifier Word + -> IdentifierSet -- ^ Seen components -> FilePath -- ^ HDL dir - -> ComponentPrefix + -> Maybe StrictText.Text -- ^ Component name prefix -> Id -- ^ Name of the @topEntity@ - -> IO (VarEnv ([Bool],SrcSpan,HashMap Identifier Word,Component),HashMap Identifier Word) -genNetlist isTb opts reprs globals tops primMap tcm typeTrans iw mkId extId ite be seen env prefixM topEntity = do - (_,s) <- runNetlistMonad isTb opts reprs globals topEntityMap - primMap tcm typeTrans iw mkId extId ite be seen env prefixM $ - genComponent topEntity - return ( _components s - , _seenComps s - ) - where - topEntityMap :: VarEnv TopEntityT - topEntityMap = mkVarEnv (zip (map topId tops) tops) + -> IO (Component, ComponentMap, IdentifierSet) +genNetlist isTb opts reprs globals tops topNames primMap tcm typeTrans iw ite be seen0 env prefixM topEntity = do + ((_meta, topComponent), s) <- + runNetlistMonad isTb opts reprs globals tops primMap tcm typeTrans + iw ite be seen1 env componentNames_ $ genComponent topEntity + return (topComponent, _components s, seen1) + where + (componentNames_, seen1) = + genNames (opt_newInlineStrat opts) prefixM seen0 topNames globals -- | Run a NetlistMonad action in a given environment runNetlistMonad @@ -150,58 +153,109 @@ -- ^ Hardcode Type -> HWType translator -> Int -- ^ Int/Word/Integer bit-width - -> (IdType -> Identifier -> Identifier) - -- ^ valid identifiers - -> (IdType -> Identifier -> Identifier -> Identifier) - -- ^ extend valid identifiers -> Bool -- ^ Whether the backend supports ifThenElse expressions -> SomeBackend -- ^ The current HDL backend - -> HashMap Identifier Word + -> IdentifierSet -- ^ Seen components -> FilePath -- ^ HDL dir - -> ComponentPrefix - -- ^ Component name prefix + -> VarEnv Identifier + -- ^ Seen components -> NetlistMonad a -- ^ Action to run -> IO (a, NetlistState) -runNetlistMonad isTb opts reprs s tops p tcm typeTrans iw mkId extId ite be seenIds_ env prefixM +runNetlistMonad isTb opts reprs s tops p tcm typeTrans iw + ite be seenIds_ env componentNames_ = flip runReaderT (NetlistEnv "" "" Nothing) . flip runStateT s' . runNetlist where s' = NetlistState - s 0 emptyVarEnv p typeTrans tcm (StrictText.empty,noSrcSpan) iw mkId - extId HashMapS.empty seenIds' Set.empty names tops env 0 prefixM reprs opts isTb ite be - HashMapS.empty + { _bindings=s + , _components=OMap.empty + , _primitives=p + , _typeTranslator=typeTrans + , _tcCache=tcm + , _curCompNm=(error "genComponent should have set _curCompNm", noSrcSpan) + , _intWidth=iw + , _seenIds=seenIds_ + , _seenComps=seenIds_ + , _seenPrimitives=Set.empty + , _componentNames=componentNames_ + , _topEntityAnns=tops + , _hdlDir=env + , _curBBlvl=0 + , _customReprs=reprs + , _clashOpts=opts + , _isTestBench=isTb + , _backEndITE=ite + , _backend=be + , _htyCache=HashMapS.empty + } - (seenIds',names) = genNames (opt_newInlineStrat opts) mkId prefixM seenIds_ - emptyVarEnv s +-- | Generate names for all binders in "BindingMap", except for the ones already +-- present in given identifier varenv. +genNames + :: Bool + -- ^ New inline strategy enabled? + -> Maybe StrictText.Text + -- ^ Prefix + -> IdentifierSet + -- ^ Identifier set to extend + -> VarEnv Identifier + -- ^ Pre-generated names + -> BindingMap + -> (VarEnv Identifier, IdentifierSet) +genNames newInlineStrat prefixM is env bndrs = + runState (foldlM go env bndrs) is + where + go env_ (bindingId -> id_) = + case lookupVarEnv id_ env_ of + Just _ -> pure env_ + Nothing -> do + nm <- Id.makeBasic (genComponentName newInlineStrat prefixM id_) + pure (extendVarEnv id_ nm env_) -genNames :: Bool - -> (IdType -> Identifier -> Identifier) - -> ComponentPrefix - -> HashMap Identifier Word - -> VarEnv Identifier - -> BindingMap - -> (HashMap Identifier Word, VarEnv Identifier) -genNames newInlineStrat mkId prefixM s0 m0 = foldr go (s0,m0) - where - go b (s,m) = - let nm' = genComponentName newInlineStrat s mkId prefixM (bindingId b) - s' = HashMapS.insert nm' 0 s - m' = extendVarEnv (bindingId b) nm' m - in (s', m') +-- | Generate names for top entities. Should be executed at the very start of +-- the synthesis process and shared between all passes. +genTopNames + :: Maybe StrictText.Text + -- ^ Prefix + -> Bool + -- ^ Allow escaped identifiers? + -> PreserveCase + -- ^ Lower case basic ids? + -> HDL + -- ^ HDL to generate identifiers for + -> [TopEntityT] + -> (VarEnv Identifier, IdentifierSet) +genTopNames prefixM esc lw hdl tops = + -- TODO: Report error if fixed top entities have conflicting names + flip runState (Id.emptyIdentifierSet esc lw hdl) $ do + env0 <- foldlM goFixed emptyVarEnv fixedTops + env1 <- foldlM goNonFixed env0 nonFixedTops + pure env1 + where + fixedTops = [(topId, ann) | TopEntityT{topId, topAnnotation=Just ann} <- tops] + nonFixedTops = [topId | TopEntityT{topId, topAnnotation=Nothing} <- tops] + goFixed env (topId, ann) = do + topNm <- genTopName prefixM ann + pure (extendVarEnv topId topNm env) + + goNonFixed env id_ = do + topNm <- Id.makeBasic (genComponentName True prefixM id_) + pure (extendVarEnv id_ topNm env) + -- | Generate a component for a given function (caching) genComponent :: HasCallStack => Id -- ^ Name of the function - -> NetlistMonad ([Bool],SrcSpan,HashMap Identifier Word,Component) + -> NetlistMonad (ComponentMeta, Component) genComponent compName = do compExprM <- lookupVarEnv compName <$> Lens.use bindings case compExprM of @@ -209,7 +263,7 @@ (_,sp) <- Lens.use curCompNm throw (ClashException sp ($(curLoc) ++ "No normalized expression found for: " ++ show compName) Nothing) Just b -> do - makeCachedU compName components $ genComponentT compName (bindingTerm b) + makeCachedO compName components $ genComponentT compName (bindingTerm b) -- | Generate a component for a given function genComponentT @@ -218,79 +272,111 @@ -- ^ Name of the function -> Term -- ^ Corresponding term - -> NetlistMonad ([Bool],SrcSpan,HashMap Identifier Word,Component) -genComponentT compName componentExpr = do - varCount .= 0 - componentName1 <- (`lookupVarEnv'` compName) <$> Lens.use componentNames - topEntMM <- fmap topAnnotation . lookupVarEnv compName <$> Lens.use topEntityAnns - prefixM <- Lens.use componentPrefix - let componentName2 = case (componentPrefixTop prefixM, join topEntMM) of - (Just p, Just ann) -> p `StrictText.append` StrictText.pack ('_':t_name ann) - (_,Just ann) -> StrictText.pack (t_name ann) - _ -> componentName1 - sp <- (bindingLoc . (`lookupVarEnv'` compName)) <$> Lens.use bindings - curCompNm .= (componentName2,sp) - + -> NetlistMonad (ComponentMeta, Component) +genComponentT compName0 componentExpr = do tcm <- Lens.use tcCache + compName1 <- (`lookupVarEnv'` compName0) <$> Lens.use componentNames + sp <- (bindingLoc . (`lookupVarEnv'` compName0)) <$> Lens.use bindings + curCompNm .= (compName1, sp) - -- HACK: Determine resulttype of this function by looking at its definition - -- in topEntityAnns, instead of looking at its last binder (which obscures - -- any attributes [see: Clash.Annotations.SynthesisAttributes]). - topEntityTypeM <- lookupVarEnv compName <$> Lens.use topEntityAnns - let topEntityTypeM' = snd . splitCoreFunForallTy tcm . varType . topId <$> topEntityTypeM + topEntityTM <- lookupVarEnv compName0 <$> Lens.use topEntityAnns + let topAnnMM = topAnnotation <$> topEntityTM + topVarTypeM = snd . splitCoreFunForallTy tcm . varType . topId <$> topEntityTM - seenIds .= HashMapS.empty + seenIds <~ Lens.use seenComps (wereVoids,compInps,argWrappers,compOutps,resUnwrappers,binders,resultM) <- case splitNormalized tcm componentExpr of Right (args, binds, res) -> do - let varType' = fromMaybe (varType res) topEntityTypeM' - mkUniqueNormalized emptyInScopeSet topEntMM ((args, binds, res{varType=varType'})) + let varType1 = fromMaybe (varType res) topVarTypeM + mkUniqueNormalized + emptyInScopeSet + topAnnMM + -- HACK: Determine resulttype of this function by looking at its definition + -- instead of looking at its last binder (which obscures any attributes + -- [see: Clash.Annotations.SynthesisAttributes]). + ((args, binds, res{varType=varType1})) Left err -> throw (ClashException sp ($curLoc ++ err) Nothing) - netDecls <- fmap catMaybes . mapM mkNetDecl $ filter (maybe (const True) (/=) resultM . fst) binders + netDecls <- concatMapM mkNetDecl (filter (maybe (const True) (/=) resultM . fst) binders) decls <- concat <$> mapM (uncurry mkDeclarations) binders case resultM of Just result -> do - Just (NetDecl' _ rw _ _ rIM) <- mkNetDecl . head $ filter ((==result) . fst) binders + [NetDecl' _ rw _ _ rIM] <- case filter ((==result) . fst) binders of + b:_ -> mkNetDecl b + _ -> error "internal error: couldn't find result binder" let (compOutps',resUnwrappers') = case compOutps of [oport] -> ([(rw,oport,rIM)],resUnwrappers) - _ -> let NetDecl n res resTy = head resUnwrappers + _ -> let NetDecl n res resTy = case resUnwrappers of + decl:_ -> decl + _ -> error "internal error: insufficient resUnwrappers" in (map (Wire,,Nothing) compOutps ,NetDecl' n rw res (Right resTy) Nothing:tail resUnwrappers ) - component = Component componentName2 compInps compOutps' + component = Component compName1 compInps compOutps' (netDecls ++ argWrappers ++ decls ++ resUnwrappers') ids <- Lens.use seenIds - return (wereVoids, sp, ids, component) + return (ComponentMeta wereVoids sp ids, component) -- No result declaration means that the result is empty, this only happens -- when the TopEntity has an empty result. We just create an empty component -- in this case. Nothing -> do - let component = Component componentName2 compInps [] (netDecls ++ argWrappers ++ decls) + let component = Component compName1 compInps [] (netDecls ++ argWrappers ++ decls) ids <- Lens.use seenIds - return (wereVoids, sp, ids, component) + return (ComponentMeta wereVoids sp ids, component) -mkNetDecl :: (Id, Term) -> NetlistMonad (Maybe Declaration) +mkNetDecl :: (Id, Term) -> NetlistMonad [Declaration] mkNetDecl (id_,tm) = preserveVarEnv $ do - let typ = varType id_ - hwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) typ - wr <- termToWireOrReg tm - rIM <- getResInit (id_,tm) - if isVoid hwTy - then return Nothing - else return . Just $ NetDecl' (addSrcNote sp) - wr - (id2identifier id_) - (Right hwTy) - rIM + hwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (varType id_) + if | not (shouldRenderDecl hwTy tm) -> return [] + | (Prim pInfo@PrimInfo{primMultiResult=MultiResult}, args) <- collectArgs tm -> + multiDecls pInfo args + | otherwise -> pure <$> singleDecl hwTy + where - nm = varName id_ - sp = case tm of {Tick (SrcSpan s) _ -> s; _ -> nameLoc nm} + multiDecls pInfo args0 = do + tcm <- Lens.use tcCache + resInits0 <- getResInits (id_, tm) + let + resInits1 = map Just resInits0 <> repeat Nothing + mpInfo = multiPrimInfo' tcm pInfo + (_, res) = splitMultiPrimArgs mpInfo args0 + netdecl i typ resInit = + -- TODO: Dehardcode Wire. Would entail changing 'outputReg' to a + -- list. + NetDecl' srcNote Wire (id2identifier i) (Right typ) resInit + hwTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) (mpi_resultTypes mpInfo) + pure (zipWith3 netdecl res hwTys resInits1) + + + singleDecl hwTy = do + wr <- termToWireOrReg tm + rIM <- listToMaybe <$> getResInits (id_, tm) + return (NetDecl' srcNote wr (id2identifier id_) (Right hwTy) rIM) + + addSrcNote loc + | isGoodSrcSpan loc = Just (StrictText.pack (showSDocUnsafe (ppr loc))) + | otherwise = Nothing + + srcNote = addSrcNote $ case tm of + Tick (SrcSpan s) _ -> s + _ -> nameLoc (varName id_) + + isMultiPrimSelect :: Term -> Bool + isMultiPrimSelect t = case collectArgs t of + (Prim (primName -> "c$multiPrimSelect"), _) -> True + _ -> False + + shouldRenderDecl :: HWType -> Term -> Bool + shouldRenderDecl ty t + | isVoid ty = False + | isMultiPrimSelect t = False + | otherwise = True + termToWireOrReg :: Term -> NetlistMonad WireOrReg termToWireOrReg (stripTicks -> Case scrut _ alts0@(_:_:_)) = do tcm <- Lens.use tcCache @@ -308,32 +394,43 @@ _ -> return Wire termToWireOrReg _ = return Wire - addSrcNote loc = if isGoodSrcSpan loc - then Just (StrictText.pack (showSDocUnsafe (ppr loc))) - else Nothing - -- Set the initialization value of a signal when a primitive wants to set it - getResInit - :: (Id,Term) -> NetlistMonad (Maybe Expr) - getResInit (i,collectArgsTicks -> (k,args,ticks)) = case k of - Prim p -> extractPrimWarnOrFail (primName p) >>= go (primName p) - _ -> return Nothing + getResInits :: (Id, Term) -> NetlistMonad [Expr] + getResInits (i,collectArgsTicks -> (k,args0,ticks)) = case k of + Prim p -> extractPrimWarnOrFail (primName p) >>= go p + _ -> return [] where - go pNm (BlackBox {resultInit = Just nmD}) = withTicks ticks $ \_ -> do - (bbCtx,_) <- mkBlackBoxContext pNm i args - (bbTempl,templDecl) <- prepareBlackBox pNm nmD bbCtx + go pInfo (BlackBox {resultInits=nmDs, multiResult=True}) = withTicks ticks $ \_ -> do + tcm <- Lens.use tcCache + let (args1, res) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args0 + (bbCtx, _) <- mkBlackBoxContext (primName pInfo) res args1 + mapM (go' (primName pInfo) bbCtx) nmDs + go pInfo (BlackBox {resultInits=nmDs}) = withTicks ticks $ \_ -> do + (bbCtx, _) <- mkBlackBoxContext (primName pInfo) [i] args0 + mapM (go' (primName pInfo) bbCtx) nmDs + go _ _ = pure [] + + go' pNm bbCtx nmD = do + (bbTempl, templDecl) <- prepareBlackBox pNm nmD bbCtx case templDecl of - [] -> return (Just (BlackBoxE pNm [] [] [] bbTempl bbCtx False)) + [] -> + return (BlackBoxE pNm [] [] [] bbTempl bbCtx False) _ -> do (_,sloc) <- Lens.use curCompNm - throw (ClashException sloc - (unwords [ $(curLoc) - , "signal initialization requires declarations:\n" - , show templDecl - ]) - Nothing) - go _ _ = return Nothing + throw (ClashException sloc [I.i| + Initial values cannot produce declarations, but saw: + #{templDecl} + + after rendering initial values for blackbox: + + #{pNm} + + Given template: + + #{nmD} + |] Nothing) + -- | Generate a list of concurrent Declarations for a let-binder, return an -- empty list if the bound expression is represented by 0 bits mkDeclarations @@ -396,7 +493,7 @@ Noop -> -- Rendered expression rendered a "noop" - a list of -- declarations without a result. Used for things like - -- mealy IO / inline assertions. + -- mealy IO / inline assertions / multi result primitives. [] _ -> -- Turn returned expression into declaration by assigning @@ -422,7 +519,7 @@ tcm <- Lens.use tcCache let scrutTy = termType tcm scrut scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy - scrutId <- extendIdentifier Extended dstId "_selection" + scrutId <- Id.suffix dstId "selection" (_,sp) <- Lens.use curCompNm ite <- Lens.use backEndITE altHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) altTy @@ -435,8 +532,8 @@ SP {} -> first (mkScrutExpr sp scrutHTy (fst (last alts0))) <$> mkExpr True declType (NetlistId scrutId scrutTy) scrut _ -> mkExpr False declType (NetlistId scrutId scrutTy) scrut - altTId <- extendIdentifier Extended dstId "_sel_alt_t" - altFId <- extendIdentifier Extended dstId "_sel_alt_f" + altTId <- Id.suffix dstId "sel_alt_t" + altFId <- Id.suffix dstId "sel_alt_f" (altTExpr,altTDecls) <- mkExpr False declType (NetlistId altTId altTy) altT (altFExpr,altFDecls) <- mkExpr False declType (NetlistId altFId altTy) altF -- This logic (and the same logic a few lines below) is faulty in the @@ -477,9 +574,7 @@ where mkCondExpr :: HWType -> (Pat,Term) -> NetlistMonad ((Maybe HW.Literal,Expr),[Declaration]) mkCondExpr scrutHTy (pat,alt) = do - altId <- extendIdentifier Extended - (netlistId1 id id2identifier bndr) - "_sel_alt" + altId <- Id.suffix (netlistId1 id id2identifier bndr) "sel_alt" (altExpr,altDecls) <- mkExpr False declType (NetlistId altId altTy) alt (,altDecls) <$> case pat of DefaultPat -> return (Nothing,altExpr) @@ -575,7 +670,6 @@ , let fArgTys1 = splitShouldSplit tcm $ rights fArgTys0 , length fArgTys1 == length args -> do - let annM = topAnnotation topEntity argHWTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) fArgTys1 (argExprs, concat -> argDecls) <- unzip <$> mapM (\(e,t) -> mkExpr False Concurrent (NetlistId dstId t) e) @@ -583,25 +677,57 @@ -- Filter void arguments, but make sure to render their declarations: let - filteredTypeExprs = filter (not . isVoid . fst) (zip argHWTys argExprs) - (hWTysFiltered, argExprsFiltered) = unzip filteredTypeExprs + filteredTypeExprs = filter (not . isVoid . snd) (zip argExprs argHWTys) dstHWty <- unsafeCoreTypeToHWTypeM' $(curLoc) fResTy - env <- Lens.use hdlDir - mkId <- Lens.use mkIdentifierFn - prefixM <- Lens.use componentPrefix - newInlineStrat <- opt_newInlineStrat <$> Lens.use clashOpts - let topName = StrictText.unpack - (genTopComponentName newInlineStrat mkId prefixM annM fun) - modName = takeWhile (/= '.') - (StrictText.unpack (nameOcc (varName fun))) - manFile <- case annM of - Just _ -> return (env ".." modName topName topName <.> "manifest") - Nothing -> return (env topName <.> "manifest") - Just man <- readMaybe <$> liftIO (readFile manFile) - instDecls <- mkTopUnWrapper fun annM man (dstId,dstHWty) - (zip argExprsFiltered hWTysFiltered) - tickDecls + + -- TODO: The commented code fetches the function definition from the + -- set of global bindings and uses it to replicate the port names + -- of it. However, this does rely on the binding actually being + -- present in the binding map. This isn't the case, as only + -- the current top entity (and its dependencies, stopping at other + -- top entities) are present. We can't add the non-normalized + -- version, as this logic relies on 'splitArguments' having + -- fired. Adding normalized versions would create a dependency + -- between two top entities, defeating the ability to compile in + -- parallel. + -- + -- One option is to split the normalization process into two + -- chunks: preprocessing (e.g., 'splitArguments') and actually + -- normalizing. This would ensure only minimal work is being done + -- serially. + -- + -- The current workaround is to not rely on named arguments, using + -- positional ones instead when instantiating a top entity. + -- + -- funTerm <- fmap bindingTerm . lookupVarEnv fun <$> Lens.use bindings + -- + -- expandedTopEntity <- + -- case splitNormalized tcm <$> funTerm of + -- Nothing -> error ("Internal error: could not find " <> show fun) + -- Just (Left err) -> error ("Internal error: " <> show err) + -- Just (Right (argIds, _binds, resId)) -> do + -- argTys <- mapM (unsafeCoreTypeToHWTypeM $(curLoc)) (map varType argIds) + -- resTy <- unsafeCoreTypeToHWTypeM $(curLoc) (varType resId) + -- is <- Lens.use seenIds + -- let topAnnM = topAnnotation topEntity + -- pure (expandTopEntityOrErr is (zip argIds argTys) (resId, resTy) topAnnM) + + -- Generate ExpandedTopEntity, see TODO^ + is <- Lens.use seenIds + argTys <- mapM (unsafeCoreTypeToHWTypeM $(curLoc) . termType tcm) args + resTy <- unsafeCoreTypeToHWTypeM $(curLoc) fResTy + let + ettArgs = (Nothing,) <$> argTys + ettRes = (Nothing, resTy) + expandedTopEntity = + expandTopEntityOrErr is ettArgs ettRes (topAnnotation topEntity) + + instDecls <- + mkTopUnWrapper + fun expandedTopEntity (dstId, dstHWty) + filteredTypeExprs tickDecls + return (argDecls ++ instDecls) | otherwise -> error $ $(curLoc) ++ "under-applied TopEntity: " ++ showPpr fun @@ -614,7 +740,7 @@ #{showPpr fun} |] Just (Binding{bindingTerm}) -> do - (_,_,_,Component compName compInps co _) <- preserveVarEnv $ genComponent fun + (_, Component compName compInps co _) <- preserveVarEnv $ genComponent fun let argTys = map (termType tcm) args argHWTys <- mapM coreTypeToHWTypeM' argTys @@ -624,25 +750,29 @@ -- Filter void arguments, but make sure to render their declarations: let - argTypeExprs = zip argHWTys (zip argTys argExprs) + argTypeExprs = zip argHWTys (zip argExprs argTys) filteredTypeExprs = fmap snd $ filter (not . isVoidMaybe True . fst) argTypeExprs - (argTysFiltered, argsFiltered) = unzip filteredTypeExprs let compOutp = (\(_,x,_) -> x) <$> listToMaybe co - if length argTysFiltered == length compInps + if length filteredTypeExprs == length compInps then do - (argExprs',argDecls') <- (second concat . unzip) <$> mapM (toSimpleVar dstId) (zip argsFiltered argTysFiltered) + (argExprs',argDecls') <- (second concat . unzip) <$> mapM (toSimpleVar dstId) filteredTypeExprs let inpAssigns = zipWith (\(i,t) e -> (Identifier i Nothing,In,t,e)) compInps argExprs' outpAssign = case compOutp of Nothing -> [] Just (id_,hwtype) -> [(Identifier id_ Nothing,Out,hwtype,Identifier dstId Nothing)] - instLabel0 <- extendIdentifier Basic compName (StrictText.pack "_" `StrictText.append` dstId) + let instLabel0 = StrictText.concat [Id.toText compName, "_", Id.toText dstId] instLabel1 <- fromMaybe instLabel0 <$> Lens.view setName instLabel2 <- affixName instLabel1 - instLabel3 <- mkUniqueIdentifier Basic instLabel2 - let instDecl = InstDecl Entity Nothing compName instLabel3 [] (outpAssign ++ inpAssigns) + instLabel3 <- Id.makeBasic instLabel2 + let portMap = NamedPortMap (outpAssign ++ inpAssigns) + instDecl = InstDecl Entity Nothing [] compName instLabel3 [] portMap return (argDecls ++ argDecls' ++ tickDecls ++ [instDecl]) - else error [I.i| + else + let + argsFiltered :: [Expr] + argsFiltered = map fst filteredTypeExprs + in error [I.i| Under-applied normalized function at component #{compName}: #{showPpr fun} @@ -664,7 +794,7 @@ case args of [] -> -- TODO: Figure out what to do with zero-width constructs - return [Assignment dstId (Identifier (nameOcc $ varName fun) Nothing)] + return [Assignment dstId (Identifier (id2identifier fun) Nothing)] _ -> error [I.i| Netlist generation encountered a local function. This should not happen. Function: @@ -693,21 +823,18 @@ -> NetlistMonad (Expr,[Declaration]) toSimpleVar _ (e@(Identifier _ Nothing),_) = return (e,[]) toSimpleVar dstId (e,ty) = do - argNm <- extendIdentifier Extended - dstId - "_fun_arg" - argNm' <- mkUniqueIdentifier Extended argNm + argNm <- Id.suffix dstId "fun_arg" hTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty - let argDecl = NetDecl Nothing argNm' hTy - argAssn = Assignment argNm' e - return (Identifier argNm' Nothing,[argDecl,argAssn]) + let argDecl = NetDecl Nothing argNm hTy + argAssn = Assignment argNm e + return (Identifier argNm Nothing,[argDecl,argAssn]) -- | Generate an expression for a term occurring on the RHS of a let-binder mkExpr :: HasCallStack => Bool -- ^ Treat BlackBox expression as declaration -> DeclarationType -- ^ Should the returned declarations be concurrent or sequential? - -> NetlistId -- ^ Id to assign the result to + -> NetlistId -- ^ Name hint for the id to (potentially) assign the result to -> Term -- ^ Term to convert to an expression -> NetlistMonad (Expr,[Declaration]) -- ^ Returned expression and a list of generate BlackBox declarations mkExpr _ _ _ (stripTicks -> Core.Literal l) = do @@ -726,7 +853,11 @@ i = toInteger (doubleToWord d) in return (HW.Literal (Just (BitVector 64,64)) (NumLit i), []) NaturalLiteral n -> return (HW.Literal (Just (Unsigned iw,iw)) $ NumLit n, []) - ByteArrayLiteral (PV.Vector _ _ (ByteArray ba)) -> return (HW.Literal Nothing (NumLit (Jp# (BN# ba))),[]) +#if MIN_VERSION_base(4,15,0) + ByteArrayLiteral (ByteArray ba) -> return (HW.Literal Nothing (NumLit (IP ba)),[]) +#else + ByteArrayLiteral (ByteArray ba) -> return (HW.Literal Nothing (NumLit (Jp# (BN# ba))),[]) +#endif _ -> error $ $(curLoc) ++ "not an integer or char literal" mkExpr bbEasD declType bndr app = @@ -735,7 +866,9 @@ in withTicks ticks $ \tickDecls -> do hwTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) (netlistTypes bndr) (_,sp) <- Lens.use curCompNm - let hwTyA = head hwTys + let hwTyA = case hwTys of + hwTy:_ -> hwTy + _ -> error ("internal error: unable to extract sufficient hwTys from: " <> show bndr) case appF of Data dc -> mkDcApplication hwTys bndr dc tmArgs Prim pInfo -> mkPrimitive False bbEasD bndr pInfo args tickDecls @@ -744,20 +877,18 @@ if isVoid hwTyA then return (Noop, []) else - return (Identifier (nameOcc $ varName f) Nothing, []) + return (Identifier (id2identifier f) Nothing, []) | not (null tyArgs) -> throw (ClashException sp ($(curLoc) ++ "Not in normal form: " ++ "Var-application with Type arguments:\n\n" ++ showPpr app) Nothing) | otherwise -> do - argNm0 <- extendIdentifier Extended (netlistId1 id id2identifier bndr) - "_fun_arg" - argNm1 <- mkUniqueIdentifier Extended argNm0 - decls <- mkFunApp argNm1 f tmArgs tickDecls + argNm <- Id.suffix (netlistId1 id id2identifier bndr) "fun_arg" + decls <- mkFunApp argNm f tmArgs tickDecls if isVoid hwTyA then return (Noop, decls) else - return ( Identifier argNm1 Nothing - , NetDecl' Nothing Wire argNm1 (Right hwTyA) Nothing:decls) + return ( Identifier argNm Nothing + , NetDecl' Nothing Wire argNm (Right hwTyA) Nothing:decls) Case scrut ty' [alt] -> mkProjection bbEasD bndr scrut ty' alt Case scrut tyA alts -> do tcm <- Lens.use tcCache @@ -767,18 +898,17 @@ let wr = case iteAlts scrutHTy alts of Just _ | ite -> Wire _ -> Reg - argNm0 <- extendIdentifier Extended (netlistId1 id id2identifier bndr) "_sel_arg" - argNm1 <- mkUniqueIdentifier Extended argNm0 - decls <- mkSelection declType (NetlistId argNm1 (netlistTypes1 bndr)) + argNm <- Id.suffix (netlistId1 id id2identifier bndr) "sel_arg" + decls <- mkSelection declType (NetlistId argNm (netlistTypes1 bndr)) scrut tyA alts tickDecls if isVoid hwTyA then return (Noop, decls) else - return ( Identifier argNm1 Nothing - , NetDecl' Nothing wr argNm1 (Right hwTyA) Nothing:decls) + return ( Identifier argNm Nothing + , NetDecl' Nothing wr argNm (Right hwTyA) Nothing:decls) Letrec binders body -> do - netDecls <- fmap catMaybes $ mapM mkNetDecl binders - decls <- concat <$> mapM (uncurry mkDeclarations) binders + netDecls <- concatMapM mkNetDecl binders + decls <- concatMapM (uncurry mkDeclarations) binders (bodyE,bodyDecls) <- mkExpr bbEasD declType bndr (mkApps (mkTicks body ticks) args) return (bodyE,netDecls ++ decls ++ bodyDecls) _ -> throw (ClashException sp ($(curLoc) ++ "Not in normal form: application of a Lambda-expression\n\n" ++ showPpr app) Nothing) @@ -790,7 +920,7 @@ :: Bool -- ^ Projection must bind to a simple variable -> NetlistId - -- ^ The signal to which the projection is (potentially) assigned + -- ^ Name hint for the signal to which the projection is (potentially) assigned -> Term -- ^ The subject/scrutinee of the projection -> Type @@ -813,8 +943,8 @@ scrutRendered <- do scrutNm <- netlistId1 - return - (\b -> extendIdentifier Extended (id2identifier b) "_projection") + Id.next + (\b -> Id.suffix (id2identifier b) "projection") bndr (scrutExpr,newDecls) <- mkExpr False Concurrent (NetlistId scrutNm scrutTy) scrut case scrutExpr of @@ -827,15 +957,14 @@ -- TODO: seems useless? pure (Left newDecls) _ -> do - scrutNm' <- mkUniqueIdentifier Extended scrutNm - let scrutDecl = NetDecl Nothing scrutNm' sHwTy - scrutAssn = Assignment scrutNm' scrutExpr - pure (Right (scrutNm', Nothing, newDecls ++ [scrutDecl, scrutAssn])) + let scrutDecl = NetDecl Nothing scrutNm sHwTy + scrutAssn = Assignment scrutNm scrutExpr + pure (Right (scrutNm, Nothing, newDecls ++ [scrutDecl, scrutAssn])) case scrutRendered of Left newDecls -> pure (Noop, newDecls) Right (selId, modM, decls) -> do - let altVarId = nameOcc (varName varTm) + let altVarId = id2identifier varTm modifier <- case pat of DataPat dc exts tms -> do let @@ -865,7 +994,7 @@ let extractExpr = Identifier (maybe altVarId (const selId) modifier) modifier case bndr of NetlistId scrutNm _ | mkDec -> do - scrutNm' <- mkUniqueIdentifier Extended scrutNm + scrutNm' <- Id.next scrutNm let scrutDecl = NetDecl Nothing scrutNm' vHwTy scrutAssn = Assignment scrutNm' extractExpr return (Identifier scrutNm' Nothing,scrutDecl:scrutAssn:decls) @@ -883,7 +1012,7 @@ -- ^ HWType of the LHS of the let-binder, can multiple types when we're -- creating a "split" product type (e.g. a tuple of a Clock and Reset) -> NetlistId - -- ^ Id to assign the result to + -- ^ Name hint for result id -> DataCon -- ^ Applied DataCon -> [Term] @@ -894,7 +1023,7 @@ let dcNm = nameOcc (dcName dc) tcm <- Lens.use tcCache let argTys = map (termType tcm) args - argNm <- netlistId1 return (\b -> extendIdentifier Extended (nameOcc (varName b)) "_dc_arg") bndr + argNm <- netlistId1 return (\b -> Id.suffix (id2identifier b) "_dc_arg") bndr argHWTys <- mapM coreTypeToHWTypeM' argTys (argExprs, concat -> argDecls) <- unzip <$> @@ -947,6 +1076,10 @@ CustomSum _ _ _ _ -> return (HW.DataCon dstHType (DC (dstHType, dcTag dc - 1)) []) + Enable _ -> + case argExprsFiltered of + [x] -> return (HW.DataCon dstHType (DC (dstHType,dcTag dc - 1)) [x]) + _ -> error $ $(curLoc) ++ "unexpected arguments to Enable: " ++ show argExprsFiltered Bool -> let dc' = case dcTag dc of 1 -> HW.Literal Nothing (BoolLit False) @@ -973,23 +1106,45 @@ in return dc' Void {} -> return Noop Signed _ +#if MIN_VERSION_base(4,15,0) + | dcNm == "GHC.Num.Integer.IS" +#else | dcNm == "GHC.Integer.Type.S#" - -> pure (head argExprsFiltered) +#endif + , (a:_) <- argExprsFiltered + -> pure a -- ByteArray# are non-translatable / void, except when they're literals +#if MIN_VERSION_base(4,15,0) + | dcNm == "GHC.Num.Integer.IP" +#else | dcNm == "GHC.Integer.Type.Jp#" - , HW.Literal Nothing (NumLit _) <- head argExprs - -> pure (head argExprs) +#endif + , (a@(HW.Literal Nothing (NumLit _)):_) <- argExprs + -> pure a +#if MIN_VERSION_base(4,15,0) + | dcNm == "GHC.Num.Integer.IN" +#else | dcNm == "GHC.Integer.Type.Jn#" +#endif -- ByteArray# are non-translatable / void, except when they're literals - , HW.Literal Nothing (NumLit i) <- head argExprs + , (HW.Literal Nothing (NumLit i):_) <- argExprs -> pure (HW.Literal Nothing (NumLit (negate i))) Unsigned _ +#if MIN_VERSION_base(4,15,0) + | dcNm == "GHC.Num.Natural.NS" +#else | dcNm == "GHC.Natural.NatS#" - -> pure (head argExprsFiltered) +#endif + , (a:_) <- argExprsFiltered + -> pure a +#if MIN_VERSION_base(4,15,0) + | dcNm == "GHC.Num.Natural.NB" +#else | dcNm == "GHC.Natural.NatJ#" +#endif -- ByteArray# are non-translatable / void, except when they're literals - , HW.Literal Nothing (NumLit _) <- head argExprs - -> pure (head argExprs) + , (a@(HW.Literal Nothing (NumLit _)):_) <- argExprs + -> pure a _ -> error $ $(curLoc) ++ "mkDcApplication undefined for: " ++ show (dstHType,dc,args,argHWTys) diff --git a/src/Clash/Netlist.hs-boot b/src/Clash/Netlist.hs-boot --- a/src/Clash/Netlist.hs-boot +++ b/src/Clash/Netlist.hs-boot @@ -3,6 +3,7 @@ License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} +{-# LANGUAGE CPP #-} module Clash.Netlist (genComponent @@ -16,20 +17,19 @@ ,mkFunApp ) where -import Data.HashMap.Strict (HashMap) import Clash.Core.DataCon (DataCon) import Clash.Core.Term (Alt,LetBinding,Term) import Clash.Core.Type (Type) import Clash.Core.Var (Id) -import Clash.Netlist.Types (Expr, HWType, Identifier, NetlistMonad, Component, - Declaration, NetlistId, DeclarationType) -import SrcLoc (SrcSpan) +import Clash.Netlist.Types + (Expr, HWType, Identifier, NetlistMonad, Declaration, NetlistId, + DeclarationType, ComponentMeta, Component) import GHC.Stack (HasCallStack) genComponent :: HasCallStack => Id - -> NetlistMonad ([Bool],SrcSpan,HashMap Identifier Word,Component) + -> NetlistMonad (ComponentMeta, Component) mkExpr :: HasCallStack => Bool @@ -62,7 +62,7 @@ -> [Declaration] -> NetlistMonad [Declaration] -mkNetDecl :: LetBinding -> NetlistMonad (Maybe Declaration) +mkNetDecl :: LetBinding -> NetlistMonad [Declaration] mkDeclarations :: HasCallStack => Id -> Term -> NetlistMonad [Declaration] mkDeclarations' :: HasCallStack => DeclarationType -> Id -> Term -> NetlistMonad [Declaration] diff --git a/src/Clash/Netlist/BlackBox.hs b/src/Clash/Netlist/BlackBox.hs --- a/src/Clash/Netlist/BlackBox.hs +++ b/src/Clash/Netlist/BlackBox.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-| Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, @@ -8,18 +9,21 @@ Functions to create BlackBox Contexts and fill in BlackBox templates -} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} module Clash.Netlist.BlackBox where import Control.Exception (throw) -import Control.Lens ((<<%=),(%=)) +import Control.Lens ((%=)) import qualified Control.Lens as Lens import Control.Monad (when, replicateM, zipWithM) +import Control.Monad.Extra (concatMapM) import Control.Monad.IO.Class (liftIO) import Data.Char (ord) import Data.Either (lefts, partitionEithers) @@ -27,7 +31,7 @@ import qualified Data.IntMap as IntMap import Data.List (elemIndex, partition) import Data.List.Extra (countEq, mapAccumLM) -import Data.Maybe (catMaybes, fromJust, fromMaybe) +import Data.Maybe (listToMaybe, fromJust, fromMaybe) import Data.Semigroup.Monad import qualified Data.Set as Set import Data.Text.Lazy (fromStrict) @@ -43,25 +47,30 @@ import System.IO (hPutStrLn, stderr, hFlush, hIsTerminalDevice) import TextShow (showt) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Utils.Misc (OverridingBool(..)) +#else import Util (OverridingBool(..)) +#endif import Clash.Annotations.Primitive - (PrimitiveGuard(HasBlackBox, WarnNonSynthesizable, WarnAlways, DontTranslate), - extractPrim) -import Clash.Annotations.TopEntity - (TopEntity(Synthesize), PortName(PortName)) + ( PrimitiveGuard(HasBlackBox, DontTranslate) + , PrimitiveWarning(WarnNonSynthesizable, WarnAlways) + , extractPrim) import Clash.Core.DataCon as D (dcTag) import Clash.Core.FreeVars (freeIds) import Clash.Core.Literal as L (Literal (..)) import Clash.Core.Name (Name (..), mkUnsafeSystemName) +import qualified Clash.Netlist.Id as Id import Clash.Core.Pretty (showPpr) import Clash.Core.Subst (extendIdSubst, mkSubst, substTm) import Clash.Core.Term as C - (PrimInfo (..), Term (..), WorkInfo (..), collectArgs, collectArgsTicks, collectBndrs, mkApps) + (IsMultiPrim (..), PrimInfo (..), Term (..), WorkInfo (..), collectArgs, + collectArgsTicks, collectBndrs, mkApps) import Clash.Core.TermInfo import Clash.Core.Type as C - (Type (..), ConstTy (..), TypeView (..), mkFunTy, splitFunTys, splitFunTy, tyView) + (Type (..), ConstTy (..), TypeView (..), mkFunTy, splitFunTys, tyView) import Clash.Core.TyCon as C (TyConMap, tyConDataCons) import Clash.Core.Util (inverseTopSortLetBindings, splitShouldSplit) @@ -78,7 +87,6 @@ (opt_primWarn, opt_color, ClashOpts) import Clash.Netlist.BlackBox.Types as B import Clash.Netlist.BlackBox.Util as B -import Clash.Netlist.Id (IdType (..)) import Clash.Netlist.Types as N import Clash.Netlist.Util as N import Clash.Primitives.Types as P @@ -109,42 +117,45 @@ -- | Generate the context for a BlackBox instantiation. mkBlackBoxContext - :: TextS.Text + :: HasCallStack + => TextS.Text -- ^ Blackbox function name - -> Id - -- ^ Identifier binding the primitive/blackbox application + -> [Id] + -- ^ Identifiers binding the primitive/blackbox application -> [Either Term Type] -- ^ Arguments of the primitive/blackbox application -> NetlistMonad (BlackBoxContext,[Declaration]) -mkBlackBoxContext bbName resId args@(lefts -> termArgs) = do +mkBlackBoxContext bbName resIds args@(lefts -> termArgs) = do -- Make context inputs - let resNm = nameOcc (varName resId) - resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (V.varType resId) + let + resNms = map id2identifier resIds + resNm = fromMaybe (error "mkBlackBoxContext: head") (listToMaybe resNms) + resTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc) . V.varType) resIds (imps,impDecls) <- unzip <$> zipWithM (mkArgument bbName resNm) [0..] termArgs (funs,funDecls) <- mapAccumLM - (addFunction (V.varType resId)) + (addFunction (map V.varType resIds)) IntMap.empty (zip termArgs [0..]) -- Make context result - let res = Identifier resNm Nothing + let ress = map (flip Identifier Nothing) resNms lvl <- Lens.use curBBlvl (nm,_) <- Lens.use curCompNm -- Set "context name" to value set by `Clash.Magic.setName`, default to the -- name of the closest binder - ctxName1 <- fromMaybe resNm <$> Lens.view setName + ctxName1 <- fromMaybe (map Id.toText resNms) . fmap pure <$> Lens.view setName -- Update "context name" with prefixes and suffixes set by -- `Clash.Magic.prefixName` and `Clash.Magic.suffixName` - ctxName2 <- affixName ctxName1 + ctxName2 <- mapM affixName ctxName1 - return ( Context bbName (res,resTy) imps funs [] lvl nm (Just ctxName2) + return ( Context bbName (zip ress resTys) imps funs [] lvl nm (listToMaybe ctxName2) , concat impDecls ++ concat funDecls ) where - addFunction resTy im (arg,i) = do + addFunction resTys im (arg,i) = do tcm <- Lens.use tcCache if isFun tcm arg then do -- Only try to calculate function plurality when primitive actually @@ -153,12 +164,14 @@ funcPlurality <- case extractPrim <$> prim of Just (Just p) -> - P.getFunctionPlurality p args resTy i + P.getFunctionPlurality p args resTys i _ -> pure 1 curBBlvl Lens.+= 1 - (fs,ds) <- unzip <$> replicateM funcPlurality (mkFunInput resId arg) + (fs,ds) <- case resIds of + (resId:_) -> unzip <$> replicateM funcPlurality (mkFunInput resId arg) + _ -> error "internal error: insufficient resIds" curBBlvl Lens.-= 1 let im' = IntMap.insert i fs im @@ -176,7 +189,7 @@ Nothing -> do (t2,decls) <- onBlackBox - (fmap (first BBTemplate) . setSym mkUniqueIdentifier bbCtx) + (fmap (first BBTemplate) . setSym bbCtx) (\bbName bbHash bbFunc -> pure (BBFunction bbName bbHash bbFunc, [])) templ return (t2,decls) @@ -199,7 +212,8 @@ :: TextS.Text -- ^ Blackbox function name -> Identifier - -- ^ LHS of the original let-binder + -- ^ LHS of the original let-binder. Is used as a name hint to generate new + -- names in case the argument is a declaration. -> Int -- ^ Argument n (zero-indexed). Used for error message. -> Term @@ -216,11 +230,12 @@ Nothing | (Prim p,_) <- collectArgs e , primName p == "Clash.Transformations.removedArg" - -> return ((Identifier (primName p) Nothing, Void Nothing, False),[]) + -> return ((Identifier (Id.unsafeMake "Clash.Transformations.removedArg") Nothing, Void Nothing, False), []) | otherwise -> return ((error ($(curLoc) ++ "Forced to evaluate untranslatable type: " ++ eTyMsg), Void Nothing, False), []) Just hwTy -> case collectArgsTicks e of - (C.Var v,[],_) -> return ((Identifier (nameOcc (varName v)) Nothing,hwTy,False),[]) + (C.Var v,[],_) -> + return ((Identifier (id2identifier v) Nothing,hwTy,False),[]) (C.Literal (IntegerLiteral i),[],_) -> return ((N.Literal (Just (Signed iw,iw)) (N.NumLit i),hwTy,True),[]) (C.Literal (IntLiteral i), [],_) -> @@ -274,10 +289,18 @@ extractPrimWarnOrFail nm = do prim <- HashMap.lookup nm <$> Lens.use primitives case prim of - Just guardedPrim -> - -- See if we need to warn the user, or error because we encountered - -- a primitive the user explicitly requested not to translate - go guardedPrim + Just (HasBlackBox warnings compiledPrim) -> + -- See if we need to warn the user + if null warnings then return compiledPrim else go warnings compiledPrim + Just DontTranslate -> do + -- We need to error because we encountered a primitive the user + -- explicitly requested not to translate + (_,sp) <- Lens.use curCompNm + let msg = $(curLoc) ++ "Clash was forced to translate '" ++ unpack nm + ++ "', but this value was marked with DontTranslate. Did you forget" + ++ " to include a blackbox for one of the constructs using this?" + ++ (if debugIsOn then "\n\n" ++ prettyCallStack callStack ++ "\n\n" else []) + throw (ClashException sp msg Nothing) Nothing -> do -- Blackbox requested, but no blackbox found at all! (_,sp) <- Lens.use curCompNm @@ -288,20 +311,11 @@ throw (ClashException sp msg Nothing) where go - :: GuardedCompiledPrimitive + :: [PrimitiveWarning] + -> CompiledPrimitive -> NetlistMonad CompiledPrimitive - go (HasBlackBox cp) = - return cp - go DontTranslate = do - (_,sp) <- Lens.use curCompNm - let msg = $(curLoc) ++ "Clash was forced to translate '" ++ unpack nm - ++ "', but this value was marked with DontTranslate. Did you forget" - ++ " to include a blackbox for one of the constructs using this?" - ++ (if debugIsOn then "\n\n" ++ prettyCallStack callStack ++ "\n\n" else []) - throw (ClashException sp msg Nothing) - - go (WarnAlways warning cp) = do + go ((WarnAlways warning):ws) cp = do primWarn <- opt_primWarn <$> Lens.use clashOpts seen <- Set.member nm <$> Lens.use seenPrimitives opts <- Lens.use clashOpts @@ -315,14 +329,15 @@ ++ warning ++ " (disable with -fclash-no-prim-warn)" - seenPrimitives %= Set.insert nm - - return cp + go ws cp - go (WarnNonSynthesizable warning cp) = do + go ((WarnNonSynthesizable warning):ws) cp = do isTB <- Lens.use isTestBench - if isTB then return cp else go (WarnAlways warning cp) + if isTB then go ws cp else go ((WarnAlways warning):ws) cp + go [] cp = do + seenPrimitives %= Set.insert nm + return cp mkPrimitive :: Bool @@ -341,15 +356,16 @@ mkPrimitive bbEParen bbEasD dst pInfo args tickDecls = go =<< extractPrimWarnOrFail (primName pInfo) where - ty = head (netlistTypes dst) + tys = netlistTypes dst + ty = fromMaybe (error "mkPrimitive") (listToMaybe tys) go :: CompiledPrimitive -> NetlistMonad (Expr, [Declaration]) go = \case - P.BlackBoxHaskell bbName wf _usedArgs funcName (_fHash, func) -> do - bbFunRes <- func bbEasD (primName pInfo) args ty + P.BlackBoxHaskell bbName wf _usedArgs multiResult funcName (_fHash, func) -> do + bbFunRes <- func bbEasD (primName pInfo) args tys case bbFunRes of Left err -> do -- Blackbox template function returned an error: @@ -360,30 +376,43 @@ (_,sp) <- Lens.use curCompNm throw (ClashException sp err' Nothing) Right (BlackBoxMeta {..}, bbTemplate) -> - -- Blackbox template generation succesful. Rerun 'go', but this time + -- Blackbox template generation successful. Rerun 'go', but this time -- around with a 'normal' @BlackBox@ go (P.BlackBox - bbName wf bbRenderVoid bbKind () bbOutputReg bbLibrary bbImports - bbFunctionPlurality bbIncludes Nothing Nothing bbTemplate) - p@P.BlackBox {} -> - case kind p of + bbName wf bbRenderVoid multiResult bbKind () bbOutputReg + bbLibrary bbImports bbFunctionPlurality bbIncludes + bbResultNames bbResultInits bbTemplate) + -- See 'setupMultiResultPrim' in "Clash.Normalize.Transformations": + P.BlackBox {name="c$multiPrimSelect"} -> + pure (Noop, []) + p@P.BlackBox {multiResult=True, name, template} -> do + -- Multi result primitives assign their results to signals + -- provided as arguments. Hence, we ignore any declarations + -- from 'resBndr1'. + tcm <- Lens.use tcCache + let (args1, resArgs) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args + (bbCtx, ctxDcls) <- mkBlackBoxContext (primName pInfo) resArgs args1 + (templ, templDecl) <- prepareBlackBox name template bbCtx + let bbDecl = N.BlackBoxD name (libraries p) (imports p) (includes p) templ bbCtx + return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl]) + p@P.BlackBox {template, name=pNm, kind} -> + case kind of TDecl -> do - let tempD = template p - pNm = name p resM <- resBndr1 True dst case resM of Just (dst',dstNm,dstDecl) -> do - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst' args - (templ,templDecl) <- prepareBlackBox pNm tempD bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst'] args + (templ,templDecl) <- prepareBlackBox pNm template bbCtx let bbDecl = N.BlackBoxD pNm (libraries p) (imports p) (includes p) templ bbCtx return (Identifier dstNm Nothing,dstDecl ++ ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl]) -- Render declarations as a Noop when requested Nothing | RenderVoid <- renderVoid p -> do + -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TDECL_NOOP__" 0) - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst1 args - (templ,templDecl) <- prepareBlackBox pNm tempD bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args + (templ,templDecl) <- prepareBlackBox pNm template bbCtx let bbDecl = N.BlackBoxD pNm (libraries p) (imports p) (includes p) templ bbCtx return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl]) @@ -391,15 +420,13 @@ -- Otherwise don't render them Nothing -> return (Noop,[]) TExpr -> do - let tempE = template p - pNm = name p if bbEasD then do resM <- resBndr1 True dst case resM of Just (dst',dstNm,dstDecl) -> do - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst' args - (bbTempl,templDecl) <- prepareBlackBox pNm tempE bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst'] args + (bbTempl,templDecl) <- prepareBlackBox pNm template bbCtx let tmpAssgn = Assignment dstNm (BlackBoxE pNm (libraries p) (imports p) (includes p) bbTempl bbCtx @@ -408,21 +435,22 @@ -- Render expression as a Noop when requested Nothing | RenderVoid <- renderVoid p -> do + -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TEXPRD_NOOP__" 0) - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst1 args - (templ,templDecl) <- prepareBlackBox pNm tempE bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args + (templ,templDecl) <- prepareBlackBox pNm template bbCtx let bbDecl = N.BlackBoxD pNm (libraries p) (imports p) (includes p) templ bbCtx return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl]) -- Otherwise don't render them - Nothing -> return (Identifier "__VOID_TEXPRD__" Nothing,[]) + Nothing -> return (Identifier (Id.unsafeMake "__VOID_TEXPRD__") Nothing,[]) else do resM <- resBndr1 False dst case resM of Just (dst',_,_) -> do - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst' args - (bbTempl,templDecl0) <- prepareBlackBox pNm tempE bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst'] args + (bbTempl,templDecl0) <- prepareBlackBox pNm template bbCtx let templDecl1 = case primName pInfo of "Clash.Sized.Internal.BitVector.fromInteger#" | [N.Literal _ (NumLit _), N.Literal _ _, N.Literal _ _] <- extractLiterals bbCtx -> [] @@ -438,15 +466,16 @@ return (BlackBoxE pNm (libraries p) (imports p) (includes p) bbTempl bbCtx bbEParen,ctxDcls ++ templDecl1) -- Render expression as a Noop when requested Nothing | RenderVoid <- renderVoid p -> do + -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists let dst1 = mkLocalId ty (mkUnsafeSystemName "__VOID_TEXPRE_NOOP__" 0) - (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) dst1 args - (templ,templDecl) <- prepareBlackBox pNm tempE bbCtx + (bbCtx,ctxDcls) <- mkBlackBoxContext (primName pInfo) [dst1] args + (templ,templDecl) <- prepareBlackBox pNm template bbCtx let bbDecl = N.BlackBoxD pNm (libraries p) (imports p) (includes p) templ bbCtx return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl]) -- Otherwise don't render them - Nothing -> return (Identifier "__VOID__" Nothing,[]) + Nothing -> return (Identifier (Id.unsafeMake "__VOID__") Nothing,[]) P.Primitive pNm _ _ | pNm == "GHC.Prim.tagToEnum#" -> do hwTy <- N.unsafeCoreTypeToHWTypeM' $(curLoc) ty @@ -461,12 +490,12 @@ tcm <- Lens.use tcCache let scrutTy = termType tcm scrut (scrutExpr,scrutDecls) <- - mkExpr False Concurrent (NetlistId "c$tte_rhs" scrutTy) scrut + mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$tte_rhs") scrutTy) scrut case scrutExpr of Identifier id_ Nothing -> return (DataTag hwTy (Left id_),scrutDecls) _ -> do scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy - tmpRhs <- mkUniqueIdentifier Extended "c$tte_rhs" + tmpRhs <- Id.make "c$tte_rhs" let netDeclRhs = NetDecl Nothing tmpRhs scrutHTy netAssignRhs = Assignment tmpRhs scrutExpr return (DataTag hwTy (Left tmpRhs),[netDeclRhs,netAssignRhs] ++ scrutDecls) @@ -480,11 +509,11 @@ let scrutTy = termType tcm scrut scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy (scrutExpr,scrutDecls) <- - mkExpr False Concurrent (NetlistId "c$dtt_rhs" scrutTy) scrut + mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut case scrutExpr of Identifier id_ Nothing -> return (DataTag scrutHTy (Right id_),scrutDecls) _ -> do - tmpRhs <- mkUniqueIdentifier Extended "c$dtt_rhs" + tmpRhs <- Id.make "c$dtt_rhs" let netDeclRhs = NetDecl Nothing tmpRhs scrutHTy netAssignRhs = Assignment tmpRhs scrutExpr return (DataTag scrutHTy (Right tmpRhs),[netDeclRhs,netAssignRhs] ++ scrutDecls) @@ -499,8 +528,20 @@ return (Noop, dstDecl ++ mealyDecls) Nothing -> return (Noop,[]) - | pNm == "Clash.Explicit.SimIO.bindSimIO#" -> - collectBindIO dst (lefts args) + | pNm == "Clash.Explicit.SimIO.bindSimIO#" -> do + (expr,decls) <- collectBindIO dst (lefts args) + resM <- resBndr True dst + case resM of + Just (_,dstNms,dstDecl) -> case expr of + Noop -> + return (Noop,decls) + _ -> case dstNms of + [dstNm] -> + return ( Identifier dstNm Nothing + , dstDecl ++ decls ++ [Assignment dstNm expr]) + _ -> error "internal error" + _ -> + return (Noop,decls) | pNm == "Clash.Explicit.SimIO.apSimIO#" -> do collectAppIO dst (lefts args) [] @@ -529,10 +570,14 @@ return (Noop, bindDecls) | pNm == "Clash.Explicit.SimIO.unSimIO#" -> - mkExpr False Sequential dst (head (lefts args)) + case lefts args of + (arg:_) -> mkExpr False Sequential dst arg + _ -> error "internal error: insufficient arguments" | pNm == "Clash.Explicit.SimIO.pureSimIO#" -> do - (expr,decls) <- mkExpr False Sequential dst (head (lefts args)) + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Sequential dst arg + _ -> error "internal error: insufficient arguments" resM <- resBndr True dst case resM of Just (_,dstNms,dstDecl) -> case expr of @@ -546,6 +591,45 @@ _ -> return (Noop,decls) + | pNm == "GHC.Num.Integer.IS" -> do + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Concurrent dst arg + _ -> error "internal error: insufficient arguments" + iw <- Lens.use intWidth + return (N.DataCon (Signed iw) (DC (Void Nothing,-1)) [expr],decls) + + | pNm == "GHC.Num.Integer.IP" -> do + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Concurrent dst arg + _ -> error "internal error: insufficient arguments" + case expr of + N.Literal Nothing (NumLit _) -> return (expr,decls) + _ -> error "non-constant ByteArray# not supported" + + | pNm == "GHC.Num.Integer.IN" -> do + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Concurrent dst arg + _ -> error "internal error: insufficient arguments" + case expr of + N.Literal Nothing (NumLit i) -> + return (N.Literal Nothing (NumLit (negate i)),decls) + _ -> error "non-constant ByteArray# not supported" + + | pNm == "GHC.Num.Natural.NS" -> do + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Concurrent dst arg + _ -> error "internal error: insufficient arguments" + iw <- Lens.use intWidth + return (N.DataCon (Unsigned iw) (DC (Void Nothing,-1)) [expr],decls) + + | pNm == "GHC.Num.Integer.NB" -> do + (expr,decls) <- case lefts args of + (arg:_) -> mkExpr False Concurrent dst arg + _ -> error "internal error: insufficient arguments" + case expr of + N.Literal Nothing (NumLit _) -> return (expr,decls) + _ -> error "non-constant ByteArray# not supported" + | otherwise -> return (BlackBoxE "" [] [] [] (BBTemplate [Text $ mconcat ["NO_TRANSLATION_FOR:",fromStrict pNm]]) @@ -580,7 +664,9 @@ -> NetlistMonad (Maybe ([Id],[Identifier],[Declaration])) -- Nothing when the binder would have type `Void` resBndr mkDec dst' = do - resHwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty + resHwTy <- case tys of + (ty1:_) -> unsafeCoreTypeToHWTypeM' $(curLoc) ty1 + _ -> error "internal error: insufficient types" if isVoid resHwTy then pure Nothing else @@ -588,22 +674,31 @@ NetlistId dstL _ -> case mkDec of False -> do -- TODO: check that it's okay to use `mkUnsafeSystemName` - let nm' = mkUnsafeSystemName dstL 0 + let nm' = mkUnsafeSystemName (Id.toText dstL) 0 id_ = mkLocalId ty nm' return (Just ([id_],[dstL],[])) True -> do - nm1 <- extendIdentifier Extended dstL "_res" - nm2 <- mkUniqueIdentifier Extended nm1 + nm2 <- Id.suffix dstL "res" -- TODO: check that it's okay to use `mkUnsafeInternalName` - let nm3 = mkUnsafeSystemName nm2 0 + let nm3 = mkUnsafeSystemName (Id.toText nm2) 0 id_ = mkLocalId ty nm3 - idDeclM <- mkNetDecl (id_,mkApps (Prim pInfo) args) + idDeclM <- mkNetDecl (id_, mkApps (Prim pInfo) args) case idDeclM of - Nothing -> return Nothing - Just idDecl -> return (Just ([id_],[nm2],[idDecl])) - CoreId dstR -> return (Just ([dstR],[nameOcc . varName $ dstR],[])) - MultiId ids -> return (Just (ids,map (nameOcc . varName) ids,[])) + [] -> return Nothing + [idDecl] -> return (Just ([id_],[nm2],[idDecl])) + ids -> error [I.i| + Unexpected nested use of multi result primitive. Ids: + #{show ids} + + Multi primitive should only appear on the RHS of a + let-binding. Please report this as a bug. + |] + CoreId dstR -> + return (Just ([dstR], [Id.unsafeMake . nameOcc . varName $ dstR], [])) + MultiId ids -> + return (Just (ids, map (Id.unsafeMake . nameOcc . varName) ids, [])) + -- Like resBndr, but fails on MultiId resBndr1 :: HasCallStack @@ -650,17 +745,20 @@ (mkLocalId (termType tcm e) (mkUnsafeSystemName "mealyres" 0)) in ([(u,e)], u) +#if __GLASGOW_HASKELL__ >= 900 + args1 = args0 +#else -- Drop the 'State# World' argument args1 = init args0 +#endif -- Take into account that the state argument is split over multiple -- binders because it contained types that are not allowed to occur in -- a HDL aggregate type mealyInitLength = length (splitShouldSplit tcm [termType tcm mealyInit]) (sArgs,iArgs) = splitAt mealyInitLength args1 -- Give all binders a unique name - normE <- mkUniqueNormalized is0 - (Just (Just (Synthesize "" [] (PortName "")))) - ([],map (,mealyInit) sArgs ++ map (,mealyIn) iArgs ++ bs,res) + let sBindings = map (,mealyInit) sArgs ++ map (,mealyIn) iArgs ++ bs + normE <- mkUniqueNormalized is0 Nothing ([], sBindings, res) case normE of -- We're not expecting any input or output wrappers (_,[],[],_,[],binders0,Just result) -> do @@ -677,10 +775,10 @@ -- -- The first set is only assigned in the always block, so they must be -- 'reg' in Verilog terminology - netDeclsSeq <- fmap catMaybes (mapM mkNetDecl (sBinders ++ bindersN)) + netDeclsSeq <- concatMapM mkNetDecl (sBinders ++ bindersN) -- The second set is assigned using concurrent assignment, so don't need -- to be 'reg' - netDeclsInp <- fmap catMaybes (mapM mkNetDecl iBinders) + netDeclsInp <- concatMapM mkNetDecl iBinders -- If the 'mealyFun' was not a let-expression with a variable reference -- as a body then we used the LHS of the entire 'mealyIO' expression as @@ -711,16 +809,20 @@ -- Create the declarations for the "initial state" block let sDst = case sBinders of + [] -> error "internal error: insufficient sBinders" [(b,_)] -> CoreId b _ -> MultiId (map fst sBinders) (exprInit,initDecls) <- mkExpr False Sequential sDst mealyInit let initAssign = case exprInit of Identifier _ Nothing -> [] Noop -> [] - _ -> [Assignment (id2identifier (fst (head sBinders))) exprInit] + _ -> case sBinders of + ((b,_):_) -> [Assignment (id2identifier b) exprInit] + _ -> error "internal error: insufficient sBinders" -- Create the declarations that corresponding to the input let iDst = case iBinders of + [] -> error "internal error: insufficient iBinders" [(b,_)] -> CoreId b _ -> MultiId (map fst iBinders) (exprArg,inpDeclsMisc) <- mkExpr False Concurrent iDst mealyIn @@ -742,14 +844,16 @@ KnownDomain _ _ Falling _ _ _ -> Rising _ -> error "internal error" (clkExpr,clkDecls) <- - mkExpr False Concurrent (NetlistId "__MEALY_CLK__" (termType tcm clk)) clk + mkExpr False Concurrent (NetlistId (Id.unsafeMake "__MEALY_CLK__") (termType tcm clk)) clk -- collect the declarations related to the input let netDeclsInp1 = netDeclsInp ++ inpDeclsMisc -- Collate everything return (clkDecls ++ netDeclsSeq1 ++ netDeclsInp1 ++ - [ Assignment (id2identifier (fst (head iBinders))) exprArg + [ case iBinders of + ((i,_):_) -> Assignment (id2identifier i) exprArg + _ -> error "internal error: insufficient iBinders" , Seq [Initial (map SeqDecl (initDeclsOther ++ initAssign))] , Seq [AlwaysClocked edge clkExpr (map SeqDecl seqDeclsOther)] ] ++ resAssn) @@ -765,30 +869,33 @@ -- | Collect the sequential declarations for 'bindIO' collectBindIO :: NetlistId -> [Term] -> NetlistMonad (Expr,[Declaration]) +#if __GLASGOW_HASKELL__ >= 900 +collectBindIO dst (m:Lam x q@e:_) = do +#else collectBindIO dst (m:Lam x q@(Lam _ e):_) = do +#endif tcm <- Lens.use tcCache - ds0 <- collectAction tcm - case splitNormalized tcm q of + (ds0,subst) <- collectAction tcm + let qS = substTm "collectBindIO1" subst q + case splitNormalized tcm qS of Right (args,bs0,res) -> do let Letrec bs _ = inverseTopSortLetBindings (Letrec bs0 (C.Var res)) - let is0 = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet q) + let is0 = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet qS) normE <- mkUniqueNormalized is0 Nothing (args,bs,res) case normE of (_,_,[],_,[],binders,Just result) -> do - ds1 <- concat <$> mapM (uncurry (mkDeclarations' Sequential)) binders - netDecls <- fmap catMaybes (mapM mkNetDecl binders) - let assn = Assignment (netlistId1 id id2identifier dst) - (Identifier (id2identifier result) Nothing) - return (Noop, (netDecls ++ ds0 ++ ds1 ++ [assn])) + ds1 <- concatMapM (uncurry (mkDeclarations' Sequential)) binders + netDecls <- concatMapM mkNetDecl binders + return (Identifier (id2identifier result) Nothing, netDecls ++ ds0 ++ ds1) _ -> error "internal error" - _ -> case e of + _ -> case substTm "collectBindIO2" subst e of Letrec {} -> error "internal error" (collectArgs -> (Prim p,args)) | primName p == "Clash.Explicit.SimIO.bindSimIO#" -> do (expr,ds1) <- collectBindIO dst (lefts args) return (expr, ds0 ++ ds1) - _ -> do - (expr,ds1) <- mkExpr False Sequential dst e + eS -> do + (expr,ds1) <- mkExpr False Sequential dst eS return (expr, ds0 ++ ds1) where collectAction tcm = case splitNormalized tcm m of @@ -797,27 +904,30 @@ let is0 = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet m) normE <- mkUniqueNormalized is0 Nothing (args,(x,m):bs,res) case normE of - (_,_,[],_,[],binders,Just result) -> do - let binders1 = tail binders ++ [(fst (head binders), C.Var result)] - ds1 <- concat <$> mapM (uncurry (mkDeclarations' Sequential)) binders1 - netDecls <- fmap catMaybes (mapM mkNetDecl binders) - return (netDecls ++ ds1) + (_,_,[],_,[],binders@(b:_),Just result) -> do + let binders1 = tail binders ++ [(fst b, C.Var result)] + ds1 <- concatMapM (uncurry (mkDeclarations' Sequential)) binders1 + netDecls <- concatMapM mkNetDecl binders + return (netDecls ++ ds1,extendIdSubst (mkSubst eInScopeSet) x (Var (fst b))) _ -> error "internal error" _ -> do - netDecls <- fmap catMaybes (mapM mkNetDecl [(x,m)]) - ds1 <- mkDeclarations' Sequential x m - return (netDecls ++ ds1) + ([x'],s) <- mkUnique (mkSubst eInScopeSet) [x] + netDecls <- concatMapM mkNetDecl [(x',m)] + ds1 <- mkDeclarations' Sequential x' m + return (netDecls ++ ds1,s) + eInScopeSet = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet e) + collectBindIO _ es = error ("internal error:\n" ++ showPpr es) -- | Collect the sequential declarations for 'appIO' collectAppIO :: NetlistId -> [Term] -> [Term] -> NetlistMonad (Expr,[Declaration]) collectAppIO dst (fun1:arg1:_) rest = case collectArgs fun1 of - (Prim (PrimInfo "Clash.Explicit.SimIO.fmapSimIO#" _ _),(lefts -> (fun0:arg0:_))) -> do + (Prim (PrimInfo "Clash.Explicit.SimIO.fmapSimIO#" _ _ _),(lefts -> (fun0:arg0:_))) -> do tcm <- Lens.use tcCache let argN = map (Left . unSimIO tcm) (arg0:arg1:rest) mkExpr False Sequential dst (mkApps fun0 argN) - (Prim (PrimInfo "Clash.Explicit.SimIO.apSimIO#" _ _),(lefts -> args)) -> do + (Prim (PrimInfo "Clash.Explicit.SimIO.apSimIO#" _ _ _),(lefts -> args)) -> do collectAppIO dst args (arg1:rest) _ -> error ("internal error:\n" ++ showPpr (fun1:arg1:rest)) @@ -837,7 +947,11 @@ let argTy = termType tcm arg in case tyView argTy of TyConApp _ [tcArg] -> - mkApps (Prim (PrimInfo "Clash.Explicit.SimIO.unSimIO#" (mkFunTy argTy tcArg) WorkNever)) + mkApps (Prim ( PrimInfo + "Clash.Explicit.SimIO.unSimIO#" + (mkFunTy argTy tcArg) + WorkNever + SingleResult )) [Left arg] _ -> error ("internal error:\n" ++ showPpr arg) @@ -847,7 +961,8 @@ mkFunInput :: HasCallStack => Id - -- ^ Identifier binding the encompassing primitive/blackbox application + -- ^ Identifier binding the encompassing primitive/blackbox application. Used + -- as a name hint if 'mkFunInput' needs intermediate signals. -> Term -- ^ The function argument term -> NetlistMonad @@ -874,17 +989,21 @@ error $ $(curLoc) ++ "Unexpected blackbox type: " ++ "Primitive " ++ show pn ++ " " ++ show pt - P.BlackBoxHaskell pName _workInfo _usedArgs fName (_, func) -> do + P.BlackBoxHaskell{name=pName, multiResult=True} -> + -- TODO: dev pointers + error [I.i| + Encountered multiresult primitive as a direct argument to + another primitive. This should not happen. + + Encountered: #{pName} + + Please report this as an issue. + |] + P.BlackBoxHaskell{name=pName, functionName=fName, function=(_, func)} -> do -- Determine result type of this blackbox. If it's not a -- function, simply use its term type. - let - resTy0 = termType tcm e - resTy1 = - case splitFunTy tcm resTy0 of - Just (_, t) -> t - Nothing -> resTy0 - - bbhRes <- func True pName args resTy1 + let (_, resTy) = splitFunTys tcm (termType tcm e) + bbhRes <- func True pName args [resTy] case bbhRes of Left err -> error $ $(curLoc) ++ show fName ++ " yielded an error: " @@ -903,11 +1022,11 @@ case resHTyM1 of -- Special case where coreTypeToHWTypeM determined a type to -- be completely transparent. - Just (_resHTy, areVoids@[countEq False -> 1]) -> do - let nonVoidArgI = fromJust (elemIndex False (head areVoids)) - let arg = TextS.concat ["~ARG[", showt nonVoidArgI, "]"] - let assign = Assignment "~RESULT" (Identifier arg Nothing) - return (Right (("", tickDecls ++ [assign]), Wire)) + Just (_resHTy, [areVoids@(countEq False -> 1)]) -> do + let nonVoidArgI = fromJust (elemIndex False areVoids) + let arg = Id.unsafeMake (TextS.concat ["~ARG[", showt nonVoidArgI, "]"]) + let assign = Assignment (Id.unsafeMake "~RESULT") (Identifier arg Nothing) + return (Right ((Id.unsafeMake "", tickDecls ++ [assign]), Wire)) -- Because we filter void constructs, the argument indices and -- the field indices don't necessarily correspond anymore. We @@ -918,10 +1037,11 @@ let dcI = dcTag dc - 1 areVoids1 = indexNote ($(curLoc) ++ "No areVoids with index: " ++ show dcI) areVoids0 dcI - dcInps = [Identifier (TextS.pack ("~ARG[" ++ show x ++ "]")) Nothing | x <- originalIndices areVoids1] + mkArg i = Id.unsafeMake ("~ARG[" <> showt i <> "]") + dcInps = [Identifier (mkArg x) Nothing | x <- originalIndices areVoids1] dcApp = DataCon resHTy (DC (resHTy,dcI)) dcInps - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) -- CustomSP the same as SP, but with a user-defined bit -- level representation @@ -929,41 +1049,43 @@ let dcI = dcTag dc - 1 areVoids1 = indexNote ($(curLoc) ++ "No areVoids with index: " ++ show dcI) areVoids0 dcI - dcInps = [Identifier (TextS.pack ("~ARG[" ++ show x ++ "]")) Nothing | x <- originalIndices areVoids1] + mkArg i = Id.unsafeMake ("~ARG[" <> showt i <> "]") + dcInps = [Identifier (mkArg x) Nothing | x <- originalIndices areVoids1] dcApp = DataCon resHTy (DC (resHTy,dcI)) dcInps - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) -- Like SP, we have to retrieve the index BEFORE filtering voids - Just (resHTy@(Product _ _ _), areVoids0) -> do - let areVoids1 = head areVoids0 - dcInps = [ Identifier (TextS.pack ("~ARG[" ++ show x ++ "]")) Nothing | x <- originalIndices areVoids1] + Just (resHTy@(Product _ _ _), areVoids1:_) -> do + let mkArg i = Id.unsafeMake ("~ARG[" <> showt i <> "]") + dcInps = [ Identifier (mkArg x) Nothing | x <- originalIndices areVoids1] dcApp = DataCon resHTy (DC (resHTy,0)) dcInps - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) -- Vectors never have defined areVoids (or all set to False), as -- it would be converted to Void otherwise. We can therefore -- safely ignore it: Just (resHTy@(Vector _ _), _areVoids) -> do - let dcInps = [ Identifier (TextS.pack ("~ARG[" ++ show x ++ "]")) Nothing | x <- [(1::Int)..2] ] + let mkArg i = Id.unsafeMake ("~ARG[" <> showt i <> "]") + dcInps = [ Identifier (mkArg x) Nothing | x <- [(1::Int)..2] ] dcApp = DataCon resHTy (DC (resHTy,1)) dcInps - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) -- Sum types OR a Sum type after filtering empty types: Just (resHTy@(Sum _ _), _areVoids) -> do let dcI = dcTag dc - 1 dcApp = DataCon resHTy (DC (resHTy,dcI)) [] - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) -- Same as Sum, but with user defined bit level representation Just (resHTy@(CustomSum {}), _areVoids) -> do let dcI = dcTag dc - 1 dcApp = DataCon resHTy (DC (resHTy,dcI)) [] - dcAss = Assignment "~RESULT" dcApp - return (Right (("",tickDecls ++ [dcAss]),Wire)) + dcAss = Assignment (Id.unsafeMake "~RESULT") dcApp + return (Right ((Id.unsafeMake "",tickDecls ++ [dcAss]),Wire)) Just (Void {}, _areVoids) -> return (error $ $(curLoc) ++ "Encountered Void in mkFunInput." @@ -979,21 +1101,25 @@ normalized <- Lens.use bindings case lookupVarEnv fun normalized of Just _ -> do - (wereVoids,_,_,N.Component compName compInps [(_,compOutp,_)] _) <- + (meta,N.Component compName compInps [(_,compOutp,_)] _) <- preserveVarEnv $ genComponent fun - let inpAssign (i, t) e' = (Identifier i Nothing, In, t, e') - inpVar i = TextS.pack ("~VAR[arg" ++ show i ++ "][" ++ show i ++ "]") - inpVars = [Identifier (inpVar i) Nothing | i <- originalIndices wereVoids] - inpAssigns = zipWith inpAssign compInps inpVars - outpAssign = ( Identifier (fst compOutp) Nothing - , Out - , snd compOutp - , Identifier "~RESULT" Nothing ) - i <- varCount <<%= (+1) - let instLabel = TextS.concat [compName,TextS.pack ("_" ++ show i)] - instDecl = InstDecl Entity Nothing compName instLabel [] (outpAssign:inpAssigns) - return (Right (("",tickDecls ++ [instDecl]),Wire)) + let + ComponentMeta{cmWereVoids} = meta + inpAssign (i, t) e' = (Identifier i Nothing, In, t, e') + inpVar i = Id.unsafeMake ("~VAR[arg" <> showt i <> "][" <> showt i <> "]") + inpVars = [Identifier (inpVar i) Nothing | i <- originalIndices cmWereVoids] + inpAssigns = zipWith inpAssign compInps inpVars + outpAssign = + ( Identifier (fst compOutp) Nothing + , Out + , snd compOutp + , Identifier (Id.unsafeMake "~RESULT") Nothing ) + instLabel <- Id.next compName + let + portMap = NamedPortMap (outpAssign:inpAssigns) + instDecl = InstDecl Entity Nothing [] compName instLabel [] portMap + return (Right ((Id.unsafeMake "",tickDecls ++ [instDecl]),Wire)) Nothing -> error $ $(curLoc) ++ "Cannot make function input for: " ++ showPpr e C.Lam {} -> do let is0 = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet appE) @@ -1002,25 +1128,26 @@ let pNm = case appE of Prim p -> primName p _ -> "__INTERNAL__" - (bbCtx,dcls) <- mkBlackBoxContext pNm resId args + (bbCtx,dcls) <- mkBlackBoxContext pNm [resId] args case templ of Left (TDecl,oreg,libs,imps,inc,_,templ') -> do (l',templDecl) <- onBlackBox - (fmap (first BBTemplate) . setSym mkUniqueIdentifier bbCtx) + (fmap (first BBTemplate) . setSym bbCtx) (\bbName bbHash bbFunc -> pure $ (BBFunction bbName bbHash bbFunc, [])) templ' return ((Left l',if oreg then Reg else Wire,libs,imps,inc,bbCtx),dcls ++ templDecl) Left (TExpr,_,libs,imps,inc,nm,templ') -> do onBlackBox (\t -> do t' <- getMon (prettyBlackBox t) - let assn = Assignment "~RESULT" (Identifier (Text.toStrict t') Nothing) - return ((Right ("",[assn]),Wire,libs,imps,inc,bbCtx),dcls)) + let t'' = Id.unsafeMake (Text.toStrict t') + assn = Assignment (Id.unsafeMake "~RESULT") (Identifier t'' Nothing) + return ((Right (Id.unsafeMake "",[assn]),Wire,libs,imps,inc,bbCtx),dcls)) (\bbName bbHash (TemplateFunction k g _) -> do let f' bbCtx' = do - let assn = Assignment "~RESULT" + let assn = Assignment (Id.unsafeMake "~RESULT") (BlackBoxE nm libs imps inc templ' bbCtx' False) - p <- getMon (Backend.blockDecl "" [assn]) + p <- getMon (Backend.blockDecl (Id.unsafeMake "") [assn]) return p return ((Left (BBFunction bbName bbHash (TemplateFunction k g f')) ,Wire @@ -1037,24 +1164,29 @@ return ((Right decl,wr,[],[],[],bbCtx),dcls) where goExpr app@(collectArgsTicks -> (C.Var fun,args@(_:_),ticks)) = do + tcm <- Lens.use tcCache + resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (termType tcm app) let (tmArgs,tyArgs) = partitionEithers args if null tyArgs then withTicks ticks $ \tickDecls -> do - appDecls <- mkFunApp "~RESULT" fun tmArgs tickDecls - nm <- mkUniqueIdentifier Basic "block" - return (Right ((nm,appDecls),Wire)) + resNm <- Id.make "result" + appDecls <- mkFunApp resNm fun tmArgs tickDecls + let assn = [ Assignment (Id.unsafeMake "~RESULT") (Identifier resNm Nothing) + , NetDecl Nothing resNm resTy ] + nm <- Id.makeBasic "block" + return (Right ((nm,assn++appDecls),Wire)) else do (_,sp) <- Lens.use curCompNm throw (ClashException sp ($(curLoc) ++ "Not in normal form: Var-application with Type arguments:\n\n" ++ showPpr app) Nothing) goExpr e' = do tcm <- Lens.use tcCache let eType = termType tcm e' - (appExpr,appDecls) <- mkExpr False Concurrent (NetlistId "c$bb_res" eType) e' - let assn = Assignment "~RESULT" appExpr + (appExpr,appDecls) <- mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$bb_res") eType) e' + let assn = Assignment (Id.unsafeMake "~RESULT") appExpr nm <- if null appDecls - then return "" - else mkUniqueIdentifier Basic "block" + then return (Id.unsafeMake "") + else Id.makeBasic "block" return (Right ((nm,appDecls ++ [assn]),Wire)) go is0 n (Lam id_ e') = do @@ -1068,24 +1200,20 @@ go is1 (n+(1::Int)) e'' go _ _ (C.Var v) = do - let assn = Assignment "~RESULT" (Identifier (nameOcc (varName v)) Nothing) - return (Right (("",[assn]),Wire)) + let assn = Assignment (Id.unsafeMake "~RESULT") (Identifier (id2identifier v) Nothing) + return (Right ((Id.unsafeMake "",[assn]),Wire)) go _ _ (Case scrut ty [alt]) = do tcm <- Lens.use tcCache let sTy = termType tcm scrut - (projection,decls) <- mkProjection False (NetlistId "c$bb_res" sTy) scrut ty alt - let assn = Assignment "~RESULT" projection + (projection,decls) <- mkProjection False (NetlistId (Id.unsafeMake "c$bb_res") sTy) scrut ty alt + let assn = Assignment (Id.unsafeMake "~RESULT") projection nm <- if null decls - then return "" - else mkUniqueIdentifier Basic "projection" + then return (Id.unsafeMake "") + else Id.makeBasic "projection" return (Right ((nm,decls ++ [assn]),Wire)) go _ _ (Case scrut ty alts@(_:_:_)) = do - -- TODO: check that it's okay to use `mkUnsafeSystemName` - let resId' = resId {varName = mkUnsafeSystemName "~RESULT" 0} - selectionDecls <- mkSelection Concurrent (CoreId resId') scrut ty alts [] - nm <- mkUniqueIdentifier Basic "selection" tcm <- Lens.use tcCache let scrutTy = termType tcm scrut scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy @@ -1093,8 +1221,18 @@ let wr = case iteAlts scrutHTy alts of Just _ | ite -> Wire _ -> Reg - return (Right ((nm,selectionDecls),wr)) + resNm <- Id.make "result" + -- It's safe to use 'mkUnsafeSystemName' here: only the name, not the + -- unique, will be used + let resId' = NetlistId resNm ty + selectionDecls <- mkSelection Concurrent resId' scrut ty alts [] + resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty + let assn = [ NetDecl' Nothing wr resNm (Right resTy) Nothing + , Assignment (Id.unsafeMake "~RESULT") (Identifier resNm Nothing) ] + nm <- Id.makeBasic "selection" + return (Right ((nm,assn++selectionDecls),Wire)) + go is0 _ e'@(Letrec {}) = do tcm <- Lens.use tcCache let normE = splitNormalized tcm e' @@ -1103,17 +1241,19 @@ Left err -> error err case resultM of Just result -> do - let binders' = map (\(id_,tm) -> (goR result id_,tm)) binders - netDecls <- fmap catMaybes . mapM mkNetDecl $ filter ((/= result) . fst) binders - decls <- concat <$> mapM (uncurry mkDeclarations) binders' - Just (NetDecl' _ rw _ _ _) <- mkNetDecl . head $ filter ((==result) . fst) binders - nm <- mkUniqueIdentifier Basic "fun" - return (Right ((nm,netDecls ++ decls),rw)) - Nothing -> return (Right (("",[]),Wire)) - where - -- TODO: check that it's okay to use `mkUnsafeSystemName` - goR r id_ | id_ == r = id_ {varName = mkUnsafeSystemName "~RESULT" 0} - | otherwise = id_ + -- TODO: figure out what to do with multires blackboxes here + netDecls <- concatMapM mkNetDecl $ binders + decls <- concatMapM (uncurry mkDeclarations) binders + nm <- Id.makeBasic "fun" + let resultId = id2identifier result + -- TODO: Due to reasons lost in the mists of time, #1265 creates an + -- assignement here, whereas it previously wouldn't. With the PR in + -- tests break when reverting to the old behavior. In some cases this + -- creates "useless" assignments. We should investigate whether we can + -- get the old behavior back. + let resDecl = Assignment (Id.unsafeMake "~RESULT") (Identifier resultId Nothing) + return (Right ((nm,resDecl:netDecls ++ decls),Wire)) + Nothing -> return (Right ((Id.unsafeMake "",[]),Wire)) go is0 n (Tick _ e') = go is0 n e' diff --git a/src/Clash/Netlist/BlackBox.hs-boot b/src/Clash/Netlist/BlackBox.hs-boot --- a/src/Clash/Netlist/BlackBox.hs-boot +++ b/src/Clash/Netlist/BlackBox.hs-boot @@ -20,10 +20,11 @@ -> NetlistMonad CompiledPrimitive mkBlackBoxContext - :: Text + :: HasCallStack + => Text -- ^ Blackbox function name - -> Id - -- ^ Identifier binding the primitive/blackbox application + -> [Id] + -- ^ Identifiers binding the primitive/blackbox application -> [Either Term Type] -- ^ Arguments of the primitive/blackbox application -> NetlistMonad (BlackBoxContext,[Declaration]) diff --git a/src/Clash/Netlist/BlackBox/Parser.hs b/src/Clash/Netlist/BlackBox/Parser.hs --- a/src/Clash/Netlist/BlackBox/Parser.hs +++ b/src/Clash/Netlist/BlackBox/Parser.hs @@ -74,11 +74,9 @@ -- | Parse an Expression element pTagE :: Parser Element -pTagE = Result True <$ string "~ERESULT" - <|> Result False <$ string "~RESULT" +pTagE = Result <$ string "~RESULT" <|> ArgGen <$> (string "~ARGN" *> brackets' natural') <*> brackets' natural' - <|> Arg True <$> (string "~EARG" *> brackets' natural') - <|> Arg False <$> (string "~ARG" *> brackets' natural') + <|> Arg <$> (string "~ARG" *> brackets' natural') <|> Const <$> (string "~CONST" *> brackets' natural') <|> Lit <$> (string "~LIT" *> brackets' natural') <|> Name <$> (string "~NAME" *> brackets' natural') @@ -114,6 +112,7 @@ <|> IsVar <$> (string "~ISVAR" *> brackets' natural') <|> IsActiveHigh <$> (string "~ISACTIVEHIGH" *> brackets' natural') <|> IsActiveEnable <$> (string "~ISACTIVEENABLE" *> brackets' natural') + <|> IsUndefined <$> (string "~ISUNDEFINED" *> brackets' natural') <|> StrCmp <$> (string "~STRCMP" *> brackets' pSigD) <*> brackets' natural' <|> OutputWireReg <$> (string "~OUTPUTWIREREG" *> brackets' natural') <|> GenSym <$> (string "~GENSYM" *> brackets' pSigD) <*> brackets' natural' diff --git a/src/Clash/Netlist/BlackBox/Types.hs b/src/Clash/Netlist/BlackBox/Types.hs --- a/src/Clash/Netlist/BlackBox/Types.hs +++ b/src/Clash/Netlist/BlackBox/Types.hs @@ -65,12 +65,14 @@ , bbFunctionPlurality :: [(Int, Int)] , bbIncludes :: [((S.Text, S.Text), BlackBox)] , bbRenderVoid :: RenderVoid + , bbResultNames :: [BlackBox] + , bbResultInits :: [BlackBox] } -- | Use this value in your blackbox template function if you do want to -- accept the defaults as documented in @Clash.Primitives.Types.BlackBox@. emptyBlackBoxMeta :: BlackBoxMeta -emptyBlackBoxMeta = BlackBoxMeta False TExpr [] [] [] [] NoRenderVoid +emptyBlackBoxMeta = BlackBoxMeta False TExpr [] [] [] [] NoRenderVoid [] [] -- | A BlackBox function generates a blackbox template, given the inputs and -- result type of the function it should provide a blackbox for. This is useful @@ -84,8 +86,8 @@ -- ^ Name of primitive -> [Either Term Type] -- ^ Arguments - -> Type - -- ^ Result type + -> [Type] + -- ^ Result types -> NetlistMonad (Either String (BlackBoxMeta, BlackBox)) -- | A BlackBox Template is a List of Elements @@ -108,10 +110,10 @@ -- ^ Dumps given text without processing in HDL | Component !Decl -- ^ Component instantiation hole - | Result !Bool - -- ^ Output hole; @Bool@ asserts escape marker stripping - | Arg !Bool !Int - -- ^ Input hole; @Bool@ asserts escape marker stripping + | Result + -- ^ Output hole; + | Arg !Int + -- ^ Input hole | ArgGen !Int !Int -- ^ Like Arg, but its first argument is the scoping level. For use in -- in generated code only. @@ -182,6 +184,11 @@ | IsActiveEnable !Int -- ^ Whether given enable line is active. More specifically, whether the -- enable line is NOT set to a constant 'True'. + | IsUndefined !Int + -- ^ Whether argument is undefined. E.g., an XException, error call, + -- removed argument, or primitive that is undefined. This template tag will + -- always return 0 (False) if `-fclash-aggressive-x-optimization-blackboxes` + -- is NOT set. | StrCmp [Element] !Int | OutputWireReg !Int | Vars !Int diff --git a/src/Clash/Netlist/BlackBox/Util.hs b/src/Clash/Netlist/BlackBox/Util.hs --- a/src/Clash/Netlist/BlackBox/Util.hs +++ b/src/Clash/Netlist/BlackBox/Util.hs @@ -12,6 +12,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -23,6 +24,7 @@ import Control.Monad (forM) import Control.Monad.State (State, StateT (..), lift) import Data.Bool (bool) +import Data.Coerce (coerce) import Data.Foldable (foldrM) import Data.Hashable (Hashable (..)) import qualified Data.IntMap as IntMap @@ -44,25 +46,24 @@ import Text.Read (readEither) import Text.Trifecta.Result hiding (Err) -import Clash.Backend (Backend (..), Usage (..), mkUniqueIdentifier) -import qualified Clash.Backend as Backend +import Clash.Backend + (Backend (..), Usage (..), AggressiveXOptBB(..)) import Clash.Netlist.BlackBox.Parser import Clash.Netlist.BlackBox.Types -import Clash.Netlist.Id (IdType (..)) -import Clash.Netlist.Types (BlackBoxContext (..), - Expr (..), HWType (..), - Identifier, Literal (..), - Modifier (..), - Declaration(BlackBoxD)) +import Clash.Netlist.Types + (BlackBoxContext (..), Expr (..), HWType (..), Literal (..), Modifier (..), + Declaration(BlackBoxD)) +import qualified Clash.Netlist.Id as Id import qualified Clash.Netlist.Types as N import Clash.Netlist.Util (typeSize, isVoid, stripVoid) import Clash.Signal.Internal (ResetKind(..), ResetPolarity(..), InitBehavior(..)) import Clash.Util +import qualified Clash.Util.Interpolate as I inputHole :: Element -> Maybe Int inputHole = \case - Arg _ n -> pure n + Arg n -> pure n Lit n -> pure n Const n -> pure n Name n -> pure n @@ -144,12 +145,11 @@ -- counter for every newly encountered symbol. setSym :: forall m - . Monad m - => (IdType -> Identifier -> m Identifier) - -> BlackBoxContext + . Id.IdentifierSetMonad m + => BlackBoxContext -> BlackBoxTemplate -> m (BlackBoxTemplate,[N.Declaration]) -setSym mkUniqueIdentifierM bbCtx l = do +setSym bbCtx l = do (a,(_,decls)) <- runStateT (mapM setSym' l) (IntMap.empty,IntMap.empty) return (a,concatMap snd (IntMap.elems decls)) where @@ -157,33 +157,34 @@ setSym' :: Element - -> StateT ( IntMap.IntMap Identifier - , IntMap.IntMap (Identifier,[N.Declaration])) + -> StateT ( IntMap.IntMap N.IdentifierText + , IntMap.IntMap (N.IdentifierText, [N.Declaration])) m Element setSym' e = case e of ToVar nm i | i < length (bbInputs bbCtx) -> case bbInputs bbCtx !! i of - (Identifier nm' Nothing,_,_) -> - return (ToVar [Text (Text.fromStrict nm')] i) + (Identifier nm0 Nothing,_,_) -> + return (ToVar [Text (Id.toLazyText nm0)] i) (e',hwTy,_) -> do varM <- IntMap.lookup i <$> use _2 case varM of Nothing -> do - nm' <- lift (mkUniqueIdentifierM Extended (Text.toStrict (concatT (Text "c$":nm)))) + nm' <- lift (Id.make (Text.toStrict (concatT (Text "c$":nm)))) let decls = case typeSize hwTy of 0 -> [] _ -> [N.NetDecl Nothing nm' hwTy ,N.Assignment nm' e' ] - _2 %= (IntMap.insert i (nm',decls)) + _2 %= (IntMap.insert i (Id.toText nm',decls)) + return (ToVar [Text (Id.toLazyText nm')] i) + Just (nm',_) -> return (ToVar [Text (Text.fromStrict nm')] i) - Just (nm',_) -> return (ToVar [Text (Text.fromStrict nm')] i) Sym _ i -> do symM <- IntMap.lookup i <$> use _1 case symM of Nothing -> do - t <- lift (mkUniqueIdentifierM Extended "c$n") + t <- Id.toText <$> lift (Id.make "c$n") _1 %= (IntMap.insert i t) return (Sym (Text.fromStrict t) i) Just t -> return (Sym (Text.fromStrict t) i) @@ -191,7 +192,7 @@ symM <- IntMap.lookup i <$> use _1 case symM of Nothing -> do - t' <- lift (mkUniqueIdentifierM Basic (Text.toStrict (concatT t))) + t' <- Id.toText <$> lift (Id.makeBasic (Text.toStrict (concatT t))) _1 %= (IntMap.insert i t') return (GenSym [Text (Text.fromStrict t')] i) Just _ -> @@ -223,12 +224,12 @@ error $ $(curLoc) ++ "Could not convert ~LIT[" ++ show i ++ "]" ++ " to string:" ++ msg ++ "\n\nError occured while " ++ "processing blackbox for " ++ bbnm - Result _ | Identifier t _ <- fst (bbResult bbCtx) -> Text.fromStrict t - CompName -> Text.fromStrict (bbCompName bbCtx) + Result | [(Identifier t _, _)] <- bbResults bbCtx -> Id.toLazyText t + CompName -> Id.toLazyText (bbCompName bbCtx) CtxName -> case bbCtxName bbCtx of Just nm -> Text.fromStrict nm - _ | Identifier t _ <- fst (bbResult bbCtx) -> Text.fromStrict t + _ | [(Identifier t _, _)] <- bbResults bbCtx -> Id.toLazyText t _ -> error $ $(curLoc) ++ "Internal error when processing blackbox " ++ "for " ++ bbnm _ -> error $ $(curLoc) ++ "Unexpected element in GENSYM when processing " @@ -331,7 +332,7 @@ , show (subN +1 ), " got only ", show (length (fromJust func0)) ] func1 = indexNote' errr subN <$> func0 Just (templ0,_,libs,imps,inc,pCtx) = func1 - b' = pCtx { bbResult = (o,oTy), bbInputs = bbInputs pCtx ++ is } + b' = pCtx { bbResults = [(o,oTy)], bbInputs = bbInputs pCtx ++ is } layoutOptions = LayoutOptions (AvailablePerLine 120 0.4) render = N.BBTemplate . parseFail . renderLazy . layoutPretty layoutOptions @@ -340,7 +341,7 @@ Left t -> return t Right (nm0,ds) -> do - nm1 <- mkUniqueIdentifier Basic nm0 + nm1 <- Id.next nm0 block <- getMon (blockDecl nm1 ds) return (render block) @@ -349,13 +350,13 @@ N.BBFunction {} -> return templ1 N.BBTemplate templ2 -> do - (templ3, templDecls) <- setSym Backend.mkUniqueIdentifier b' templ2 + (templ3, templDecls) <- setSym b' templ2 case templDecls of [] -> return (N.BBTemplate templ3) _ -> do - nm1 <- Backend.mkUniqueIdentifier Basic "bb" - nm2 <- Backend.mkUniqueIdentifier Basic "bb" + nm1 <- Id.toText <$> Id.makeBasic "bb" + nm2 <- Id.makeBasic "bb" let bbD = BlackBoxD nm1 libs imps inc (N.BBTemplate templ3) b' block <- getMon (blockDecl nm2 (templDecls ++ [bbD])) return (render block) @@ -374,7 +375,7 @@ renderElem b (SigD e m) = do e' <- Text.concat <$> mapM (fmap ($ 0) . renderElem b) e let ty = case m of - Nothing -> snd $ bbResult b + Nothing -> snd $ bbResult "~SIGD" b Just n -> let (_,ty',_) = bbInputs b !! n in ty' t <- getMon (hdlSig e' ty) @@ -393,9 +394,11 @@ case stripVoid ty of KnownDomain dom _ _ _ _ _ -> return (const (Text.pack (Data.Text.unpack dom))) + Clock dom -> + return (const (Text.pack (Data.Text.unpack dom))) Reset dom -> return (const (Text.pack (Data.Text.unpack dom))) - Clock dom -> + Enable dom -> return (const (Text.pack (Data.Text.unpack dom))) _ -> error $ $(curLoc) ++ "Tag: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty @@ -404,10 +407,12 @@ renderElem b (IF c t f) = do iw <- iwWidth syn <- hdlSyn - let c' = check iw syn c + xOpt <- aggressiveXOptBB + let c' = check (coerce xOpt) iw syn c if c' > 0 then renderTemplate b t else renderTemplate b f where - check iw syn c' = case c' of + check :: Bool -> Int -> HdlSyn -> Element -> Int + check xOpt iw syn c' = case c' of (Size e) -> typeSize (lineToType b [e]) (Length e) -> case lineToType b [e] of (Vector n _) -> n @@ -446,15 +451,22 @@ BlackBoxE {} -> 1 _ -> 0 + (IsUndefined n) -> + let (e, _, _) = bbInputs b !! n in + case (xOpt, e) of + (True, BlackBoxE _ _ _ _ (N.BBTemplate [Err _]) _ _) -> 1 + _ -> 0 + (IsActiveEnable n) -> let (e, ty, _) = bbInputs b !! n in case (e, ty) of - (Literal Nothing (BoolLit True), Bool) -> 0 + (Literal Nothing (BoolLit True), Enable {}) -> 0 -- TODO: Emit warning? If enable signal is inferred as always False, -- TODO: the component will never be enabled. This is probably not the -- TODO: user's intention. - (Literal Nothing (BoolLit False), Bool) -> 1 - (_, Bool) -> 1 + (Literal Nothing (BoolLit False), Enable {}) -> 1 + (_, Bool) -> 1 + (_, Enable _) -> 1 _ -> error $ $(curLoc) ++ "IsActiveEnable: Expected Bool, not: " ++ show ty @@ -494,10 +506,10 @@ | t1 == Text.pack t2 -> 1 | otherwise -> 0 Nothing -> error $ $(curLoc) ++ "Expected a string literal: " ++ show e - (And es) -> if all (/=0) (map (check iw syn) es) + (And es) -> if all (/=0) (map (check xOpt iw syn) es) then 1 else 0 - CmpLE e1 e2 -> if check iw syn e1 <= check iw syn e2 + CmpLE e1 e2 -> if check xOpt iw syn e1 <= check xOpt iw syn e2 then 1 else 0 _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGTH, IW64, LIT, ISLIT, or ISARG" @@ -511,10 +523,17 @@ Success templ -> templ idToExpr - :: (Text,HWType) - -> (Expr,HWType,Bool) -idToExpr (t,ty) = (Identifier (Text.toStrict t) Nothing,ty,False) + :: (Text, HWType) + -> (Expr, HWType, Bool) +idToExpr (t, ty) = + (Identifier (Id.unsafeMake (Text.toStrict t)) Nothing, ty, False) +bbResult :: HasCallStack => String -> BlackBoxContext -> (Expr, HWType) +bbResult _s (bbResults -> [r]) = r +bbResult s ctx = error [I.i| + Multi result primitives not supported when using template tag #{s}. Tag used + in blackbox implementation of #{bbName ctx} |] + -- | Fill out the template corresponding to an output/input assignment of a -- component instantiation, and turn it into a single identifier so it can -- be used for a new blackbox context. @@ -530,7 +549,7 @@ lineToType :: BlackBoxContext -> BlackBoxTemplate -> HWType -lineToType b [(Typ Nothing)] = snd $ bbResult b +lineToType b [(Typ Nothing)] = snd $ bbResult "~TYPO" b lineToType b [(Typ (Just n))] = let (_,ty,_) = bbInputs b !! n in ty lineToType b [(TypElem t)] = case lineToType b [t] of @@ -550,13 +569,11 @@ -> Element -> State backend Text renderTag _ (Text t) = return t -renderTag b (Result esc) = do - escape <- if esc then unextend else pure id - fmap (Text.fromStrict . escape . Text.toStrict . renderOneLine) . getMon . expr False . fst $ bbResult b -renderTag b (Arg esc n) = do +renderTag b (Result) = do + fmap renderOneLine . getMon . expr False . fst $ bbResult "~RESULT" b +renderTag b (Arg n) = do let (e,_,_) = bbInputs b !! n - escape <- if esc then unextend else pure id - (Text.fromStrict . escape . Text.toStrict . renderOneLine) <$> getMon (expr False e) + renderOneLine <$> getMon (expr False e) renderTag b (Const n) = do let (e,_,_) = bbInputs b !! n @@ -602,13 +619,13 @@ let ty = lineToType b [e] in renderOneLine <$> getMon (hdlRecSel ty n) -renderTag b (Typ Nothing) = fmap renderOneLine . getMon . hdlType Internal . snd $ bbResult b +renderTag b (Typ Nothing) = fmap renderOneLine . getMon . hdlType Internal . snd $ bbResult "~TYPO" b renderTag b (Typ (Just n)) = let (_,ty,_) = bbInputs b !! n in renderOneLine <$> getMon (hdlType Internal ty) -renderTag b (TypM Nothing) = fmap renderOneLine . getMon . hdlTypeMark . snd $ bbResult b +renderTag b (TypM Nothing) = fmap renderOneLine . getMon . hdlTypeMark . snd $ bbResult "~TYPMO" b renderTag b (TypM (Just n)) = let (_,ty,_) = bbInputs b !! n in renderOneLine <$> getMon (hdlTypeMark ty) -renderTag b (Err Nothing) = fmap renderOneLine . getMon . hdlTypeErrValue . snd $ bbResult b +renderTag b (Err Nothing) = fmap renderOneLine . getMon . hdlTypeErrValue . snd $ bbResult "~ERRORO" b renderTag b (Err (Just n)) = let (_,ty,_) = bbInputs b !! n in renderOneLine <$> getMon (hdlTypeErrValue ty) renderTag b (Size e) = return . Text.pack . show . typeSize $ lineToType b [e] @@ -708,12 +725,12 @@ source <- elementsToText b sourceL return (Text.unpack filename, Text.unpack source) -renderTag b CompName = pure (Text.fromStrict (bbCompName b)) +renderTag b CompName = pure (Id.toLazyText (bbCompName b)) renderTag b CtxName = case bbCtxName b of Just nm -> return (Text.fromStrict nm) - _ | Identifier t _ <- fst (bbResult b) - -> return (Text.fromStrict t) + _ | Identifier t _ <- fst (bbResult "~CTXNAME" b) + -> return (Id.toLazyText t) _ -> error "internal error" @@ -763,11 +780,13 @@ exprToString (Literal _ (NumLit i)) = Just (show i) exprToString (Literal _ (StringLit l)) = Just l exprToString (BlackBoxE "Clash.Promoted.Symbol.SSymbol" _ _ _ _ ctx _) = - let (e',_,_) = head (bbInputs ctx) - in exprToString e' + case bbInputs ctx of + (e0,_,_):_ -> exprToString e0 + _ -> error "internal error: insufficient bbInputs" exprToString (BlackBoxE "GHC.CString.unpackCString#" _ _ _ _ ctx _) = - let (e',_,_) = head (bbInputs ctx) - in exprToString e' + case bbInputs ctx of + (e0,_,_):_ -> exprToString e0 + _ -> error "internal error: insufficient bbInputs" exprToString _ = Nothing prettyBlackBox :: Monad m @@ -782,15 +801,18 @@ prettyElem (Text t) = return t prettyElem (Component (Decl i 0 args)) = do args' <- mapM (\(a,b) -> (,) <$> prettyBlackBox a <*> prettyBlackBox b) args - renderOneLine <$> - (nest 2 (string "~INST" <+> int i <> line <> - string "~OUTPUT" <+> string "=>" <+> string (fst (head args')) <+> string (snd (head args')) <+> string "~" <> line <> - vcat (mapM (\(a,b) -> string "~INPUT" <+> string "=>" <+> string a <+> string b <+> string "~") (tail args'))) - <> line <> string "~INST") + case args' of + (arg:rest) -> + renderOneLine <$> + (nest 2 (string "~INST" <+> int i <> line <> + string "~OUTPUT" <+> string "=>" <+> string (fst arg) <+> string (snd arg) <+> string "~" <> line <> + vcat (mapM (\(a,b) -> string "~INPUT" <+> string "=>" <+> string a <+> string b <+> string "~") rest)) + <> line <> string "~INST") + _ -> error "internal error: insufficient args" prettyElem (Component (Decl {})) = error $ $(curLoc) ++ "prettyElem can't (yet) render ~INST when subfuncion /= 0!" -prettyElem (Result b) = if b then return "~ERESULT" else return "~RESULT" -prettyElem (Arg b i) = renderOneLine <$> (if b then string "~EARG" else string "~ARG" <> brackets (int i)) +prettyElem Result = return "~RESULT" +prettyElem (Arg i) = renderOneLine <$> ("~ARG" <> brackets (int i)) prettyElem (Lit i) = renderOneLine <$> (string "~LIT" <> brackets (int i)) prettyElem (Const i) = renderOneLine <$> (string "~CONST" <> brackets (int i)) prettyElem (Name i) = renderOneLine <$> (string "~NAME" <> brackets (int i)) @@ -864,6 +886,7 @@ prettyElem (IsVar i) = renderOneLine <$> (string "~ISVAR" <> brackets (int i)) prettyElem (IsActiveHigh i) = renderOneLine <$> (string "~ISACTIVEHIGH" <> brackets (int i)) prettyElem (IsActiveEnable i) = renderOneLine <$> (string "~ISACTIVEENABLE" <> brackets (int i)) +prettyElem (IsUndefined i) = renderOneLine <$> (string "~ISUNDEFINED" <> brackets (int i)) -- Domain attributes: prettyElem (Tag i) = renderOneLine <$> (string "~TAG" <> brackets (int i)) @@ -940,8 +963,8 @@ GenSym es _ -> concatMap go es DevNull es -> concatMap go es Text _ -> [] - Result _ -> [] - Arg _ _ -> [] + Result -> [] + Arg _ -> [] ArgGen _ _ -> [] Const _ -> [] Lit _ -> [] @@ -973,6 +996,7 @@ IsInitDefined _ -> [] IsActiveHigh _ -> [] IsActiveEnable _ -> [] + IsUndefined _ -> [] StrCmp es _ -> concatMap go es OutputWireReg _ -> [] Vars _ -> [] @@ -982,17 +1006,18 @@ -- | Determine variables used in an expression. Used for VHDL sensitivity list. -- Also see: https://github.com/clash-lang/clash-compiler/issues/365 -usedVariables :: Expr -> [Identifier] +usedVariables :: Expr -> [N.IdentifierText] usedVariables Noop = [] -usedVariables (Identifier i _) = [i] +usedVariables (Identifier i _) = [Id.toText i] usedVariables (DataCon _ _ es) = concatMap usedVariables es -usedVariables (DataTag _ e') = [either id id e'] +usedVariables (DataTag _ e') = [Id.toText (either id id e')] usedVariables (Literal {}) = [] -usedVariables (ConvBV _ _ _ e') = usedVariables e' +usedVariables (ToBv _ _ e') = usedVariables e' +usedVariables (FromBv _ _ e') = usedVariables e' usedVariables (IfThenElse e1 e2 e3) = concatMap usedVariables [e1,e2,e3] usedVariables (BlackBoxE _ _ _ _ t bb _) = nub (sList ++ sList') where - matchArg (Arg _ i) = Just i + matchArg (Arg i) = Just i matchArg _ = Nothing matchVar (ToVar [Text v] _) = Just (Text.toStrict v) @@ -1010,11 +1035,12 @@ where matchArg = \case - Arg _ i -> Just i + Arg i -> Just i Component (Decl i _ _) -> Just i Const i -> Just i IsLit i -> Just i IsActiveEnable i -> Just i + IsUndefined i -> Just i Lit i -> Just i Name i -> Just i ToVar _ i -> Just i @@ -1050,7 +1076,7 @@ MaxIndex _ -> Nothing OutputWireReg _ -> Nothing Repeat _ _ -> Nothing - Result _ -> Nothing + Result -> Nothing Sel _ _ -> Nothing SigD _ _ -> Nothing Size _ -> Nothing diff --git a/src/Clash/Netlist/Id.hs b/src/Clash/Netlist/Id.hs --- a/src/Clash/Netlist/Id.hs +++ b/src/Clash/Netlist/Id.hs @@ -1,117 +1,241 @@ {-| - Copyright : (C) 2012-2016, University of Twente + Copyright : (C) 2020, QBayLogic B.V. License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. Transform/format a Netlist Identifier so that it is acceptable as a HDL identifier -} {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Clash.Netlist.Id - ( IdType (..) - , mkBasicId' - , stripDollarPrefixes + ( -- * Utilities to use IdentifierSet + IdentifierSet + , IdentifierSetMonad(..) + , HasIdentifierSet(..) + , emptyIdentifierSet + , makeSet + , clearSet + + -- * Unsafe creation and extracting identifiers + , Identifier + , IdentifierType (..) + , unsafeMake + , toText + , toLazyText + , toList + , union + + -- * Creating and extending identifiers + , make + , makeBasic + , makeBasicOr + , makeAs + , add + , addMultiple + , addRaw + , deepen + , deepenN + , next + , nextN + , prefix + , suffix + , fromCoreId + + -- * Misc. and internals + , VHDL.stripDollarPrefixes + , toBasicId# + , isBasic# + , isExtended# ) where -import Clash.Annotations.Primitive (HDL (..)) -import Data.Char (isAsciiLower,isAsciiUpper,isDigit) -import Data.Text as Text +import Clash.Annotations.Primitive (HDL (..)) +import Clash.Core.Var (Id) +import Clash.Debug (debugIsOn) +import {-# SOURCE #-} Clash.Netlist.Types + (PreserveCase(..), HasIdentifierSet(..), IdentifierSet(..), Identifier(..), + IdentifierType(..), IdentifierSetMonad(identifierSetM)) +import qualified Data.HashSet as HashSet +import qualified Data.HashMap.Strict as HashMap +import qualified Data.IntMap.Strict as IntMap +import qualified Data.List as List +import Data.Text (Text) +import qualified Data.Text.Lazy as LT +import GHC.Stack -data IdType = Basic | Extended +import qualified Clash.Netlist.Id.VHDL as VHDL +import Clash.Netlist.Id.Internal -mkBasicId' - :: HDL - -> Bool - -> Text - -> Text -mkBasicId' hdl tupEncode = stripMultiscore hdl . stripLeading hdl . zEncode hdl tupEncode - where - stripLeading VHDL = Text.dropWhile (`elem` ('_':['0'..'9'])) - stripLeading _ = Text.dropWhile (`elem` ('$':['0'..'9'])) - stripMultiscore VHDL - = Text.concat - . Prelude.map (\cs -> case Text.head cs of - '_' -> "_" - _ -> cs - ) - . Text.group - stripMultiscore _ = id +-- | Identifier set without identifiers +emptyIdentifierSet + :: Bool + -- ^ Allow escaped identifiers? + -> PreserveCase + -- ^ Should all basic identifiers be lower case? + -> HDL + -- ^ HDL to generate names for + -> IdentifierSet +emptyIdentifierSet esc lw hdl = makeSet esc lw hdl mempty -stripDollarPrefixes :: Text -> Text -stripDollarPrefixes = stripWorkerPrefix . stripSpecPrefix . stripConPrefix - . stripWorkerPrefix . stripDictFunPrefix - where - stripDictFunPrefix t = case Text.stripPrefix "$f" t of - Just k -> takeWhileEnd (/= '_') k - Nothing -> t +-- | Union of two identifier sets. Errors if given sets have been made with +-- different options enabled. +union :: HasCallStack => IdentifierSet -> IdentifierSet -> IdentifierSet +union (IdentifierSet escL lwL hdlL freshL idsL) (IdentifierSet escR lwR hdlR freshR idsR) + | escL /= escR = error $ "Internal error: escL /= escR, " <> show (escL, escR) + | hdlL /= hdlR = error $ "Internal error: hdlL /= hdlR, " <> show (hdlL, hdlR) + | lwL /= lwR = error $ "Internal error: lwL /= lwR , " <> show (lwL, lwR) + | otherwise = IdentifierSet escR lwR hdlR fresh ids + where + fresh = HashMap.unionWith (IntMap.unionWith max) freshL freshR + ids = HashSet.union idsL idsR - stripWorkerPrefix t = case Text.stripPrefix "$w" t of - Just k -> k - Nothing -> t +-- | Make a identifier set filled with given identifiers +makeSet + :: Bool + -- ^ Allow escaped identifiers? + -> PreserveCase + -- ^ Should all basic identifiers be lower case? + -> HDL + -- ^ HDL to generate names for + -> HashSet.HashSet Identifier + -- ^ Identifiers to add to set + -> IdentifierSet +makeSet esc lw hdl ids = IdentifierSet esc lw hdl fresh ids + where + fresh = List.foldl' updateFreshCache# mempty ids - stripConPrefix t = case Text.stripPrefix "$c" t of - Just k -> k - Nothing -> t +-- | Remove all identifiers from a set +clearSet :: IdentifierSet -> IdentifierSet +clearSet (IdentifierSet escL lwL hdlL _ _) = + IdentifierSet escL lwL hdlL mempty mempty - stripSpecPrefix t = case Text.stripPrefix "$s" t of - Just k -> k - Nothing -> t -- snd (Text.breakOnEnd "$s" t) +toList :: IdentifierSet -> [Identifier] +toList (IdentifierSet _ _ _ _ idStore) = HashSet.toList idStore +-- | Convert an identifier to string. Use 'unmake' if you need the +-- "IdentifierType" too. +toText :: Identifier -> Text +toText = toText# -type UserString = Text -- As the user typed it -type EncodedString = Text -- Encoded form +-- | Convert an identifier to string. Use 'unmake' if you need the +-- "IdentifierType" too. +toLazyText :: Identifier -> LT.Text +toLazyText = LT.fromStrict . toText -zEncode :: HDL -> Bool -> UserString -> EncodedString -zEncode hdl False cs = go (uncons cs) - where - go Nothing = empty - go (Just (c,cs')) = append (encodeDigitCh hdl c) (go' $ uncons cs') - go' Nothing = empty - go' (Just (c,cs')) = append (encodeCh hdl c) (go' $ uncons cs') +-- | Helper function to define pure Id functions in terms of a IdentifierSetMonad +withIdentifierSetM' + :: IdentifierSetMonad m + => (IdentifierSet -> a -> IdentifierSet) + -> a + -> m () +withIdentifierSetM' f a = do + is0 <- identifierSetM id + identifierSetM (const (f is0 a)) >> pure () -zEncode hdl True cs = case maybeTuple cs of - Just (n,cs') -> append n (go' (uncons cs')) - Nothing -> go (uncons cs) - where - go Nothing = empty - go (Just (c,cs')) = append (encodeDigitCh hdl c) (go' $ uncons cs') - go' Nothing = empty - go' (Just (c,cs')) = case maybeTuple (cons c cs') of - Just (n,cs2) -> append n (go' $ uncons cs2) - Nothing -> append (encodeCh hdl c) (go' $ uncons cs') +-- | Helper function to define pure Id functions in terms of a IdentifierSetMonad +withIdentifierSetM + :: IdentifierSetMonad m + => (IdentifierSet -> a -> (IdentifierSet, b)) + -> a + -> m b +withIdentifierSetM f a = do + is0 <- identifierSetM id + let (is1, b) = f is0 a + _ <- identifierSetM (const is1) + pure b -encodeDigitCh :: HDL -> Char -> EncodedString -encodeDigitCh _ c | isDigit c = Text.empty -- encodeAsUnicodeChar c -encodeDigitCh hdl c = encodeCh hdl c +-- | Like 'addRaw', 'unsafeMake' creates an identifier that will be spliced +-- at verbatim in the HDL. As opposed to 'addRaw', the resulting Identifier +-- might be generated at a later point as it is NOT added to an IdentifierSet. +unsafeMake :: HasCallStack => Text -> Identifier +unsafeMake t = + RawIdentifier t Nothing (if debugIsOn then callStack else emptyCallStack) -encodeCh :: HDL -> Char -> EncodedString -encodeCh hdl c | unencodedChar hdl c = singleton c -- Common case first - | otherwise = Text.empty +-- | Add an identifier to an IdentifierSet +add :: HasCallStack => IdentifierSetMonad m => Identifier -> m () +add = withIdentifierSetM' add# -unencodedChar :: HDL -> Char -> Bool -- True for chars that don't need encoding -unencodedChar hdl c = - or [ isAsciiLower c - , isAsciiUpper c - , isDigit c - , if hdl == VHDL then c == '_' else c `elem` ['_','$'] - ] +-- | Add identifiers to an IdentifierSet +addMultiple :: (HasCallStack, IdentifierSetMonad m, Foldable t) => t Identifier -> m () +addMultiple = withIdentifierSetM' addMultiple# -maybeTuple :: UserString -> Maybe (EncodedString,UserString) -maybeTuple "(# #)" = Just ("Unit",empty) -maybeTuple "()" = Just ("Unit",empty) -maybeTuple (uncons -> Just ('(',uncons -> Just ('#',cs))) = - case countCommas 0 cs of - (n,uncons -> Just ('#',uncons -> Just (')',cs'))) -> Just (pack ("Tup" ++ show (n+1)),cs') - _ -> Nothing -maybeTuple (uncons -> Just ('(',cs)) = - case countCommas 0 cs of - (n,uncons -> Just (')',cs')) -> Just (pack ("Tup" ++ show (n+1)),cs') - _ -> Nothing -maybeTuple _ = Nothing +-- | Add a string as is to an IdentifierSet. Should only be used for identifiers +-- that should be spliced at verbatim in HDL, such as port names. It's sanitized +-- version will still be added to the identifier set, to prevent freshly +-- generated variables clashing with the raw one. +addRaw :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier +addRaw = withIdentifierSetM addRaw# -countCommas :: Int -> UserString -> (Int,UserString) -countCommas n (uncons -> Just (',',cs)) = countCommas (n+1) cs -countCommas n cs = (n,cs) +-- | Make unique identifier based on given string +make :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier +make = withIdentifierSetM make# + +-- | Make unique basic identifier based on given string +makeBasic :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier +makeBasic = withIdentifierSetM makeBasic# + +-- | Make unique basic identifier based on given string. If given string can't +-- be converted to a basic identifier (i.e., it would yield an empty string) the +-- alternative name is used. +makeBasicOr + :: (HasCallStack, IdentifierSetMonad m) + => Text + -- ^ Name hint + -> Text + -- ^ If name hint can't be converted to a sensible basic id, use this instead + -> m Identifier +makeBasicOr hint altHint = + withIdentifierSetM + (\is0 -> uncurry (makeBasicOr# is0)) + (hint, altHint) + +-- | Make unique identifier. Uses 'makeBasic' if first argument is 'Basic' +makeAs :: (HasCallStack, IdentifierSetMonad m) => IdentifierType -> Text -> m Identifier +makeAs Basic = makeBasic +makeAs Extended = make + +-- | Given identifier "foo_1_2" return "foo_1_3". If "foo_1_3" is already a +-- member of the given set, return "foo_1_4" instead, etc. Identifier returned +-- is guaranteed to be unique. +next :: (HasCallStack, IdentifierSetMonad m) => Identifier -> m Identifier +next = withIdentifierSetM next# + +-- | Same as 'nextM', but returns N fresh identifiers +nextN :: (HasCallStack, IdentifierSetMonad m) => Int -> Identifier -> m [Identifier] +nextN n = withIdentifierSetM (nextN# n) + +-- | Given identifier "foo_1_2" return "foo_1_2_0". If "foo_1_2_0" is already a +-- member of the given set, return "foo_1_2_1" instead, etc. Identifier returned +-- is guaranteed to be unique. +deepen :: (HasCallStack, IdentifierSetMonad m) => Identifier -> m Identifier +deepen = withIdentifierSetM deepen# + +-- | Same as 'deepenM', but returns N fresh identifiers. For example, given +-- "foo_23" is would return "foo_23_0", "foo_23_1", ... +deepenN :: (HasCallStack, IdentifierSetMonad m) => Int -> Identifier -> m [Identifier] +deepenN n = withIdentifierSetM (deepenN# n) + +-- | Given identifier "foo_1_2" and a suffix "bar", return an identifier called +-- "foo_bar". Identifier returned is guaranteed to be unique according to the +-- rules of 'nextIdentifier'. +suffix :: (HasCallStack, IdentifierSetMonad m) => Identifier -> Text -> m Identifier +suffix id0 suffix_ = withIdentifierSetM (\is id1 -> suffix# is id1 suffix_) id0 + +-- | Given identifier "foo_1_2" and a prefix "bar", return an identifier called +-- "bar_foo". Identifier returned is guaranteed to be unique according to the +-- rules of 'nextIdentifier'. +prefix :: (HasCallStack, IdentifierSetMonad m) => Identifier -> Text -> m Identifier +prefix id0 prefix_ = withIdentifierSetM (\is id1 -> prefix# is id1 prefix_) id0 + +-- | Convert a Clash Core Id to an identifier. Makes sure returned identifier +-- is unique. +fromCoreId :: (HasCallStack, IdentifierSetMonad m) => Id -> m Identifier +fromCoreId = withIdentifierSetM fromCoreId# diff --git a/src/Clash/Netlist/Id.hs-boot b/src/Clash/Netlist/Id.hs-boot new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id.hs-boot @@ -0,0 +1,6 @@ +module Clash.Netlist.Id where + +import {-# SOURCE #-} Clash.Netlist.Types (Identifier) +import Data.Text (Text) + +toText :: Identifier -> Text diff --git a/src/Clash/Netlist/Id/Common.hs b/src/Clash/Netlist/Id/Common.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id/Common.hs @@ -0,0 +1,108 @@ +{-| + Copyright : (C) 2020, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. )) +import Control.Applicative.Extra (orEmpty) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Char as Char +import TextShow (showt) + +parseWhiteSpace :: Text -> Maybe Text +parseWhiteSpace = parseSingle isWhiteSpace + +isWhiteSpace :: Char -> Bool +isWhiteSpace c = c `elem` [' ', '\n', '\t'] + +parsePrintable :: Text -> Maybe Text +parsePrintable = parseSingle (\c -> Char.isPrint c && Char.isAscii c) + +parseSingle :: (Char -> Bool) -> Text -> Maybe Text +parseSingle predicate s = do + (l, ls) <- Text.uncons s + orEmpty (predicate l) ls + +parseMaybeSingle :: (Char -> Bool) -> Text -> Maybe Text +parseMaybeSingle predicate s = Just (fromMaybe s (parseSingle predicate s)) + +parseLetter :: Text -> Maybe Text +parseLetter = parseSingle (\c -> Char.isAscii c && Char.isLetter c) + +parseDigit :: Text -> Maybe Text +parseDigit = parseSingle Char.isDigit + +parseLetterOrDigit :: Text -> Maybe Text +parseLetterOrDigit s = parseLetter s <|> parseDigit s + +parseUnderscore :: Text -> Maybe Text +parseUnderscore = parseSingle (=='_') + +parseDollar :: Text -> Maybe Text +parseDollar = parseSingle (=='$') + +parseTab :: Text -> Maybe Text +parseTab = parseSingle (=='\t') + +parseBackslash :: Text -> Maybe Text +parseBackslash = parseSingle (=='\\') + +failNonEmpty :: Text -> Maybe Text +failNonEmpty s | Text.null s = Just Text.empty + | otherwise = Nothing + +repeatParseN :: (Text -> Maybe Text) -> Text -> Maybe (Int, Text) +repeatParseN parser = go 0 + where + go n s0 = + case parser s0 of + Just s1 -> go (n+1) s1 + Nothing -> Just (n, s0) + +repeatParse :: (Text -> Maybe Text) -> Text -> Maybe Text +repeatParse parser s0 = snd <$> repeatParseN parser s0 + +-- | Encodes tuples as "TupN" and removes all characters not matching a +-- predicate. +zEncode + :: (Char -> Bool) + -- ^ Characters to keep + -> Text + -> Text +zEncode keep s = + let go = zEncode keep in + case maybeTuple s of + Just (tupName, rest) -> + tupName <> go rest + Nothing -> + case Text.uncons s of + Just (c, rest) -> + if keep c then + Text.cons c (go rest) + else + go rest + Nothing -> s + +prettyName :: Text -> Text +prettyName t = maybe t (uncurry (<>)) (maybeTuple t) + +maybeTuple :: Text -> Maybe (Text, Text) +maybeTuple "(# #)" = Just ("Unit", "") +maybeTuple "()" = Just ("Unit", "") +maybeTuple t = first (\n -> "Tup" <> showt n) <$> parseTuple t + +parseTuple :: Text -> Maybe (Int, Text) +parseTuple t0 = do + t1 <- parseSingle (=='(') t0 + t2 <- parseMaybeSingle (=='#') t1 + (n, t3) <- repeatParseN (parseSingle (== ',')) t2 + t4 <- parseMaybeSingle (=='#') t3 + t5 <- parseSingle (==')') t4 + pure (n+1, t5) diff --git a/src/Clash/Netlist/Id/Internal.hs b/src/Clash/Netlist/Id/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id/Internal.hs @@ -0,0 +1,251 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Clash.Netlist.Id.Internal where + +import Clash.Annotations.Primitive (HDL (..)) +import Clash.Core.Name (Name(nameOcc)) +import Clash.Core.Var (Id, varName) +import Clash.Debug (debugIsOn) +import {-# SOURCE #-} Clash.Netlist.Types + (PreserveCase(..), IdentifierSet(..), Identifier(..), FreshCache, + IdentifierType(..)) +import Control.Arrow (second) +import qualified Data.Char as Char +import qualified Data.List as List +import qualified Data.Text.Prettyprint.Doc as PP +import qualified Data.Text as Text +import Data.Text (Text) +import qualified Data.Maybe as Maybe +import Text.Read (readMaybe) +import TextShow (showt) +import GHC.Stack + +import qualified Data.IntMap as IntMap +import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashSet as HashSet + +import qualified Clash.Netlist.Id.SystemVerilog as SystemVerilog +import qualified Clash.Netlist.Id.Verilog as Verilog +import qualified Clash.Netlist.Id.VHDL as VHDL +import qualified Clash.Netlist.Id.Common as Common + +-- | Return identifier with highest extension for given identifier. See +-- 'is_freshCache' for more information. +-- +-- For example, if the FreshCache contains "foo_12_25" and the given identifier +-- is "foo_12_13" this function would return "Just 25". In this case, "foo_12_26" +-- is guaranteed to be a fresh identifier. +lookupFreshCache# :: FreshCache -> Identifier -> Maybe Word +lookupFreshCache# fresh0 id0 = do + fresh1 <- HashMap.lookup (i_baseNameCaseFold id0) fresh0 + IntMap.lookup (length (i_extensionsRev id0)) fresh1 + +-- | Add new identifier to FreshCache, see 'is_freshCache' for more information. +updateFreshCache# :: HasCallStack => FreshCache -> Identifier -> FreshCache +updateFreshCache# _fresh (RawIdentifier _s Nothing _) = + error "Internal error: updateFreshCache# called with unsafely made identifier" +updateFreshCache# fresh (RawIdentifier _s (Just id_) _) = + updateFreshCache# fresh id_ +updateFreshCache# fresh id_ = + go0 (go1 (max (Maybe.fromMaybe 0 (Maybe.listToMaybe exts)))) + where + go0 f = HashMap.alter (Just . f . Maybe.fromMaybe mempty) base fresh + go1 f = IntMap.alter (Just . f . Maybe.fromMaybe 0) (length exts) + + exts = i_extensionsRev id_ + base = i_baseNameCaseFold id_ + +-- | Adds identifier at verbatim if its basename hasn't been used before. +-- Otherwise it will return the first free identifier. +mkUnique# + :: HasCallStack + => IdentifierSet + -> Identifier + -> (IdentifierSet, Identifier) +mkUnique# _is0 (RawIdentifier {}) = + error "Internal error: mkUnique# cannot be used on RawIdentifiers" +mkUnique# is0 id_@(i_extensionsRev -> []) = deepen# is0 id_ +mkUnique# is id0 = (is{is_freshCache=freshCache, is_store=isStore}, id2) + where + freshCache = updateFreshCache# (is_freshCache is) id2 + isStore = HashSet.insert id2 (is_store is) + id2 = id1{i_provenance=if debugIsOn then callStack else emptyCallStack} + id1 = case lookupFreshCache# (is_freshCache is) id0 of + Just currentMax -> + id0{i_extensionsRev=currentMax+1 : tail (i_extensionsRev id0)} + Nothing -> + -- Identifier doesn't exist in set yet, so just return it. + id0 + +-- | Non-monadic, internal version of 'add' +add# :: HasCallStack => IdentifierSet -> Identifier -> IdentifierSet +add# is0@(IdentifierSet{..}) (RawIdentifier t Nothing _) = add# is0 (make## is_hdl t) +add# is0 (RawIdentifier _ (Just id0) _) = add# is0 id0 +add# is0@(IdentifierSet{..}) id0 = is0{is_freshCache=fresh1, is_store=ids1} + where + ids1 = HashSet.insert id0 is_store + fresh1 = updateFreshCache# is_freshCache id0 + +-- | Non-monadic, internal version of 'addMultiple' +addMultiple# :: (HasCallStack, Foldable t) => IdentifierSet -> t Identifier -> IdentifierSet +addMultiple# is ids = List.foldl' add# is ids + +-- | Non-monadic, internal version of 'addRaw' +addRaw# :: HasCallStack => IdentifierSet -> Text -> (IdentifierSet, Identifier) +addRaw# is0 id0 = + second + (\i -> RawIdentifier id0 (Just i) (if debugIsOn then callStack else emptyCallStack)) + (make# is0 (unextend id0)) + where + unextend = case is_hdl is0 of + VHDL -> VHDL.unextend + Verilog -> Verilog.unextend + SystemVerilog -> SystemVerilog.unextend + +-- | Non-monadic, internal version of 'make' +make# :: HasCallStack => IdentifierSet -> Text -> (IdentifierSet, Identifier) +make# is0@(IdentifierSet esc lw hdl fresh0 ids0) (Common.prettyName -> id0) = + if id1 `HashSet.member` ids0 then + -- Ideally we'd like to continue with the id from the HashSet so all the old + -- strings can be garbage collected, but I haven't found an efficient way of + -- doing so. I also doubt that this case will get hit often.. + deepen# is0 id1 + else + (is0{is_freshCache=fresh1, is_store=ids1}, id1) + where + ids1 = HashSet.insert id1 ids0 + fresh1 = updateFreshCache# fresh0 id1 + id1 = make## (is_hdl is0) (if esc then id0 else toBasicId# hdl lw id0) + +-- | Non-monadic, internal version of 'makeBasic' +makeBasic# :: HasCallStack => IdentifierSet -> Text -> (IdentifierSet, Identifier) +makeBasic# is0 = make# is0 . toBasicId# (is_hdl is0) (is_lowerCaseBasicIds is0) + +-- | Non-monadic, internal version of 'makeBasicOr' +makeBasicOr# :: HasCallStack => IdentifierSet -> Text -> Text -> (IdentifierSet, Identifier) +makeBasicOr# is0 hint altHint = make# is0 id1 + where + id0 = toBasicId# (is_hdl is0) (is_lowerCaseBasicIds is0) hint + id1 = if Text.null id0 + then toBasicId# (is_hdl is0) (is_lowerCaseBasicIds is0) altHint + else id0 + +-- | Non-monadic, internal version of 'next' +next# :: HasCallStack => IdentifierSet -> Identifier -> (IdentifierSet, Identifier) +next# is0 (RawIdentifier t Nothing _) = uncurry next# (make# is0 t) +next# is0 (RawIdentifier _ (Just id_) _) = next# is0 id_ +next# is0 id_@(i_extensionsRev -> []) = deepen# is0 id_ +next# is0 id_ = mkUnique# is0 id_ + +-- | Non-monadic, internal version of 'nextN' +nextN# :: HasCallStack => Int -> IdentifierSet -> Identifier -> (IdentifierSet, [Identifier]) +nextN# n is0 id0 = List.mapAccumL (\is1 _n -> next# is1 id0) is0 [1..n] +-- TODO: ^ More efficient implementation. + +-- | Non-monadic, internal version of 'deepenN' +deepenN# :: HasCallStack => Int -> IdentifierSet -> Identifier -> (IdentifierSet, [Identifier]) +deepenN# n is0 id0 = List.mapAccumL (\is1 _n -> deepen# is1 id0) is0 [1..n] +-- TODO: ^ More efficient implementation. + +-- | Non-monadic, internal version of 'deepen' +deepen# :: HasCallStack => IdentifierSet -> Identifier -> (IdentifierSet, Identifier) +deepen# is0 (RawIdentifier t Nothing _) = uncurry deepen# (make# is0 t) +deepen# is0 (RawIdentifier _ (Just id_) _) = deepen# is0 id_ +deepen# is0 id_ = mkUnique# is0 (id_{i_extensionsRev=0:i_extensionsRev id_}) + +-- | Non-monadic, internal version of 'suffix' +suffix# :: HasCallStack => IdentifierSet -> Identifier -> Text -> (IdentifierSet, Identifier) +suffix# is0 (RawIdentifier t Nothing _) suffix_ = (uncurry suffix# (make# is0 t)) suffix_ +suffix# is0 (RawIdentifier _ (Just id_) _) suffix_ = suffix# is0 id_ suffix_ +suffix# is0 id0 suffix_ = make# is0 (i_baseName id0 <> "_" <> suffix_) + +-- | Non-monadic, internal version of 'prefix' +prefix# :: HasCallStack => IdentifierSet -> Identifier -> Text -> (IdentifierSet, Identifier) +prefix# is0 (RawIdentifier t Nothing _) prefix_ = (uncurry prefix# (make# is0 t)) prefix_ +prefix# is0 (RawIdentifier _ (Just id_) _) prefix_ = prefix# is0 id_ prefix_ +prefix# is0 id0 prefix_ = make# is0 (prefix_ <> "_" <> i_baseName id0) + +toText# :: Identifier -> Text +toText# (RawIdentifier t _ _) = t +toText# (UniqueIdentifier{..}) = + case i_hdl of + VHDL -> VHDL.toText i_idType basicId + Verilog -> Verilog.toText i_idType basicId + SystemVerilog -> SystemVerilog.toText i_idType basicId + where + exts = map showt (reverse i_extensionsRev) + basicId = Text.intercalate "_" (i_baseName : exts) + +-- | Is given string a valid basic identifier in given HDL? +isBasic# :: HDL -> Text -> Bool +isBasic# VHDL = VHDL.parseBasic +isBasic# Verilog = Verilog.parseBasic +isBasic# SystemVerilog = SystemVerilog.parseBasic + +-- | Is given string a valid extended identifier in given HDL? +isExtended# :: HDL -> Text -> Bool +isExtended# VHDL = VHDL.parseExtended +isExtended# Verilog = Verilog.parseExtended +isExtended# SystemVerilog = SystemVerilog.parseExtended + +-- | Convert given string to ASCII. Retains all printable ASCII. All other +-- characters are thrown out. +toPrintableAscii# :: Text -> Text +toPrintableAscii# = Text.filter (\c -> Char.isPrint c && Char.isAscii c) + +-- | Split identifiers such as "foo_1_2" into ("foo", [2, 1]). +parseIdentifier# :: Text -> (Text, [Word]) +parseIdentifier# t = + let (tsRev, extsRev) = go (List.reverse (Text.splitOn "_" t)) in + (Text.intercalate "_" (List.reverse tsRev), extsRev) + where + go :: [Text] -> ([Text], [Word]) + go [] = go ["clash", "internal"] + go (i:is) = case readMaybe @Word (Text.unpack i) of + Just w -> second (w:) (go is) + Nothing -> (i:is, []) + +make## :: HasCallStack => HDL -> Text -> Identifier +make## hdl = + go + . Text.strip + . Text.replace "\\" "" + . toPrintableAscii# + where + go s | Text.null s = go "clash_internal" + | otherwise = + let + (baseName, extensions) = parseIdentifier# s + idType = if isBasic# hdl s then Basic else Extended + + -- VHDL is a case insensitive language, so we convert the given + -- text to lowercase. Note that 'baseNameCaseFold' is used in the + -- Eq for Identifier. + baseNameCaseFold = case hdl of + VHDL -> Text.toCaseFold baseName + _ -> baseName + in + UniqueIdentifier + baseName baseNameCaseFold extensions idType hdl + (if debugIsOn then callStack else emptyCallStack) + +toBasicId# :: HDL -> PreserveCase -> Text -> Text +toBasicId# hdl lw id0 = + case hdl of + VHDL -> VHDL.toBasic id1 + Verilog -> Verilog.toBasic id1 + SystemVerilog -> SystemVerilog.toBasic id1 + where + id1 = case lw of {PreserveCase -> id0; ToLower -> Text.toLower id0} + +-- | Convert a Clash Core Id to an identifier. Makes sure returned identifier +-- is unique. +fromCoreId# :: IdentifierSet -> Id -> (IdentifierSet, Identifier) +fromCoreId# is0 id0 = make# is0 (nameOcc (varName id0)) + +instance PP.Pretty Identifier where + pretty = PP.pretty . toText# diff --git a/src/Clash/Netlist/Id/SystemVerilog.hs b/src/Clash/Netlist/Id/SystemVerilog.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id/SystemVerilog.hs @@ -0,0 +1,71 @@ +{-| + Copyright : (C) 2020, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. Bool +isKeyword t = HashSet.member (Text.toLower t) keywords + +parseBasic :: Text -> Bool +parseBasic id0 = Verilog.parseBasic' id0 && not (isKeyword id0) + +parseExtended :: Text -> Bool +parseExtended = Verilog.parseExtended + +toBasic :: Text -> Text +toBasic (Verilog.toBasic' -> t) = if isKeyword t then "r_" <> t else t + +unextend :: Text -> Text +unextend = Verilog.unextend + +toText :: IdentifierType -> Text -> Text +toText = Verilog.toText diff --git a/src/Clash/Netlist/Id/VHDL.hs b/src/Clash/Netlist/Id/VHDL.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id/VHDL.hs @@ -0,0 +1,163 @@ +{-| + Copyright : (C) 2020, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. )) +import qualified Data.Char as Char +import qualified Data.Text as Text +import Data.Text (Text) +import Data.Maybe (isJust, fromMaybe) +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet + +import Clash.Netlist.Types (IdentifierType(..)) + +-- | Identifiers which are imported from the following: +-- +-- use IEEE.STD_LOGIC_1164.ALL; +-- use IEEE.NUMERIC_STD.ALL; +-- use IEEE.MATH_REAL.ALL; +-- use std.textio.all; +-- +-- Clash should not use these identifiers, as it can lead to errors when +-- interfacing with an EDA tool. +-- +-- See https://github.com/clash-lang/clash-compiler/issues/1439. +-- +importedNames :: [Text] +importedNames = + [ -- ieee.std_logic_1164.all + "std_ulogic", "std_ulogic_vector", "resolved", "std_logic", "std_logic_vector" + , "x01", "x01z", "ux01", "ux01z", "to_bit", "to_bitvector", "to_stdulogic" + , "to_stdlogicvector", "to_stdulogicvector", "to_01", "to_x01", "to_x01z" + , "to_ux01", "rising_edge", "falling_edge", "is_x" + -- ieee.numeric_std.all + , "unresolved_unsigned", "unresolved_signed", "u_unsigned", "u_signed" + , "unsigned", "signed", "find_leftmost", "find_rightmost", "minimum" + , "maximum", "shift_left", "shift_right", "rotate_left", "rotate_right" + , "resize", "to_integer", "to_unsigned", "to_signed", "std_match" + -- ieee.math_real.all + , "math_e", "math_1_over_e", "math_pi", "math_2_pi", "math_1_over_pi" + , "math_pi_over_2", "math_pi_over_3", "path_pi_over_4", "path_3_pi_over_2" + , "math_log_of_2", "math_log_of_10", "math_log10_of_e", "math_sqrt_2" + , "math_1_over_sqrt_2", "math_sqrt_pi", "math_deg_to_rad", "math_rad_to_deg" + , "sign", "ceil", "floor", "round", "trunc", "realmax", "realmin", "uniform" + , "sqrt", "cbrt", "exp", "log", "log2", "log10", "sin", "cos", "tan", "arcsin" + , "arccos", "arctan", "sinh", "cosh", "tanh", "arcsinh", "arccosh", "arctanh" + -- std.textio.all + , "line", "text", "side", "width", "justify", "input", "output", "readline" + , "read", "sread", "string_read", "bread", "binary_read", "oread", "octal_read" + , "hread", "hex_read", "writeline", "tee", "write", "swrite", "string_write" + , "bwrite", "binary_write", "owrite", "octal_write", "hwrite", "hex_write" + ] + +-- | Time units: are added to 'reservedWords' as simulators trip over signals +-- named after them. +timeUnits :: [Text] +timeUnits = ["fs", "ps", "ns", "us", "ms", "sec", "min", "hr"] + +-- List of reserved VHDL-2008 keywords +-- + used internal names: toslv, fromslv, tagtoenum, datatotag +-- + used IEEE library names: integer, boolean, std_logic, std_logic_vector, +-- signed, unsigned, to_integer, to_signed, to_unsigned, string +keywords :: HashSet Text +keywords = HashSet.fromList $ + ["abs","access","after","alias","all","and","architecture" + ,"array","assert","assume","assume_guarantee","attribute","begin","block" + ,"body","buffer","bus","case","component","configuration","constant","context" + ,"cover","default","disconnect","downto","else","elsif","end","entity","exit" + ,"fairness","file","for","force","function","generate","generic","group" + ,"guarded","if","impure","in","inertial","inout","is","label","library" + ,"linkage","literal","loop","map","mod","nand","new","next","nor","not","null" + ,"of","on","open","or","others","out","package","parameter","port","postponed" + ,"procedure","process","property","protected","pure","range","record" + ,"register","reject","release","rem","report","restrict","restrict_guarantee" + ,"return","rol","ror","select","sequence","severity","signal","shared","sla" + ,"sll","sra","srl","strong","subtype","then","to","transport","type" + ,"unaffected","units","until","use","variable","vmode","vprop","vunit","wait" + ,"when","while","with","xnor","xor","toslv","fromslv","tagtoenum","datatotag" + ,"integer", "boolean", "std_logic", "std_logic_vector", "signed", "unsigned" + ,"to_integer", "to_signed", "to_unsigned", "string","log"] <> timeUnits <> importedNames + +isKeyword :: Text -> Bool +isKeyword t = HashSet.member (Text.toLower t) keywords + +parseBasic :: Text -> Bool +parseBasic id0 = parseBasic' id0 && not (isKeyword id0) + +parseBasic' :: Text -> Bool +parseBasic' id0 = isJust $ do + id1 <- parseLetter id0 + id2 <- repeatParse parseGroup id1 + failNonEmpty id2 + where + parseGroup s0 = do + s1 <- parseUnderscore s0 <|> Just s0 + s2 <- parseLetterOrDigit s1 + repeatParse parseLetterOrDigit s2 + +parseExtended :: Text -> Bool +parseExtended id0 = isJust $ do + id1 <- parseBackslash id0 + id2 <- parse id1 + id3 <- parseBackslash id2 + failNonEmpty id3 + where + parse s0 = + case parseBackslash s0 of + Just s1 -> parseBackslash s1 >>= repeatParse parse + Nothing -> parsePrintable s0 >>= repeatParse parse + +toBasic :: Text -> Text +toBasic = + replaceKeywords + . stripMultiscore + . Text.dropWhileEnd (=='_') + . Text.dropWhile (\c -> c == '_' || Char.isDigit c) + . zEncode isBasicChar + . stripDollarPrefixes +-- . Text.toLower + where + replaceKeywords i + | isKeyword i = "r_" <> i + | otherwise = i + + stripMultiscore = + Text.concat + . Prelude.map (\cs -> case Text.head cs of {'_' -> "_"; _ -> cs}) + . Text.group + +isBasicChar :: Char -> Bool +isBasicChar c = or + [ Char.isAsciiLower c + , Char.isAsciiUpper c + , Char.isDigit c + , c == '_' + ] + +stripDollarPrefixes :: Text -> Text +stripDollarPrefixes = stripWorkerPrefix . stripSpecPrefix . stripConPrefix + . stripWorkerPrefix . stripDictFunPrefix + where + stripDictFunPrefix t = + maybe t (Text.takeWhileEnd (/='_')) (Text.stripPrefix "$f" t) + stripWorkerPrefix t = fromMaybe t (Text.stripPrefix "$w" t) + stripConPrefix t = fromMaybe t (Text.stripPrefix "$c" t) + stripSpecPrefix t = fromMaybe t (Text.stripPrefix "$s" t) + +unextend :: Text -> Text +unextend = + Text.strip + . (\t -> fromMaybe t (Text.stripPrefix "\\" t)) + . (\t -> fromMaybe t (Text.stripSuffix "\\" t)) + . Text.strip + +toText :: IdentifierType -> Text -> Text +toText Basic t = t +toText Extended t = "\\" <> t <> "\\" diff --git a/src/Clash/Netlist/Id/Verilog.hs b/src/Clash/Netlist/Id/Verilog.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Netlist/Id/Verilog.hs @@ -0,0 +1,99 @@ +{-| + Copyright : (C) 2020, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. )) +import qualified Data.Char as Char +import Data.Maybe (isJust, fromMaybe) +import qualified Data.Text as Text +import Data.Text (Text) +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet + +import Clash.Netlist.Id.Common +import Clash.Netlist.Types (IdentifierType(..)) + +-- List of reserved Verilog-2005 keywords +keywords :: HashSet Text +keywords = HashSet.fromList + ["always","and","assign","automatic","begin","buf","bufif0" + ,"bufif1","case","casex","casez","cell","cmos","config","deassign","default" + ,"defparam","design","disable","edge","else","end","endcase","endconfig" + ,"endfunction","endgenerate","endmodule","endprimitive","endspecify" + ,"endtable","endtask","event","for","force","forever","fork","function" + ,"generate","genvar","highz0","highz1","if","ifnone","incdir","include" + ,"initial","inout","input","instance","integer","join","large","liblist" + ,"library","localparam","macromodule","medium","module","nand","negedge" + ,"nmos","nor","noshowcancelled","not","notif0","notif1","or","output" + ,"parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup" + ,"pulsestyle_onevent","pulsestyle_ondetect","rcmos","real","realtime","reg" + ,"release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared" + ,"showcancelled","signed","small","specify","specparam","strong0","strong1" + ,"supply0","supply1","table","task","time","tran","tranif0","tranif1","tri" + ,"tri0","tri1","triand","trior","trireg","unsigned","use","uwire","vectored" + ,"wait","wand","weak0","weak1","while","wire","wor","xnor","xor"] + +isKeyword :: Text -> Bool +isKeyword t = HashSet.member (Text.toLower t) keywords + +parseBasic :: Text -> Bool +parseBasic id0 = parseBasic' id0 && not (isKeyword id0) + +parseBasic' :: Text -> Bool +parseBasic' id0 = isJust $ do + id1 <- parseUnderscore id0 <|> parseLetter id0 + id2 <- repeatParse parseAllowedChars id1 + failNonEmpty id2 + where + parseAllowedChars s = + parseLetterOrDigit s + <|> parseUnderscore s + <|> parseDollar s + +parseExtended :: Text -> Bool +parseExtended id0 = + isJust ((parse id0 >>= failNonEmpty) >> parseEnd id0) + where + -- Extended identifier must start with backslash, followed by printable chars + parse s = parseBackslash s >>= repeatParse parsePrintable + + -- Extended identifier must end in exactly one whitespace + parseEnd :: Text -> Maybe Text + parseEnd s = + case Text.unpack (Text.takeEnd 2 s) of + [c0, c1] | not (isWhiteSpace c0) && isWhiteSpace c1 -> Just "" + _ -> Nothing + +toBasic' :: Text -> Text +toBasic' (zEncode isBasicChar -> t) = + case Text.uncons t of + Just (c, _) | Char.isDigit c || c == '$' -> Text.cons '_' t + _ -> t + +toBasic :: Text -> Text +toBasic (toBasic' -> t) = + if HashSet.member (Text.toLower t) keywords then "r_" <> t else t + +isBasicChar :: Char -> Bool +isBasicChar c = or + [ Char.isAsciiLower c + , Char.isAsciiUpper c + , Char.isDigit c + , c == '_' + , c == '$' + ] + +unextend :: Text -> Text +unextend = + Text.strip + . (\t -> fromMaybe t (Text.stripPrefix "\\" t)) + . Text.strip + +toText :: IdentifierType -> Text -> Text +toText Basic t = t +toText Extended t = "\\" <> t <> " " diff --git a/src/Clash/Netlist/Types.hs b/src/Clash/Netlist/Types.hs --- a/src/Clash/Netlist/Types.hs +++ b/src/Clash/Netlist/Types.hs @@ -2,22 +2,28 @@ Copyright : (C) 2012-2016, University of Twente, 2017 , Myrtle Software Ltd, 2017-2018, Google Inc. + 2020 , QBayLogic License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. Type and instance definitions for Netlist modules -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} --- since GHC 8.6 we can haddock individual contructor fields \o/ +-- since GHC 8.6 we can haddock individual constructor fields \o/ #if __GLASGOW_HASKELL__ >= 806 #define FIELD ^ #endif @@ -29,28 +35,43 @@ where import Control.DeepSeq +import qualified Control.Lens as Lens +import Control.Lens (Lens', (.=)) #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail) #endif import Control.Monad.Reader (ReaderT, MonadReader) -import Control.Monad.State as Lazy (State) -import Control.Monad.State.Strict as Strict - (State,MonadIO, MonadState, StateT) +import qualified Control.Monad.State as Lazy (State) +import qualified Control.Monad.State.Strict as Strict + (State, MonadIO, MonadState, StateT) import Data.Bits (testBit) import Data.Binary (Binary(..)) -import Data.Hashable (Hashable) +import Data.Function (on) +import Data.Hashable (Hashable(hash,hashWithSalt)) import Data.HashMap.Strict (HashMap) +import Data.HashSet (HashSet) +import qualified Data.List as List import Data.IntMap (IntMap, empty) +import Data.Map.Ordered (OMap) +import Data.Maybe (mapMaybe) import qualified Data.Set as Set -import Data.Text (Text, pack) +import Data.Text (Text) + import Data.Typeable (Typeable) import Data.Text.Prettyprint.Doc.Extra (Doc) +import Data.Semigroup.Monad (Mon(..)) import GHC.Generics (Generic) +import GHC.Stack import Language.Haskell.TH.Syntax (Lift) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (SrcSpan) +#else import SrcLoc (SrcSpan) +#endif import Clash.Annotations.BitRepresentation (FieldAnn) +import Clash.Annotations.Primitive (HDL(..)) import Clash.Annotations.TopEntity (TopEntity) import Clash.Backend (Backend) import Clash.Core.Type (Type) @@ -59,55 +80,225 @@ import Clash.Core.VarEnv (VarEnv) import Clash.Driver.Types (BindingMap, ClashOpts) import Clash.Netlist.BlackBox.Types (BlackBoxTemplate) -import Clash.Netlist.Id (IdType) import Clash.Primitives.Types (CompiledPrimMap) import Clash.Signal.Internal (ResetPolarity, ActiveEdge, ResetKind, InitBehavior) -import Clash.Util (HasCallStack, makeLenses) +import Clash.Unique (Unique) +import Clash.Util (makeLenses) import Clash.Annotations.BitRepresentation.Internal (CustomReprs, DataRepr', ConstrRepr') --- | Structure describing a top entity: it's id, its port annotations, and --- associated testbench. +import {-# SOURCE #-} qualified Clash.Netlist.Id as Id + +-- | Structure describing a top entity: it's id and its port annotations. data TopEntityT = TopEntityT { topId :: Id -- ^ Id of top entity , topAnnotation :: Maybe TopEntity -- ^ (Maybe) a topentity annotation - , associatedTestbench :: Maybe Id - -- ^ (Maybe) a test bench associated with the topentity - } deriving (Generic) + , topIsTestBench :: Bool + -- ^ Whether this entity is a test bench + } deriving (Generic, Show) +-- | Same as "TopEntity", but with all port names that end up in HDL specified +data ExpandedTopEntity a = ExpandedTopEntity + { et_inputs :: [Maybe (ExpandedPortName a)] + -- ^ Inputs with fully expanded port names. /Nothing/ if port is void. + , et_output :: Maybe (ExpandedPortName a) + -- ^ Output with fully expanded port names. /Nothing/ if port is void or + -- BiDirectionalOut. + } deriving (Show, Functor, Foldable, Traversable) + +-- | See "ExpandedTopEntity" +data ExpandedPortName a + -- | Same as "PortName", but fully expanded + = ExpandedPortName HWType a + + -- | Same as "PortProduct", but fully expanded + | ExpandedPortProduct + Text + -- FIELD Name hint. Can be used to create intermediate signal names. + HWType + -- FIELD Type of product + [ExpandedPortName a] + -- FIELD Product fields + deriving (Show, Functor, Foldable, Traversable) + -- | Monad that caches generated components (StateT) and remembers hidden inputs -- of components that are being generated (WriterT) newtype NetlistMonad a = - NetlistMonad { runNetlist :: StateT NetlistState (ReaderT NetlistEnv IO) a } + NetlistMonad { runNetlist :: Strict.StateT NetlistState (ReaderT NetlistEnv IO) a } deriving newtype (Functor, Monad, Applicative, MonadReader NetlistEnv, - MonadState NetlistState, MonadIO, MonadFail) + Strict.MonadState NetlistState, Strict.MonadIO, MonadFail) type HWMap = HashMap Type (Either String FilteredHWType) +-- | See 'is_freshCache' +type FreshCache = HashMap Text (IntMap Word) + +type IdentifierText = Text + +-- | Whether to preserve casing in ids or converted everything to +-- lowercase. Influenced by '-fclash-lower-case-basic-identifiers' +data PreserveCase + = PreserveCase + | ToLower + deriving (Show, Generic, NFData, Eq, Binary, Hashable) + +-- See: http://vhdl.renerta.com/mobile/source/vhd00037.htm +-- http://www.verilog.renerta.com/source/vrg00018.htm +data IdentifierType + = Basic + -- ^ A basic identifier: does not have to be escaped in order to be a valid + -- identifier in HDL. + | Extended + -- ^ An extended identifier: has to be escaped, wrapped, or otherwise + -- postprocessed before writhing it to HDL. + deriving (Show, Generic, NFData, Eq) + +-- | A collection of unique identifiers. Allows for fast fresh identifier +-- generation. +-- +-- __NB__: use the functions in Clash.Netlist.Id. Don't use the constructor directly. +data IdentifierSet + = IdentifierSet { + is_allowEscaped :: !Bool + -- ^ Allow escaped ids? If set to False, "make" will always behave like + -- "makeBasic". + , is_lowerCaseBasicIds :: !PreserveCase + -- ^ Force all generated basic identifiers to lowercase. + , is_hdl :: !HDL + -- ^ HDL to generate fresh identifiers for + , is_freshCache :: !FreshCache + -- ^ Maps an 'i_baseNameCaseFold' to a map mapping the number of + -- extensions (in 'i_extensionsRev') to the maximum word at that + -- basename/level. For example, if a set would contain the identifiers: + -- + -- [foo, foo_1, foo_2, bar_5, bar_7_8] + -- + -- the map would look like: + -- + -- [(foo, [(0, 0), (1, 2)]), (bar, [(1, 5), (2, 8)])] + -- + -- This mapping makes sure we can quickly generate fresh identifiers. For + -- example, generating a new id for "foo_1" would be a matter of looking + -- up the base name in this map, concluding that the maximum identifier + -- with this basename and this number of extensions is "foo_2", + -- subsequently generating "foo_3". + -- + -- Note that an identifier with no extensions is also stored in this map + -- for practical purposes, but the maximum ext is invalid. + , is_store :: !(HashSet Identifier) + -- ^ Identifier store + } deriving (Generic, NFData, Show) + +-- | HDL identifier. Consists of a base name and a number of extensions. An +-- identifier with a base name of "foo" and a list of extensions [1, 2] will be +-- rendered as "foo_1_2". +-- +-- Note: The Eq instance of "Identifier" is case insensitive! E.g., two +-- identifiers with base names 'fooBar' and 'FoObAR' are considered the same. +-- However, identifiers are stored case preserving. This means Clash won't +-- generate two identifiers with differing case, but it will try to keep +-- capitalization. +-- +-- The goal of this data structure is to greatly simplify how Clash deals with +-- identifiers internally. Any Identifier should be trivially printable to any +-- HDL. +-- +-- __NB__: use the functions in Clash.Netlist.Id. Don't use these constructors +-- directly. +data Identifier + -- | Unparsed identifier. Used for things such as port names, which should + -- appear in the HDL exactly as the user specified. + = RawIdentifier + !Text + -- FIELD An identifier exactly as given by the user + (Maybe Identifier) + -- FIELD Parsed version of raw identifier. Will not be populated if this + -- identifier was created with an unsafe function. + !CallStack + -- ^ Stores where this identifier was generated. Tracking is only enabled + -- is 'debugIsOn', otherwise this field will be populated by an empty + -- callstack. + + -- | Parsed and sanitized identifier. See various fields for more information + -- on its invariants. + | UniqueIdentifier { + i_baseName :: !Text + -- ^ Base name of identifier. 'make' makes sure this field: + -- + -- * does not end in '_num' where 'num' is a digit. + -- * is solely made up of printable ASCII characters + -- * has no leading or trailing whitespace + -- + , i_baseNameCaseFold :: !Text + -- ^ Same as 'i_baseName', but can be used for equality testing that doesn't + -- depend on capitalization. + , i_extensionsRev :: [Word] + -- ^ Extensions applied to base identifier. E.g., an identifier with a base + -- name of 'foo' and an extension of [6, 5] would render as 'foo_5_6'. Note + -- that extensions are stored in reverse order for easier manipulation. + , i_idType :: !IdentifierType + -- ^ See "IdentifierType". + , i_hdl :: !HDL + -- ^ HDL this identifier is generated for. + , i_provenance :: !CallStack + -- ^ Stores where this identifier was generated. Tracking is only enabled + -- is 'debugIsOn', otherwise this field will be populated by an empty + -- callstack. + } deriving (Show, Generic, NFData) + +identifierKey# :: Identifier -> ((Text, Bool), [Word]) +identifierKey# (RawIdentifier t _id _) = ((t, True), []) +identifierKey# id_ = ((i_baseNameCaseFold id_, False), i_extensionsRev id_) + +instance Hashable Identifier where + hashWithSalt salt = hashWithSalt salt . hash + hash = uncurry hash# . identifierKey# + where + hash# a extensions = + -- 'hash' has an identity around zero, e.g. `hash (0, 2) == 2`. Because a + -- lot of zeros can be expected, extensions are fuzzed in order to keep + -- efficient `HashMap`s. + let fuzz fuzzFactor ext = fuzzFactor * fuzzFactor * ext in + hash (a, List.foldl' fuzz 2 extensions) + +instance Eq Identifier where + i1 == i2 = identifierKey# i1 == identifierKey# i2 + i1 /= i2 = identifierKey# i1 /= identifierKey# i2 + +instance Ord Identifier where + compare = compare `on` identifierKey# + -- | Environment of the NetlistMonad data NetlistEnv = NetlistEnv - { _prefixName :: Identifier + { _prefixName :: Text -- ^ Prefix for instance/register names - , _suffixName :: Identifier + , _suffixName :: Text -- ^ Postfix for instance/register names - , _setName :: Maybe Identifier + , _setName :: Maybe Text -- ^ (Maybe) user given instance/register name } +data ComponentMeta = ComponentMeta + { cmWereVoids :: [Bool] + , cmLoc :: SrcSpan + , cmScope :: IdentifierSet + } deriving (Generic, Show, NFData) + +type ComponentMap = OMap Unique (ComponentMeta, Component) + -- | State of the NetlistMonad data NetlistState = NetlistState { _bindings :: BindingMap -- ^ Global binders - , _varCount :: !Int - -- ^ Number of signal declarations - , _components :: VarEnv ([Bool],SrcSpan,HashMap Identifier Word,Component) - -- ^ Cached components + , _components :: ComponentMap + -- ^ Cached components. Is an insertion ordered map to preserve a topologically + -- sorted component list for the manifest file. , _primitives :: CompiledPrimMap -- ^ Primitive Definitions , _typeTranslator :: CustomReprs -> TyConMap -> Type @@ -117,20 +308,38 @@ -- ^ TyCon cache , _curCompNm :: !(Identifier,SrcSpan) , _intWidth :: Int - , _mkIdentifierFn :: IdType -> Identifier -> Identifier - , _extendIdentifierFn :: IdType -> Identifier -> Identifier -> Identifier - , _seenIds :: HashMap Identifier Word - , _seenComps :: HashMap Identifier Word + , _seenIds :: IdentifierSet + -- ^ All names currently in scope. + , _seenComps :: IdentifierSet + -- ^ Components (to be) generated during this netlist run. This is always a + -- subset of 'seenIds'. Reason d'etre: we currently generate components in a + -- top down manner. E.g. given: + -- + -- - A + -- -- B + -- -- C + -- + -- we would generate component 'A' first. Before trying to generate 'B' and + -- 'C'. 'A' might introduce a number of signal declarations. The names of these + -- signals can't clash with the name of component 'B', hence we need to pick a + -- name for B unique w.r.t. all these signal names. If we would postpone + -- generating a unqiue name for 'B' til _after_ generating all the signal + -- names, the signal names would get all the "nice" names. E.g., a signal + -- would be called "foo", thereby forcing the component 'B' to be called + -- "foo_1". Ideally, we'd use the "nice" names for components, and the "ugly" + -- names for signals. To achieve this, we generate all the component names + -- up front and subsequently store them in '_seenComps'. , _seenPrimitives :: Set.Set Text -- ^ Keeps track of invocations of ´mkPrimitive´. It is currently used to -- filter duplicate warning invocations for dubious blackbox instantiations, -- see GitHub pull request #286. , _componentNames :: VarEnv Identifier + -- ^ Names of components (to be) generated during this netlist run. Includes + -- top entity names. , _topEntityAnns :: VarEnv TopEntityT , _hdlDir :: FilePath , _curBBlvl :: Int -- ^ The current scoping level assigned to black box contexts - , _componentPrefix :: ComponentPrefix , _customReprs :: CustomReprs , _clashOpts :: ClashOpts -- ^ Settings Clash was called with @@ -145,17 +354,16 @@ data ComponentPrefix = ComponentPrefix - { componentPrefixTop :: Maybe Identifier -- ^ Prefix for top-level components - , componentPrefixOther :: Maybe Identifier -- ^ Prefix for all other components + { componentPrefixTop :: Maybe Text + -- ^ Prefix for top-level components + , componentPrefixOther :: Maybe Text + -- ^ Prefix for all other components } deriving Show -- | Existentially quantified backend data SomeBackend where SomeBackend :: Backend backend => backend -> SomeBackend --- | Signal reference -type Identifier = Text - type Comment = Text -- | Component: base unit of a Netlist @@ -173,6 +381,16 @@ Component nm inps outps decls -> rnf nm `seq` rnf inps `seq` rnf outps `seq` rnf decls +-- | Find the name and domain name of each clock argument of a component. +-- +findClocks :: Component -> [(Text, Text)] +findClocks (Component _ is _ _) = + mapMaybe isClock is + where + isClock (i, Clock d) = Just (Id.toText i, d) + isClock (i, Annotated _ t) = isClock (i,t) + isClock _ = Nothing + -- | Size indication of a type (e.g. bit-size or number of elements) type Size = Int @@ -185,6 +403,8 @@ FilteredHWType HWType [[(IsVoid, FilteredHWType)]] deriving (Eq, Show) +type DomainName = Text + -- | Representable hardware types data HWType = Void (Maybe HWType) @@ -211,42 +431,76 @@ -- ^ Vector type | RTree !Size !HWType -- ^ RTree type - | Sum !Identifier [Identifier] + | Sum !Text [Text] -- ^ Sum type: Name and Constructor names - | Product !Identifier (Maybe [Text]) [HWType] + | Product !Text (Maybe [Text]) [HWType] -- ^ Product type: Name, field names, and field types. Field names will be -- populated when using records. - | SP !Identifier [(Identifier,[HWType])] + | SP !Text [(Text, [HWType])] -- ^ Sum-of-Product type: Name and Constructor names + field types - | Clock !Identifier - -- ^ Clock type corresponding to domain /Identifier/ - | Reset !Identifier - -- ^ Reset type corresponding to domain /Identifier/ + | Clock !DomainName + -- ^ Clock type corresponding to domain /DomainName/ + | Reset !DomainName + -- ^ Reset type corresponding to domain /DomainName/ + | Enable !DomainName + -- ^ Enable type corresponding to domain /DomainName/ | BiDirectional !PortDirection !HWType -- ^ Tagging type indicating a bidirectional (inout) port - | CustomSP !Identifier !DataRepr' !Size [(ConstrRepr', Identifier, [HWType])] + | CustomSP !Text !DataRepr' !Size [(ConstrRepr', Text, [HWType])] -- ^ Same as Sum-Of-Product, but with a user specified bit representation. For -- more info, see: Clash.Annotations.BitRepresentations. - | CustomSum !Identifier !DataRepr' !Size [(ConstrRepr', Identifier)] + | CustomSum !Text !DataRepr' !Size [(ConstrRepr', Text)] -- ^ Same as Sum, but with a user specified bit representation. For more info, -- see: Clash.Annotations.BitRepresentations. - | CustomProduct !Identifier !DataRepr' !Size (Maybe [Text]) [(FieldAnn, HWType)] + | CustomProduct !Text !DataRepr' !Size (Maybe [Text]) [(FieldAnn, HWType)] -- ^ Same as Product, but with a user specified bit representation. For more -- info, see: Clash.Annotations.BitRepresentations. | Annotated [Attr'] !HWType -- ^ Annotated with HDL attributes - | KnownDomain !Identifier !Integer !ActiveEdge !ResetKind !InitBehavior !ResetPolarity + | KnownDomain !DomainName !Integer !ActiveEdge !ResetKind !InitBehavior !ResetPolarity -- ^ Domain name, period, active edge, reset kind, initial value behavior | FileType -- ^ File type for simulation-level I/O deriving (Eq, Ord, Show, Generic, NFData, Hashable) +hwTypeDomain :: HWType -> Maybe DomainName +hwTypeDomain = \case + Clock dom -> Just dom + Reset dom -> Just dom + Enable dom -> Just dom + KnownDomain dom _ _ _ _ _ -> Just dom + _ -> Nothing + -- | Extract hardware attributes from Annotated. Returns an empty list if -- non-Annotated given or if Annotated has an empty list of attributes. hwTypeAttrs :: HWType -> [Attr'] hwTypeAttrs (Annotated attrs _type) = attrs hwTypeAttrs _ = [] +-- | Specifies how to wire up a component instance +data PortMap + = IndexedPortMap [(PortDirection, HWType, Expr)] + -- ^ Port map based on port positions (port direction, type, assignment) + -- + -- HDL Example: + -- + -- bytemaster bytemaster_ds + -- ( clk_1 + -- , rst_1 + -- , bitCtrl_0 ); + -- + | NamedPortMap [(Expr, PortDirection, HWType, Expr)] + -- ^ Port map based on port names (port name, port direction, type, assignment) + -- + -- HDL Example: + -- + -- bytemaster bytemaster_ds + -- ( .clk (clk_1) + -- , .rst (rst_1) + -- , .bitCtrl (bitCtrl_0) ); + -- + deriving (Show) + -- | Internals of a Component data Declaration -- | Signal assignment @@ -265,11 +519,12 @@ -- | Instantiation of another component: | InstDecl EntityOrComponent -- FIELD Whether it's an entity or a component - (Maybe Comment) -- FIELD Comment to add to the generated code + (Maybe Text) -- FIELD Library instance is defined in + [Attr'] -- FIELD Attributes to add to the generated code !Identifier -- FIELD The component's (or entity's) name !Identifier -- FIELD Instance label [(Expr,HWType,Expr)] -- FIELD List of parameters for this component (param name, param type, param value) - [(Expr,PortDirection,HWType,Expr)] -- FIELD Ports (port name, port direction, type, assignment) + PortMap -- | Instantiation of blackbox declaration | BlackBoxD @@ -282,11 +537,11 @@ -- | Signal declaration | NetDecl' - (Maybe Comment) -- FIELD Note; will be inserted as a comment in target hdl - WireOrReg -- FIELD Wire or register - !Identifier -- FIELD Name of signal - (Either Identifier HWType) -- FIELD Pointer to type of signal or type of signal - (Maybe Expr) -- FIELD Initial value + (Maybe Comment) -- FIELD Note; will be inserted as a comment in target hdl + WireOrReg -- FIELD Wire or register + !Identifier -- FIELD Name of signal + (Either IdentifierText HWType) -- FIELD Pointer to type of signal or type of signal + (Maybe Expr) -- FIELD Initial value -- ^ Signal declaration | TickDecl Comment -- ^ HDL tick corresponding to a Core tick @@ -368,8 +623,20 @@ [((Text,Text),BlackBox)] -- FIELD Intel/Quartus only: create a @.qsys@ file from given template. !BlackBox -- FIELD Template tokens !BlackBoxContext -- FIELD Context in which tokens should be rendered - !Bool -- FIELD Wrap in paretheses? - | ConvBV (Maybe Identifier) HWType Bool Expr + !Bool -- FIELD Wrap in parentheses? + + -- | Convert some type to a BitVector. + | ToBv + (Maybe Identifier) -- FIELD Type prefix + HWType -- FIELD Type to convert _from_ + Expr -- FIELD Expression to convert to BitVector + + -- | Convert BitVector to some type. + | FromBv + (Maybe Identifier) -- FIELD Type prefix + HWType -- FIELD Type to convert _to_ + Expr -- FIELD BitVector to convert + | IfThenElse Expr Expr Expr -- | Do nothing | Noop @@ -407,9 +674,14 @@ -- | Context used to fill in the holes of a BlackBox template data BlackBoxContext = Context - { bbName :: Text -- ^ Blackbox function name (for error reporting) - , bbResult :: (Expr,HWType) -- ^ Result name and type - , bbInputs :: [(Expr,HWType,Bool)] -- ^ Argument names, types, and whether it is a literal + { bbName :: Text + -- ^ Blackbox function name (for error reporting) + , bbResults :: [(Expr,HWType)] + -- ^ Result names and types. Will typically be a list with a single item. + -- Multiple result targets will be used for "multi result primitives". See + -- 'Clash.Normalize.Transformations.setupMultiResultPrim'. + , bbInputs :: [(Expr,HWType,Bool)] + -- ^ Argument names, types, and whether it is a literal , bbFunctions :: IntMap [(Either BlackBox (Identifier,[Declaration]) ,WireOrReg ,[BlackBoxTemplate] @@ -422,14 +694,14 @@ -- , Whether the result should be /reg/ or a /wire/ (Verilog only) -- , Partial Blackbox Context -- ) - , bbQsysIncName :: [Identifier] + , bbQsysIncName :: [IdentifierText] , bbLevel :: Int -- ^ The scoping level this context is associated with, ensures that -- @~ARGN[k][n]@ holes are only filled with values from this context if @k@ -- is equal to the scoping level of this context. , bbCompName :: Identifier -- ^ The component the BlackBox is instantiated in - , bbCtxName :: Maybe Identifier + , bbCtxName :: Maybe IdentifierText -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the -- name of the closest binder } @@ -446,12 +718,16 @@ data TemplateFunction where TemplateFunction :: [Int] + -- FIELD Used arguments -> (BlackBoxContext -> Bool) + -- FIELD Validation function. Should return 'False' if function can't render + -- given a certain context. -> (forall s . Backend s => BlackBoxContext -> Lazy.State s Doc) + -- FIELD Render function -> TemplateFunction instance Show BlackBox where - show (BBTemplate t) = show t + show (BBTemplate t) = "BBTemplate " <> show t show (BBFunction nm hsh _) = "" @@ -529,17 +805,55 @@ | Sequential emptyBBContext :: Text -> BlackBoxContext -emptyBBContext n +emptyBBContext name = Context - { bbName = n - , bbResult = (Identifier (pack "__EMPTY__") Nothing, Void Nothing) + { bbName = name + , bbResults = [] , bbInputs = [] , bbFunctions = empty , bbQsysIncName = [] , bbLevel = (-1) - , bbCompName = pack "__NOCOMPNAME__" + , bbCompName = UniqueIdentifier + "__NOCOMPNAME__" "__NOCOMPNAME__" [] + Basic VHDL emptyCallStack , bbCtxName = Nothing } makeLenses ''NetlistEnv makeLenses ''NetlistState + +-- | Structures that hold an 'IdentifierSet' +class HasIdentifierSet s where + identifierSet :: Lens' s IdentifierSet + +instance HasIdentifierSet IdentifierSet where + identifierSet = ($) + +-- | An "IdentifierSetMonad" supports unique name generation for Clash Netlist +class Monad m => IdentifierSetMonad m where + identifierSetM :: (IdentifierSet -> IdentifierSet) -> m IdentifierSet + +instance IdentifierSetMonad NetlistMonad where + identifierSetM f = do + is0 <- Lens.use seenIds + let is1 = f is0 + seenIds .= is1 + pure is1 + {-# INLINE identifierSetM #-} + +instance HasIdentifierSet s => IdentifierSetMonad (Strict.State s) where + identifierSetM f = do + is0 <- Lens.use identifierSet + identifierSet .= f is0 + Lens.use identifierSet + {-# INLINE identifierSetM #-} + +instance HasIdentifierSet s => IdentifierSetMonad (Lazy.State s) where + identifierSetM f = do + is0 <- Lens.use identifierSet + identifierSet .= f is0 + Lens.use identifierSet + {-# INLINE identifierSetM #-} + +instance IdentifierSetMonad m => IdentifierSetMonad (Mon m) where + identifierSetM = Mon . identifierSetM diff --git a/src/Clash/Netlist/Types.hs-boot b/src/Clash/Netlist/Types.hs-boot --- a/src/Clash/Netlist/Types.hs-boot +++ b/src/Clash/Netlist/Types.hs-boot @@ -8,15 +8,25 @@ module Clash.Netlist.Types where -import Data.Text (Text) - -type Identifier = Text +import Control.Lens (Lens') +import Data.Hashable +data IdentifierType +data Identifier +data IdentifierSet data HWType data Declaration data Component data Expr data BlackBox +class Monad m => IdentifierSetMonad m where + identifierSetM :: (IdentifierSet -> IdentifierSet) -> m IdentifierSet + +class HasIdentifierSet s where + identifierSet :: Lens' s IdentifierSet + type role NetlistMonad nominal data NetlistMonad a +data PreserveCase = PreserveCase | ToLower +instance Hashable PreserveCase diff --git a/src/Clash/Netlist/Util.hs b/src/Clash/Netlist/Util.hs --- a/src/Clash/Netlist/Util.hs +++ b/src/Clash/Netlist/Util.hs @@ -10,2044 +10,1905 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -#if !MIN_VERSION_ghc(8,8,0) -{-# LANGUAGE MonadFailDesugaring #-} -#endif -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Clash.Netlist.Util where - -import Data.Coerce (coerce) -import Control.Error (hush) -import Control.Exception (throw) -import Control.Lens ((.=),(%=)) -import qualified Control.Lens as Lens -import Control.Monad (unless, when, zipWithM, join) -import Control.Monad.Reader (ask, local) -import qualified Control.Monad.State as State -import Control.Monad.State.Strict - (State, evalState, get, modify, runState) -import Control.Monad.Trans.Except - (ExceptT (..), runExcept, runExceptT, throwE) -import Data.Either (partitionEithers) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import qualified Data.IntSet as IntSet -import Data.String (fromString) -import Data.List (intersperse, unzip4, intercalate) -import qualified Data.List as List -import qualified Data.List.Extra as List -import Data.Maybe (catMaybes,fromMaybe,isNothing,mapMaybe) -import Data.Monoid (First (..)) -import Text.Printf (printf) -#if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup ((<>)) -#endif -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Text.Lazy (toStrict) -import Data.Text.Prettyprint.Doc (Doc) - -import Outputable (ppr, showSDocUnsafe) - -import Clash.Annotations.BitRepresentation.ClashLib - (coreToType') -import Clash.Annotations.BitRepresentation.Internal - (CustomReprs, ConstrRepr'(..), DataRepr'(..), getDataRepr, - uncheckedGetConstrRepr) -import Clash.Annotations.TopEntity (PortName (..), TopEntity (..)) -import Clash.Driver.Types (Manifest (..), ClashOpts (..)) -import Clash.Core.DataCon (DataCon (..)) -import Clash.Core.EqSolver (typeEq) -import Clash.Core.FreeVars (localIdOccursIn, typeFreeVars, typeFreeVars') -import qualified Clash.Core.Literal as C -import Clash.Core.Name - (Name (..), appendToName, nameOcc) -import Clash.Core.Pretty (showPpr) -import Clash.Core.Subst - (Subst (..), extendIdSubst, extendIdSubstList, extendInScopeId, - extendInScopeIdList, mkSubst, substTm) -import Clash.Core.Term - (Alt, LetBinding, Pat (..), Term (..), TickInfo (..), NameMod (..), - collectArgsTicks, collectTicks, collectBndrs, PrimInfo(primName), mkTicks, stripTicks) -import Clash.Core.TermInfo -import Clash.Core.TyCon - (TyCon (FunTyCon), TyConName, TyConMap, tyConDataCons) -import Clash.Core.Type (Type (..), TypeView (..), - coreView1, splitTyConAppM, tyView, TyVar) -import Clash.Core.Util - (substArgTys, tyLitShow) -import Clash.Core.Var - (Id, Var (..), mkLocalId, modifyVarName, Attr') -import Clash.Core.VarEnv - (InScopeSet, extendInScopeSetList, uniqAway) -import {-# SOURCE #-} Clash.Netlist.BlackBox -import {-# SOURCE #-} Clash.Netlist.BlackBox.Util -import Clash.Netlist.Id (IdType (..), stripDollarPrefixes) -import Clash.Netlist.Types as HW -import Clash.Primitives.Types -import Clash.Unique -import Clash.Util - --- | Throw away information indicating which constructor fields were filtered --- due to being void. -stripFiltered :: FilteredHWType -> HWType -stripFiltered (FilteredHWType hwty _filtered) = hwty - --- | Strip as many "Void" layers as possible. Might still return a Void if the --- void doesn't contain a hwtype. -stripVoid :: HWType -> HWType -stripVoid (Void (Just e)) = stripVoid e -stripVoid e = e - -flattenFiltered :: FilteredHWType -> [[Bool]] -flattenFiltered (FilteredHWType _hwty filtered) = map (map fst) filtered - -isVoidMaybe :: Bool -> Maybe HWType -> Bool -isVoidMaybe dflt Nothing = dflt -isVoidMaybe _dflt (Just t) = isVoid t - --- | Determines if type is a zero-width construct ("void") -isVoid :: HWType -> Bool -isVoid Void {} = True -isVoid _ = False - --- | Same as @isVoid@, but on @FilteredHWType@ instead of @HWType@ -isFilteredVoid :: FilteredHWType -> Bool -isFilteredVoid = isVoid . stripFiltered - -mkIdentifier :: IdType -> Identifier -> NetlistMonad Identifier -mkIdentifier typ nm = Lens.use mkIdentifierFn <*> pure typ <*> pure nm - -extendIdentifier - :: IdType - -> Identifier - -> Identifier - -> NetlistMonad Identifier -extendIdentifier typ nm ext = - Lens.use extendIdentifierFn <*> pure typ <*> pure nm <*> pure ext - --- | Split a normalized term into: a list of arguments, a list of let-bindings, --- and a variable reference that is the body of the let-binding. Returns a --- String containing the error if the term was not in a normalized form. -splitNormalized - :: TyConMap - -> Term - -> (Either String ([Id],[LetBinding],Id)) -splitNormalized tcm expr = case collectBndrs expr of - (args, collectTicks -> (Letrec xes e, ticks)) - | (tmArgs,[]) <- partitionEithers args -> case stripTicks e of - Var v -> Right (tmArgs, fmap (second (`mkTicks` ticks)) xes,v) - _ -> Left ($(curLoc) ++ "Not in normal form: res not simple var") - | otherwise -> Left ($(curLoc) ++ "Not in normal form: tyArgs") - _ -> - Left ($(curLoc) ++ "Not in normal form: no Letrec:\n\n" ++ showPpr expr ++ - "\n\nWhich has type:\n\n" ++ showPpr ty) - where - ty = termType tcm expr - --- | Same as @unsafeCoreTypeToHWType@, but discards void filter information -unsafeCoreTypeToHWType' - :: SrcSpan - -- ^ Approximate location in original source file - -> String - -> (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -> CustomReprs - -> TyConMap - -> Type - -> State HWMap HWType -unsafeCoreTypeToHWType' sp loc builtInTranslation reprs m ty = - stripFiltered <$> (unsafeCoreTypeToHWType sp loc builtInTranslation reprs m ty) - --- | Converts a Core type to a HWType given a function that translates certain --- builtin types. Errors if the Core type is not translatable. -unsafeCoreTypeToHWType - :: SrcSpan - -- ^ Approximate location in original source file - -> String - -> (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -> CustomReprs - -> TyConMap - -> Type - -> State HWMap FilteredHWType -unsafeCoreTypeToHWType sp loc builtInTranslation reprs m ty = - either (\msg -> throw (ClashException sp (loc ++ msg) Nothing)) id <$> - coreTypeToHWType builtInTranslation reprs m ty - --- | Same as @unsafeCoreTypeToHWTypeM@, but discards void filter information -unsafeCoreTypeToHWTypeM' - :: String - -> Type - -> NetlistMonad HWType -unsafeCoreTypeToHWTypeM' loc ty = - stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty - --- | Converts a Core type to a HWType within the NetlistMonad; errors on failure -unsafeCoreTypeToHWTypeM - :: String - -> Type - -> NetlistMonad FilteredHWType -unsafeCoreTypeToHWTypeM loc ty = do - (_,cmpNm) <- Lens.use curCompNm - tt <- Lens.use typeTranslator - reprs <- Lens.use customReprs - tcm <- Lens.use tcCache - htm0 <- Lens.use htyCache - let (hty,htm1) = runState (unsafeCoreTypeToHWType cmpNm loc tt reprs tcm ty) htm0 - htyCache Lens..= htm1 - return hty - --- | Same as @coreTypeToHWTypeM@, but discards void filter information -coreTypeToHWTypeM' - :: Type - -- ^ Type to convert to HWType - -> NetlistMonad (Maybe HWType) -coreTypeToHWTypeM' ty = - fmap stripFiltered <$> coreTypeToHWTypeM ty - - --- | Converts a Core type to a HWType within the NetlistMonad; 'Nothing' on failure -coreTypeToHWTypeM - :: Type - -- ^ Type to convert to HWType - -> NetlistMonad (Maybe FilteredHWType) -coreTypeToHWTypeM ty = do - tt <- Lens.use typeTranslator - reprs <- Lens.use customReprs - tcm <- Lens.use tcCache - htm0 <- Lens.use htyCache - let (hty,htm1) = runState (coreTypeToHWType tt reprs tcm ty) htm0 - htyCache Lens..= htm1 - return (hush hty) - --- | Constructs error message for unexpected projections out of a type annotated --- with a custom bit representation. -unexpectedProjectionErrorMsg - :: DataRepr' - -> Int - -- ^ Constructor index - -> Int - -- ^ Field index - -> String -unexpectedProjectionErrorMsg dataRepr cI fI = - "Unexpected projection of zero-width type: " ++ show (drType dataRepr) - ++ ". Tried to make a projection of field " ++ show fI ++ " of " - ++ constrNm ++ ". Did you try to project a field marked as zero-width" - ++ " by a custom bit representation annotation?" - where - constrNm = show (crName (drConstrs dataRepr !! cI)) - --- | Helper function of 'maybeConvertToCustomRepr' -convertToCustomRepr - :: HasCallStack - => CustomReprs - -> DataRepr' - -> HWType - -> HWType -convertToCustomRepr reprs dRepr@(DataRepr' name' size constrs) hwTy = - if length constrs == nConstrs then - if size <= 0 then - Void (Just cs) - else - cs - else - error (unwords - [ "Type", show name', "has", show nConstrs, "constructor(s), " - , "but the custom bit representation only specified", show (length constrs) - , "constructors." - ]) - where - cs = insertVoids $ case hwTy of - Sum name conIds -> - CustomSum name dRepr size (map packSum conIds) - SP name conIdsAndFieldTys -> - CustomSP name dRepr size (map packSP conIdsAndFieldTys) - Product name maybeFieldNames fieldTys - | [ConstrRepr' _cName _pos _mask _val fieldAnns] <- constrs -> - CustomProduct name dRepr size maybeFieldNames (zip fieldAnns fieldTys) - _ -> - error - ( "Found a custom bit representation annotation " ++ show dRepr ++ ", " - ++ "but it was applied to an unsupported HWType: " ++ show hwTy ++ ".") - - nConstrs :: Int - nConstrs = case hwTy of - (Sum _name conIds) -> length conIds - (SP _name conIdsAndFieldTys) -> length conIdsAndFieldTys - (Product {}) -> 1 - _ -> error ("Unexpected HWType: " ++ show hwTy) - - packSP (name, tys) = (uncheckedGetConstrRepr name reprs, name, tys) - packSum name = (uncheckedGetConstrRepr name reprs, name) - - -- Replace some "hwTy" with "Void (Just hwTy)" if the custom bit - -- representation indicated that field is represented by zero bits. We can't - -- simply remove them, as we'll later have to deal with an "overapplied" - -- constructor. If we remove the arguments altogether, we wouldn't know which - -- - on their own potentially non-void! - arguments to ignore. - insertVoids :: HWType -> HWType - insertVoids (CustomSP i d s constrs0) = - CustomSP i d s (map go0 constrs0) - where - go0 (con@(ConstrRepr' _ _ _ _ fieldAnns), i0, hwTys) = - (con, i0, zipWith go1 fieldAnns hwTys) - go1 0 hwTy0 = Void (Just hwTy0) - go1 _ hwTy0 = hwTy0 - insertVoids (CustomProduct i d s f fieldAnns) = - CustomProduct i d s f (map go fieldAnns) - where - go (0, hwTy0) = (0, Void (Just hwTy0)) - go (n, hwTy0) = (n, hwTy0) - insertVoids hwTy0 = hwTy0 - --- | Given a map containing custom bit representation, a type, and the same --- type represented as HWType, convert the HWType to a CustomSP/CustomSum if --- it has a custom bit representation. -maybeConvertToCustomRepr - :: CustomReprs - -- ^ Map containing all custom representations index on its type - -> Type - -- ^ Custom reprs are index on type, so we need the clash core type to look - -- it up. - -> HWType - -- ^ Type of previous argument represented as a HWType - -> HWType -maybeConvertToCustomRepr reprs (coreToType' -> Right tyName) hwTy - | Just dRepr <- getDataRepr tyName reprs = - convertToCustomRepr reprs dRepr hwTy -maybeConvertToCustomRepr _reprs _ty hwTy = hwTy - --- | Same as @coreTypeToHWType@, but discards void filter information -coreTypeToHWType' - :: (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -> CustomReprs - -> TyConMap - -> Type - -- ^ Type to convert to HWType - -> State HWMap (Either String HWType) -coreTypeToHWType' builtInTranslation reprs m ty = - fmap stripFiltered <$> coreTypeToHWType builtInTranslation reprs m ty - - --- | Converts a Core type to a HWType given a function that translates certain --- builtin types. Returns a string containing the error message when the Core --- type is not translatable. -coreTypeToHWType - :: (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -> CustomReprs - -> TyConMap - -> Type - -- ^ Type to convert to HWType - -> State HWMap (Either String FilteredHWType) -coreTypeToHWType builtInTranslation reprs m ty = do - htyM <- HashMap.lookup ty <$> get - case htyM of - Just hty -> return hty - _ -> do - hty0M <- builtInTranslation reprs m ty - hty1 <- go hty0M ty - modify (HashMap.insert ty hty1) - return hty1 - where - -- Try builtin translation; for now this is hardcoded to be the one in ghcTypeToHWType - go :: Maybe (Either String FilteredHWType) - -> Type - -> State (HashMap Type (Either String FilteredHWType)) - (Either String FilteredHWType) - go (Just hwtyE) _ = pure $ - (\(FilteredHWType hwty filtered) -> - (FilteredHWType (maybeConvertToCustomRepr reprs ty hwty) filtered)) <$> hwtyE - -- Strip transparant types: - go _ (coreView1 m -> Just ty') = - coreTypeToHWType builtInTranslation reprs m ty' - -- Try to create hwtype based on AST: - go _ (tyView -> TyConApp tc args) = runExceptT $ do - FilteredHWType hwty filtered <- mkADT builtInTranslation reprs m (showPpr ty) tc args - return (FilteredHWType (maybeConvertToCustomRepr reprs ty hwty) filtered) - -- All methods failed: - go _ _ = return $ Left $ "Can't translate non-tycon type: " ++ showPpr ty - --- | Generates original indices in list before filtering, given a list of --- removed indices. --- --- >>> originalIndices [False, False, True, False] --- [0,1,3] -originalIndices - :: [Bool] - -- ^ Were voids. Length must be less than or equal to n. - -> [Int] - -- ^ Original indices -originalIndices wereVoids = - [i | (i, void) <- zip [0..] wereVoids, not void] - --- | Converts an algebraic Core type (split into a TyCon and its argument) to a HWType. -mkADT - :: (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -- ^ Hardcoded Type -> HWType translator - -> CustomReprs - -> TyConMap - -- ^ TyCon cache - -> String - -- ^ String representation of the Core type for error messages - -> TyConName - -- ^ The TyCon - -> [Type] - -- ^ Its applied arguments - -> ExceptT String (State HWMap) FilteredHWType - -- ^ An error string or a tuple with the type and possibly a list of - -- removed arguments. -mkADT _ _ m tyString tc _ - | isRecursiveTy m tc - = throwE $ $(curLoc) ++ "Can't translate recursive type: " ++ tyString - -mkADT builtInTranslation reprs m tyString tc args = case tyConDataCons (m `lookupUniqMap'` tc) of - [] -> return (FilteredHWType (Void Nothing) []) - dcs -> do - let tcName = nameOcc tc - substArgTyss = map (`substArgTys` args) dcs - argHTyss0 <- mapM (mapM (ExceptT . coreTypeToHWType builtInTranslation reprs m)) substArgTyss - let argHTyss1 = map (\tys -> zip (map isFilteredVoid tys) tys) argHTyss0 - let areVoids = map (map fst) argHTyss1 - let filteredArgHTyss = map (map snd . filter (not . fst)) argHTyss1 - - -- Every alternative is annotated with some examples. Be sure to read them. - case (dcs, filteredArgHTyss) of - _ | any (hasUnconstrainedExistential m) dcs -> - throwE $ $(curLoc) ++ - "Can't translate data types with unconstrained existentials: " ++ - tyString - -- Type has one constructor and that constructor has a single field, - -- modulo empty fields if keepVoid is False. Examples of such fields - -- are: - -- - -- >>> data ABC = ABC Int - -- >>> data DEF = DEF Int () - -- - -- Notice that @DEF@'s constructor has an "empty" second argument. The - -- second field of FilteredHWType would then look like: - -- - -- >>> [[False, True]] - (_:[],[[elemTy]]) -> - return (FilteredHWType (stripFiltered elemTy) argHTyss1) - - -- Type has one constructor, but multiple fields modulo empty fields - -- (see previous case for more thorough explanation). Examples: - -- - -- >>> data GHI = GHI Int Int - -- >>> data JKL = JKL Int () Int - -- - -- In the second case the second field of FilteredHWType would be - -- [[False, True, False]] - ([dcFieldLabels -> labels0],[elemTys@(_:_)]) -> do - labelsM <- - if null labels0 then - return Nothing - else - -- Filter out labels belonging to arguments filtered due to being - -- void. See argHTyss1. - let areNotVoids = map not (head areVoids) in - let labels1 = filter fst (zip areNotVoids labels0) in - let labels2 = map snd labels1 in - return (Just labels2) - let hwty = Product tcName labelsM (map stripFiltered elemTys) - return (FilteredHWType hwty argHTyss1) - - -- Either none of the constructors have fields, or they have been filtered - -- due to them being empty. Examples: - -- - -- >>> data MNO = M | N | O - -- >>> data PQR = P () | Q | R () - -- >>> data STU = STU - -- >>> data VWX - (_, concat -> []) - -- If none of the dataconstructors have fields, and there are 1 or less - -- of them, this type only has one inhabitant. It can therefore be - -- represented by zero bits, and is therefore empty: - | length dcs <= 1 -> case argHTyss0 of - [argHTys0] -> - -- We need this to preserve constraint-tuples of `KnownDomains` - let argHTys1 = map (stripVoid . stripFiltered) argHTys0 - in return (FilteredHWType - (Void (Just (Product tcName Nothing argHTys1))) - argHTyss1) - _ -> return (FilteredHWType (Void Nothing) argHTyss1) - -- None of the dataconstructors have fields. This type is therefore a - -- simple Sum type. - | otherwise -> - return (FilteredHWType (Sum tcName $ map (nameOcc . dcName) dcs) argHTyss1) - - -- A sum of product, due to multiple constructors, where at least one - -- of the constructor has one or more fields modulo empty fields. Example: - -- - -- >>> data YZA = Y Int | Z () | A - (_,elemHTys) -> - return $ FilteredHWType (SP tcName $ zipWith - (\dc tys -> ( nameOcc (dcName dc), tys)) - dcs (map stripFiltered <$> elemHTys)) argHTyss1 - --- | Determine whether a data constructor has unconstrained existential type --- variables, i.e. those that cannot be inferred by the (potential) constraints --- between the existential type variables and universal type variables. --- --- So here we have an example of a constrained existential: --- --- data Vec :: Nat -> Type -> Type --- where --- Nil :: Vec 0 a --- Cons :: forall m . (n ~ m + 1) => a -> Vec m a -> Vec n a --- --- where we can generate a type for `m` when we know `n` (by doing `n-1`). --- --- And here is an example of an unconstrained existential: --- --- data SomeSNat where --- where --- SomeSNat :: forall m . SNat m -> SomeSNat --- --- where there is no way to generate a type for `m` from any context. --- --- So why do we care? Because terms need to be completely monomorphic in order --- to be translated to circuits. And having a topEntity lambda-bound variable --- with an unconstrained existential type prevents us from achieving a fully --- monomorphic term. -hasUnconstrainedExistential - :: TyConMap - -> DataCon - -> Bool -hasUnconstrainedExistential tcm dc = - let eTVs = dcExtTyVars dc - uTVs = dcUnivTyVars dc - constraints = mapMaybe (typeEq tcm) (dcArgTys dc) - - -- Is the existential `eTV` constrained by the constraint `(ty1,ty2)` - isConstrainedBy eTV (ty1,ty2) = - let -- Free FVs in the LHS and RHS of the constraint that are not the - -- in the set of universal type variables of the constructor. - ty1FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce) - IntSet.empty) - ty1 - ty2FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce) - IntSet.empty) - ty2 - - -- Determine whether `eTV` can be generated from one side of a - -- constraint, under the assumption that the other side of the - -- constraint mentions no existential type variables. - isGenerative :: - -- Side (LHS or RHS) of a constraint - Type -> - -- Its free type variables (that are no in the set of universal - -- type variables) - [TyVar] -> - Bool - isGenerative t efvs = case tyView t of - TyConApp tcNm _ - | Just (FunTyCon {}) <- lookupUniqMap tcNm tcm - -- For type families we can only "calculate" the `eTV` if it is - -- the only free variable. e.g. we can work out from `n + 1 ~ 4` - -- that `n ~ 3`, but can't do anything for `n + m ~ 4`. - -> [eTV] == efvs - | otherwise - -- Normal type constructors are fully generative, e.g. given: - -- DomainConfiguration a b ~ DomainConfiguration "System" 10000 - -- - -- we can infer both `a ~ "System"` and `b ~ 10000` - -> eTV `elem` efvs - FunTy {} - -- Functions are also fully generative - -> eTV `elem` efvs - OtherType other -> case other of - VarTy v -> v == eTV - LitTy _ -> False - -- Anything else, like some higher-kinded quantified type we - -- just give up for now. TODO: implement this - _ -> False - - onlyTy1 = isGenerative ty1 ty1FEVs && null ty2FEVs - onlyTy2 = isGenerative ty2 ty2FEVs && null ty1FEVs - in onlyTy1 || onlyTy2 - - -- The existential type variables that are not constrained by any of the - -- constraints. - unconstrainedETVs = - filter (\v -> not (any (isConstrainedBy v) constraints)) eTVs - - in not (null unconstrainedETVs) - - --- | Simple check if a TyCon is recursively defined. -isRecursiveTy :: TyConMap -> TyConName -> Bool -isRecursiveTy m tc = case tyConDataCons (m `lookupUniqMap'` tc) of - [] -> False - dcs -> let argTyss = map dcArgTys dcs - argTycons = (map fst . catMaybes) $ (concatMap . map) splitTyConAppM argTyss - in tc `elem` argTycons - --- | Determines if a Core type is translatable to a HWType given a function that --- translates certain builtin types. -representableType - :: (CustomReprs -> TyConMap -> Type -> - State HWMap (Maybe (Either String FilteredHWType))) - -> CustomReprs - -> Bool - -- ^ String considered representable - -> TyConMap - -> Type - -> Bool -representableType builtInTranslation reprs stringRepresentable m = - either (const False) isRepresentable . - flip evalState HashMap.empty . - coreTypeToHWType' builtInTranslation reprs m - where - isRepresentable hty = case hty of - String -> stringRepresentable - Vector _ elTy -> isRepresentable elTy - RTree _ elTy -> isRepresentable elTy - Product _ _ elTys -> all isRepresentable elTys - SP _ elTyss -> all (all isRepresentable . snd) elTyss - BiDirectional _ t -> isRepresentable t - Annotated _ ty -> isRepresentable ty - _ -> True - --- | Determines the bitsize of a type. For types that don't get turned --- into real values in hardware (string, integer) the size is 0. -typeSize :: HWType - -> Int -typeSize (Void {}) = 0 -typeSize FileType = 32 -- (ref. page 287 of IEEE 1364-2005) -typeSize String = 0 -typeSize Integer = 0 -typeSize (KnownDomain {}) = 0 -typeSize Bool = 1 -typeSize Bit = 1 -typeSize (Clock _) = 1 -typeSize (Reset {}) = 1 -typeSize (BitVector i) = i -typeSize (Index 0) = 0 -typeSize (Index 1) = 1 -typeSize (Index u) = fromMaybe 0 (clogBase 2 u) -typeSize (Signed i) = i -typeSize (Unsigned i) = i -typeSize (Vector n el) = n * typeSize el -typeSize (RTree d el) = (2^d) * typeSize el -typeSize t@(SP _ cons) = conSize t + - maximum (map (sum . map typeSize . snd) cons) -typeSize (Sum _ dcs) = fromMaybe 0 . clogBase 2 . toInteger $ length dcs -typeSize (Product _ _ tys) = sum $ map typeSize tys -typeSize (BiDirectional In h) = typeSize h -typeSize (BiDirectional Out _) = 0 -typeSize (CustomSP _ _ size _) = fromIntegral size -typeSize (CustomSum _ _ size _) = fromIntegral size -typeSize (CustomProduct _ _ size _ _) = fromIntegral size -typeSize (Annotated _ ty) = typeSize ty - --- | Determines the bitsize of the constructor of a type -conSize :: HWType - -> Int -conSize (SP _ cons) = fromMaybe 0 . clogBase 2 . toInteger $ length cons -conSize t = typeSize t - --- | Gives the length of length-indexed types -typeLength :: HWType - -> Int -typeLength (Vector n _) = n -typeLength _ = 0 - --- | Gives the HWType corresponding to a term. Returns an error if the term has --- a Core type that is not translatable to a HWType. -termHWType :: String - -> Term - -> NetlistMonad HWType -termHWType loc e = do - m <- Lens.use tcCache - let ty = termType m e - stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty - --- | Gives the HWType corresponding to a term. Returns 'Nothing' if the term has --- a Core type that is not translatable to a HWType. -termHWTypeM - :: Term - -- ^ Term to convert to HWType - -> NetlistMonad (Maybe FilteredHWType) -termHWTypeM e = do - m <- Lens.use tcCache - let ty = termType m e - coreTypeToHWTypeM ty - -isBiSignalIn :: HWType -> Bool -isBiSignalIn (BiDirectional In _) = True -isBiSignalIn _ = False - -containsBiSignalIn - :: HWType - -> Bool -containsBiSignalIn (BiDirectional In _) = True -containsBiSignalIn (Product _ _ tys) = any containsBiSignalIn tys -containsBiSignalIn (SP _ tyss) = any (any containsBiSignalIn . snd) tyss -containsBiSignalIn (Vector _ ty) = containsBiSignalIn ty -containsBiSignalIn (RTree _ ty) = containsBiSignalIn ty -containsBiSignalIn _ = False - --- | Helper function of @collectPortNames@, which operates on a @PortName@ --- instead of a TopEntity. -collectPortNames' - :: [String] - -> PortName - -> [Identifier] -collectPortNames' prefixes (PortName nm) = - let prefixes' = reverse (nm : prefixes) in - [fromString (intercalate "_" prefixes')] -collectPortNames' prefixes (PortProduct "" nms) = - concatMap (collectPortNames' prefixes) nms -collectPortNames' prefixes (PortProduct prefix nms) = - concatMap (collectPortNames' (prefix : prefixes)) nms - --- | Recursively get all port names from top entity annotations. The result is --- a list of user defined port names, which should not be used by routines --- generating unique function names. Only completely qualified names are --- returned, as it does not (and cannot) account for any implicitly named ports --- under a PortProduct. -collectPortNames - :: TopEntity - -> [Identifier] -collectPortNames TestBench {} = [] -collectPortNames Synthesize { t_inputs, t_output } = - concatMap (collectPortNames' []) t_inputs ++ (collectPortNames' []) t_output - --- | Remove ports having a void-type from user supplied PortName annotation -filterVoidPorts - :: FilteredHWType - -> PortName - -> PortName -filterVoidPorts _hwty (PortName s) = - PortName s -filterVoidPorts (FilteredHWType _hwty [filtered]) (PortProduct s ps) - | length filtered > 1 - = PortProduct s [filterVoidPorts f p | (p, (void, f)) <- zip ps filtered, not void] -filterVoidPorts (FilteredHWType _hwty fs) (PortProduct s ps) - | length (filter (not.fst) (concat fs)) == 1 - , length fs > 1 - , length ps == 2 - = PortProduct s ps -filterVoidPorts filtered pp@(PortProduct _s _ps) = - -- TODO: Prettify errors - error $ $(curLoc) ++ "Ports were annotated as product, but type wasn't one: \n\n" - ++ " Filtered was: " ++ show filtered ++ "\n\n" - ++ " Ports was: " ++ show pp - --- | Uniquely rename all the variables and their references in a normalized --- term -mkUniqueNormalized - :: HasCallStack - => InScopeSet - -> Maybe (Maybe TopEntity) - -- ^ Top entity annotation where: - -- - -- * Nothing: term is not a top entity - -- * Just Nothing: term is a top entity, but has no explicit annotation - -- * Just (Just ..): term is a top entity, and has an explicit annotation - -> ( [Id] - , [LetBinding] - , Id - ) - -> NetlistMonad - ([Bool] - ,[(Identifier,HWType)] - ,[Declaration] - ,[(Identifier,HWType)] - ,[Declaration] - ,[LetBinding] - ,Maybe Id) -mkUniqueNormalized is0 topMM (args,binds,res) = do - -- Add user define port names to list of seen ids to prevent name collisions. - let - portNames = - case join topMM of - Nothing -> [] - Just top -> collectPortNames top - - seenIds %= (HashMap.unionWith max (HashMap.fromList (map (,0) portNames))) - - let (bndrs,exprs) = unzip binds - - -- Make arguments unique - let is1 = is0 `extendInScopeSetList` (args ++ bndrs) - (wereVoids,iports,iwrappers,substArgs) <- mkUniqueArguments (mkSubst is1) topMM args - - -- Make result unique. This might yield 'Nothing' in which case the result - -- was a single BiSignalOut. This is superfluous in the HDL, as the argument - -- will already contain a bidirectional signal complementing the BiSignalOut. - resM <- mkUniqueResult substArgs topMM res - case resM of - Just (oports,owrappers,res1,substRes) -> do - -- Check whether any of the binders reference the result - let resRead = any (localIdOccursIn res) exprs - -- Rename some of the binders, see 'setBinderName' when this happens. - ((res2,subst1,extraBndr),bndrs1) <- - List.mapAccumLM (setBinderName substRes res resRead) (res1,substRes,[]) binds - -- Make let-binders unique, the result binder is already unique, so we - -- can skip it. - let (bndrsL,r:bndrsR) = break ((== res2)) bndrs1 - (bndrsL1,substL) <- mkUnique subst1 bndrsL - (bndrsR1,substR) <- mkUnique substL bndrsR - -- Replace old IDs by updated unique IDs in the RHSs of the let-binders - let exprs1 = map (substTm ("mkUniqueNormalized1" :: Doc ()) substR) exprs - -- Return the uniquely named arguments, let-binders, and result - return ( wereVoids - , iports - , iwrappers - , oports - , owrappers - , zip (bndrsL1 ++ r:bndrsR1) exprs1 ++ extraBndr - , Just res1) - Nothing -> do - (bndrs1, substArgs1) <- mkUnique substArgs bndrs - return ( wereVoids - , iports - , iwrappers - , [] - , [] - , zip bndrs1 - (map (substTm ("mkUniqueNormalized2" :: Doc ()) substArgs1) exprs) - ,Nothing) - --- | Set the name of the binder --- --- Normally, it just keeps the existing name, but there are two exceptions: --- --- 1. It's the binding for the result which is also referenced by another binding; --- in this case it's suffixed with `_rec` --- 2. The binding binds a primitive that has a name control field --- --- 2. takes priority over 1. Additionally, we create an additional binder when --- the return value gets a new name. -setBinderName - :: Subst - -- ^ Current substitution - -> Id - -- ^ The binder for the result - -> Bool - -- ^ Whether the result binder is referenced by another binder - -> (Id, Subst, [(Id,Term)]) - -- ^ * The (renamed) binder for the result - -- * The updated substitution in case the result binder is renamed - -- * A new binding, to assign the result in case the original binder for - -- the result got renamed. - -> (Id,Term) - -- ^ The binding - -> NetlistMonad ((Id, Subst, [(Id,Term)]),Id) -setBinderName subst res resRead m@(resN,_,_) (i,collectArgsTicks -> (k,args,ticks)) = case k of - Prim p -> let nm = primName p in extractPrimWarnOrFail nm >>= go nm - _ -> goDef - where - go nm (BlackBox {resultName = Just (BBTemplate nmD)}) = withTicks ticks $ \_ -> do - (bbCtx,_) <- preserveVarEnv (mkBlackBoxContext nm i args) - be <- Lens.use backend - let bbRetValName = case be of - SomeBackend s -> toStrict ((State.evalState (renderTemplate bbCtx nmD) s) 0) - i1 = modifyVarName (\n -> n {nameOcc = bbRetValName}) i - if res == i1 then do - ([i2],subst1) <- mkUnique subst [i1] - return ((i2,subst1,[(resN,Var i2)]),i2) - else - return (m,i1) - - go _ _ = goDef - - goDef - | i == res && resRead - = do - ([i1],subst1) <- mkUnique subst [modifyVarName (`appendToName` "_rec") res] - return ((i1, subst1, [(resN,Var i1)]),i1) - | i == res - = return (m,resN) - | otherwise - = return (m,i) - -mkUniqueArguments - :: Subst - -> Maybe (Maybe TopEntity) - -- ^ Top entity annotation where: - -- - -- * Nothing: term is not a top entity - -- * Just Nothing: term is a top entity, but has no explicit annotation - -- * Just (Just ..): term is a top entity, and has an explicit annotation - -> [Id] - -> NetlistMonad - ( [Bool] -- Were voids - , [(Identifier,HWType)] -- Arguments and their types - , [Declaration] -- Extra declarations - , Subst -- Substitution with new vars in scope - ) -mkUniqueArguments subst0 Nothing args = do - (args',subst1) <- mkUnique subst0 args - ports <- mapM idToInPort args' - return (map isNothing ports, catMaybes ports, [], subst1) - -mkUniqueArguments subst0 (Just teM) args = do - let iPortSupply = maybe (repeat Nothing) (extendPorts . t_inputs) teM - ports0 <- zipWithM go iPortSupply args - let (ports1, decls, subst) = unzip3 (catMaybes ports0) - return ( map isNothing ports0 - , concat ports1 - , concat decls - , extendInScopeIdList (extendIdSubstList subst0 (map snd subst)) - (map fst subst)) - where - go pM var = do - let i = varName var - i' = nameOcc i - ty = varType var - fHwty <- unsafeCoreTypeToHWTypeM $(curLoc) ty - let FilteredHWType hwty _ = fHwty - (ports,decls,_,pN) <- mkInput (filterVoidPorts fHwty <$> pM) (i',hwty) - let pId = mkLocalId ty (repName pN i) - if isVoid hwty - then return Nothing - else return (Just (ports,decls,(pId,(var,Var pId)))) - - -mkUniqueResult - :: Subst - -> Maybe (Maybe TopEntity) - -- ^ Top entity annotation where: - -- - -- * Nothing: term is not a top entity - -- * Just Nothing: term is a top entity, but has no explicit annotation - -- * Just (Just ..): term is a top entity, and has an explicit annotation - -> Id - -> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Id,Subst)) -mkUniqueResult subst0 Nothing res = do - ([res'],subst1) <- mkUnique subst0 [res] - portM <- idToOutPort res' - case portM of - Just port -> return (Just ([port],[],res',subst1)) - _ -> return Nothing - -mkUniqueResult subst0 (Just teM) res = do - (_,sp) <- Lens.use curCompNm - let o = varName res - o' = nameOcc o - ty = varType res - fHwty <- unsafeCoreTypeToHWTypeM $(curLoc) ty - let FilteredHWType hwty _ = fHwty - oPortSupply = fmap t_output teM - when (containsBiSignalIn hwty) - (throw (ClashException sp ($(curLoc) ++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Nothing)) - output <- mkOutput (filterVoidPorts fHwty <$> oPortSupply) (o',hwty) - case output of - Just (ports, decls, pN) -> do - let pO = repName pN o - pOId = mkLocalId ty pO - subst1 = extendInScopeId (extendIdSubst subst0 res (Var pOId)) pOId - return (Just (ports,decls,pOId,subst1)) - _ -> return Nothing - --- | Same as idToPort, but --- * Throws an error if the port is a composite type with a BiSignalIn -idToInPort :: Id -> NetlistMonad (Maybe (Identifier,HWType)) -idToInPort var = do - (_, sp) <- Lens.use curCompNm - portM <- idToPort var - case portM of - Just (_,hty) -> do - when (containsBiSignalIn hty && not (isBiSignalIn hty)) - (throw (ClashException sp ($(curLoc) ++ "BiSignalIn currently cannot be part of a composite type when it's a function's argument") Nothing)) - return portM - _ -> return Nothing - --- | Same as idToPort, but: --- * Throws an error if port is of type BiSignalIn -idToOutPort :: Id -> NetlistMonad (Maybe (Identifier,HWType)) -idToOutPort var = do - (_, srcspan) <- Lens.use curCompNm - portM <- idToPort var - case portM of - Just (_,hty) -> do - when (containsBiSignalIn hty) - (throw (ClashException srcspan ($(curLoc) ++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Nothing)) - return portM - _ -> return Nothing - -idToPort :: Id -> NetlistMonad (Maybe (Identifier,HWType)) -idToPort var = do - let i = varName var - ty = varType var - hwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty - if isVoid hwTy - then return Nothing - else return (Just (nameOcc i, hwTy)) - -id2type :: Id -> Type -id2type = varType - -id2identifier :: Id -> Identifier -id2identifier = nameOcc . varName - -repName :: Text -> Name a -> Name a -repName s (Name sort' _ i loc) = Name sort' s i loc - --- | Make a set of IDs unique; also returns a substitution from old ID to new --- updated unique ID. -mkUnique - :: Subst - -- ^ Existing substitution - -> [Id] - -- ^ IDs to make unique - -> NetlistMonad ([Id],Subst) - -- ^ (Unique IDs, update substitution) -mkUnique = go [] - where - go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id],Subst) - go processed subst [] = return (reverse processed,subst) - go processed subst@(Subst isN _ _ _) (i:is) = do - iN <- mkUniqueIdentifier Extended (id2identifier i) - let i' = uniqAway isN (modifyVarName (repName iN) i) - subst' = extendInScopeId (extendIdSubst subst i (Var i')) i' - go (i':processed) - subst' - is - -mkUniqueIdentifier - :: IdType - -> Identifier - -> NetlistMonad Identifier -mkUniqueIdentifier typ nm = do - seen <- Lens.use seenIds - seenC <- Lens.use seenComps - i <- mkIdentifier typ nm - let getCopyIter k = getFirst (First (HashMap.lookup k seen) <> First (HashMap.lookup k seenC)) - case getCopyIter i of - Just n -> go n getCopyIter i - Nothing -> do - seenIds %= HashMap.insert i 0 - return i - where - go :: Word -> (Identifier -> Maybe Word) -> Identifier -> NetlistMonad Identifier - go n g i = do - i' <- extendIdentifier typ i (Text.pack ('_':show n)) - case g i' of - Just _ -> go (n+1) g i - Nothing -> do - seenIds %= HashMap.insert i (n+1) - -- Don't forget to add the extended ID to the list of seen identifiers, - -- in case we want to create a new identifier based on the extended ID - -- we return in this function - seenIds %= HashMap.insert i' 0 - return i' - --- | Preserve the complete state before running an action, and restore it --- afterwards. -preserveState - :: NetlistMonad a - -> NetlistMonad a -preserveState action = do - state <- State.get - val <- action - State.put state - pure val - --- | Preserve the Netlist '_varCount','_curCompNm','_seenIds' when executing --- a monadic action -preserveVarEnv - :: NetlistMonad a - -> NetlistMonad a -preserveVarEnv action = do - -- store state - vCnt <- Lens.use varCount - vComp <- Lens.use curCompNm - vSeen <- Lens.use seenIds - -- perform action - val <- action - -- restore state - varCount .= vCnt - curCompNm .= vComp - seenIds .= vSeen - return val - -dcToLiteral :: HWType -> Int -> Literal -dcToLiteral Bool 1 = BoolLit False -dcToLiteral Bool 2 = BoolLit True -dcToLiteral _ i = NumLit (toInteger i-1) - --- * TopEntity Annotations - -extendPorts :: [PortName] -> [Maybe PortName] -extendPorts ps = map Just ps ++ repeat Nothing - -portName - :: String - -> Identifier - -> Identifier -portName [] i = i -portName x _ = Text.pack x - --- | Prefix given string before portnames /except/ when this string is empty. -prefixParent :: String -> PortName -> PortName -prefixParent "" p = p -prefixParent parent (PortName p) = PortName (parent <> "_" <> p) -prefixParent parent (PortProduct "" ps) = PortProduct parent ps -prefixParent parent (PortProduct p ps) = PortProduct (parent <> "_" <> p) ps - - -appendIdentifier - :: (Identifier,HWType) - -> Int - -> NetlistMonad (Identifier,HWType) -appendIdentifier (nm,hwty) i = - (,hwty) <$> extendIdentifier Extended nm (Text.pack ('_':show i)) - --- | In addition to the original port name (where the user should assert that --- it's a valid identifier), we also add the version of the port name that has --- gone through the 'mkIdentifier Basic' process. Why? so that the provided port --- name is copied verbatim into the generated HDL, but that in e.g. --- case-insensitive HDLs, a case-variant of the port name is not used as one --- of the signal names. -uniquePortName - :: String - -> Identifier - -> NetlistMonad Identifier -uniquePortName [] i = mkUniqueIdentifier Extended i -uniquePortName x _ = do - let xT = Text.pack x - xTB <- mkIdentifier Basic xT - seenIds %= (\s -> List.foldl' (\m k -> HashMap.insert k 0 m) s [xT,xTB]) - return xT - -mkInput - :: Maybe PortName - -> (Identifier,HWType) - -> NetlistMonad ([(Identifier,HWType)],[Declaration],Expr,Identifier) -mkInput pM = case pM of - Nothing -> go - Just p -> go' p - where - -- No PortName given, infer names - go (i,hwty) = do - i' <- mkUniqueIdentifier Extended i - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - arguments <- mapM (appendIdentifier (i',hwty'')) [0..sz-1] - (ports,_,exprs,_) <- unzip4 <$> mapM (mkInput Nothing) arguments - let netdecl = NetDecl Nothing i' (Vector sz hwty'') - vecExpr = mkVectorChain sz hwty'' exprs - netassgn = Assignment i' vecExpr - if null attrs then - return (concat ports,[netdecl,netassgn],vecExpr,i') - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - arguments <- mapM (appendIdentifier (i',hwty'')) [0..2^d-1] - (ports,_,exprs,_) <- unzip4 <$> mapM (mkInput Nothing) arguments - let netdecl = NetDecl Nothing i' (RTree d hwty'') - trExpr = mkRTreeChain d hwty'' exprs - netassgn = Assignment i' trExpr - if null attrs then - return (concat ports,[netdecl,netassgn],trExpr,i') - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - arguments <- zipWithM appendIdentifier (map (i',) hwtys) [0..] - (ports,_,exprs,_) <- unzip4 <$> mapM (mkInput Nothing) arguments - case exprs of - [expr] -> - let netdecl = NetDecl Nothing i' hwty - dcExpr = expr - netassgn = Assignment i' expr - in return (concat ports,[netdecl,netassgn],dcExpr,i') - _ -> - let netdecl = NetDecl Nothing i' hwty - dcExpr = DataCon hwty (DC (hwty,0)) exprs - netassgn = Assignment i' dcExpr - in if null attrs then - return (concat ports,[netdecl,netassgn],dcExpr,i') - else - throwAnnotatedSplitError $(curLoc) "Product" - - _ -> return ([(i',hwty)],[],Identifier i' Nothing,i') - - - -- PortName specified by user - go' (PortName p) (i,hwty) = do - pN <- uniquePortName p i - return ([(pN,hwty)],[],Identifier pN Nothing,pN) - - go' (PortProduct p ps) (i,hwty) = do - pN <- uniquePortName p i - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - arguments <- mapM (appendIdentifier (pN,hwty'')) [0..sz-1] - (ports,_,exprs,_) <- unzip4 <$> zipWithM mkInput (extendPorts $ map (prefixParent p) ps) arguments - let netdecl = NetDecl Nothing pN (Vector sz hwty'') - vecExpr = mkVectorChain sz hwty'' exprs - netassgn = Assignment pN vecExpr - if null attrs then - return (concat ports,[netdecl,netassgn],vecExpr,pN) - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - arguments <- mapM (appendIdentifier (pN,hwty'')) [0..2^d-1] - (ports,_,exprs,_) <- unzip4 <$> zipWithM mkInput (extendPorts $ map (prefixParent p) ps) arguments - let netdecl = NetDecl Nothing pN (RTree d hwty'') - trExpr = mkRTreeChain d hwty'' exprs - netassgn = Assignment pN trExpr - if null attrs then - return (concat ports,[netdecl,netassgn],trExpr,pN) - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - arguments <- zipWithM appendIdentifier (map (pN,) hwtys) [0..] - let ps' = extendPorts $ map (prefixParent p) ps - (ports,_,exprs,_) <- unzip4 <$> uncurry (zipWithM mkInput) (ps', arguments) - case exprs of - [expr] -> - let netdecl = NetDecl Nothing pN hwty' - dcExpr = expr - netassgn = Assignment pN expr - in return (concat ports,[netdecl,netassgn],dcExpr,pN) - _ -> let netdecl = NetDecl Nothing pN hwty' - dcExpr = DataCon hwty' (DC (hwty',0)) exprs - netassgn = Assignment pN dcExpr - in if null attrs then - return (concat ports,[netdecl,netassgn],dcExpr,pN) - else - throwAnnotatedSplitError $(curLoc) "Product" - - SP _ ((concat . map snd) -> [elTy]) -> do - let hwtys = [BitVector (conSize hwty'),elTy] - arguments <- zipWithM appendIdentifier (map (pN,) hwtys) [0..] - let ps' = extendPorts $ map (prefixParent p) ps - (ports,_,exprs,_) <- unzip4 <$> uncurry (zipWithM mkInput) (ps', arguments) - case exprs of - [conExpr,elExpr] -> do - let netdecl = NetDecl Nothing pN hwty' - dcExpr = DataCon hwty' (DC (BitVector (typeSize hwty'),0)) - [conExpr,ConvBV Nothing elTy True elExpr] - netassgn = Assignment pN dcExpr - return (concat ports,[netdecl,netassgn],dcExpr,pN) - _ -> error "Unexpected error for PortProduct" - - _ -> return ([(pN,hwty)],[],Identifier pN Nothing,pN) - --- | Create a Vector chain for a list of 'Identifier's -mkVectorChain :: Int - -> HWType - -> [Expr] - -> Expr -mkVectorChain _ elTy [] = DataCon (Vector 0 elTy) VecAppend [] -mkVectorChain _ elTy [e] = DataCon (Vector 1 elTy) VecAppend - [e] -mkVectorChain sz elTy (e:es) = DataCon (Vector sz elTy) VecAppend - [ e - , mkVectorChain (sz-1) elTy es - ] - --- | Create a RTree chain for a list of 'Identifier's -mkRTreeChain :: Int - -> HWType - -> [Expr] - -> Expr -mkRTreeChain _ elTy [e] = DataCon (RTree 0 elTy) RTreeAppend - [e] -mkRTreeChain d elTy es = - let (esL,esR) = splitAt (length es `div` 2) es - in DataCon (RTree d elTy) RTreeAppend - [ mkRTreeChain (d-1) elTy esL - , mkRTreeChain (d-1) elTy esR - ] - -genComponentName - :: Bool - -> HashMap Identifier Word - -> (IdType -> Identifier -> Identifier) - -> ComponentPrefix - -> Id - -> Identifier -genComponentName newInlineStrat seen mkIdFn prefixM nm = - let nm' = Text.splitOn (Text.pack ".") (nameOcc (varName nm)) - fn = mkIdFn Basic (stripDollarPrefixes (last nm')) - fn' = if Text.null fn then Text.pack "Component" else fn - prefix = maybe id (:) (componentPrefixOther prefixM) (if newInlineStrat then [] else init nm') - nm2 = Text.concat (intersperse (Text.pack "_") (prefix ++ [fn'])) - nm3 = mkIdFn Basic nm2 - in case HashMap.lookup nm3 seen of - Just n -> go n nm3 - Nothing -> nm3 - where - go :: Word -> Identifier -> Identifier - go n i = - let i' = mkIdFn Basic (i `Text.append` Text.pack ('_':show n)) - in case HashMap.lookup i' seen of - Just _ -> go (n+1) i - Nothing -> i' - -genTopComponentName - :: Bool - -> (IdType -> Identifier -> Identifier) - -> ComponentPrefix - -> Maybe TopEntity - -> Id - -> Identifier -genTopComponentName _newInlineStrat _mkIdFn prefixM (Just ann) _nm = - case componentPrefixTop prefixM of - Just p -> p `Text.append` Text.pack ('_':t_name ann) - _ -> Text.pack (t_name ann) -genTopComponentName newInlineStrat mkIdFn prefixM Nothing nm = - genComponentName newInlineStrat HashMap.empty mkIdFn prefixM' nm - where - -- use the prefix for top-level components - prefixM' = prefixM{componentPrefixOther = componentPrefixTop prefixM} - - --- | Strips one or more layers of attributes from a HWType; stops at first --- non-Annotated. Accumilates all attributes of nested annotations. -stripAttributes - :: HWType - -> ([Attr'], HWType) --- Recursively strip type, accumulate attrs: -stripAttributes (Annotated attrs typ) = - let (attrs', typ') = stripAttributes typ - in (attrs ++ attrs', typ') --- Not an annotated type, so just return it: -stripAttributes typ = ([], typ) - --- | Generate output port mappings -mkOutput - :: Maybe PortName - -> (Identifier,HWType) - -> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Identifier)) -mkOutput _pM (_o, (BiDirectional Out _)) = return Nothing -mkOutput _pM (_o, (Void _)) = return Nothing -mkOutput pM (o, hwty) = Just <$> mkOutput' pM (o, hwty) - --- | Generate output port mappings. Will yield Nothing if the only output is --- Void. -mkOutput' - :: Maybe PortName - -> (Identifier,HWType) - -> NetlistMonad ([(Identifier,HWType)],[Declaration],Identifier) -mkOutput' pM = case pM of - Nothing -> go - Just p -> go' p - where - go (o,hwty) = do - o' <- mkUniqueIdentifier Extended o - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - unless (null attrs) - (throwAnnotatedSplitError $(curLoc) "Vector") - results <- mapM (appendIdentifier (o',hwty'')) [0..sz-1] - (ports,decls,ids) <- unzip3 <$> mapM (mkOutput' Nothing) results - let netdecl = NetDecl Nothing o' hwty' - assigns = zipWith (assignId o' hwty' 10) ids [0..] - return (concat ports,netdecl:assigns ++ concat decls,o') - - RTree d hwty'' -> do - unless (null attrs) - (throwAnnotatedSplitError $(curLoc) "RTree") - results <- mapM (appendIdentifier (o',hwty'')) [0..2^d-1] - (ports,decls,ids) <- unzip3 <$> mapM (mkOutput' Nothing) results - let netdecl = NetDecl Nothing o' hwty' - assigns = zipWith (assignId o' hwty' 10) ids [0..] - return (concat ports,netdecl:assigns ++ concat decls,o') - - Product _ _ hwtys -> do - results <- zipWithM appendIdentifier (map (o,) hwtys) [0..] - (ports,decls,ids) <- unzip3 <$> mapM (mkOutput' Nothing) results - case ids of - [i] -> - let netdecl = NetDecl Nothing o' hwty - assign = Assignment i (Identifier o' Nothing) - in return (concat ports,netdecl:assign:concat decls,o') - _ -> - let netdecl = NetDecl Nothing o' hwty - assigns = zipWith (assignId o' hwty 0) ids [0..] - in if null attrs then - return (concat ports,netdecl:assigns ++ concat decls,o') - else - throwAnnotatedSplitError $(curLoc) "Product" - - _ -> return ([(o',hwty)],[],o') - - go' (PortName p) (o,hwty) = do - pN <- uniquePortName p o - return ([(pN,hwty)],[],pN) - - go' (PortProduct p ps) (_,hwty) = do - pN <- mkUniqueIdentifier Basic (Text.pack p) - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - unless (null attrs) - (throwAnnotatedSplitError $(curLoc) "Vector") - results <- mapM (appendIdentifier (pN,hwty'')) [0..sz-1] - (ports,decls,ids) <- unzip3 <$> zipWithM mkOutput' (extendPorts $ map (prefixParent p) ps) results - let netdecl = NetDecl Nothing pN hwty' - assigns = zipWith (assignId pN hwty' 10) ids [0..] - return (concat ports,netdecl:assigns ++ concat decls,pN) - - RTree d hwty'' -> do - unless (null attrs) - (throwAnnotatedSplitError $(curLoc) "RTree") - results <- mapM (appendIdentifier (pN,hwty'')) [0..2^d-1] - (ports,decls,ids) <- unzip3 <$> zipWithM mkOutput' (extendPorts $ map (prefixParent p) ps) results - let netdecl = NetDecl Nothing pN hwty' - assigns = zipWith (assignId pN hwty' 10) ids [0..] - return (concat ports,netdecl:assigns ++ concat decls,pN) - - Product _ _ hwtys -> do - results <- zipWithM appendIdentifier (map (pN,) hwtys) [0..] - let ps' = extendPorts $ map (prefixParent p) ps - (ports,decls,ids) <- unzip3 <$> uncurry (zipWithM mkOutput') (ps', results) - let netdecl = NetDecl Nothing pN hwty' - case ids of - [i] -> let assign = Assignment i (Identifier pN Nothing) - in return (concat ports,netdecl:assign:concat decls,pN) - - _ -> let assigns = zipWith (assignId pN hwty' 0) ids [0..] - in if null attrs then - return (concat ports,netdecl:assigns ++ concat decls,pN) - else - throwAnnotatedSplitError $(curLoc) "Product" - - SP _ ((concat . map snd) -> [elTy]) -> do - let hwtys = [BitVector (conSize hwty'),elTy] - results <- zipWithM appendIdentifier (map (pN,) hwtys) [0..] - let ps' = extendPorts $ map (prefixParent p) ps - (ports,decls,ids) <- unzip3 <$> uncurry (zipWithM mkOutput') (ps', results) - case ids of - [conId,elId] -> - let netdecl = NetDecl Nothing pN hwty' - conIx = Sliced (BitVector (typeSize hwty') - ,typeSize hwty' - 1 - ,typeSize elTy - ) - elIx = Sliced (BitVector (typeSize hwty') - ,typeSize elTy - 1 - ,0 - ) - assigns = [Assignment conId (Identifier pN (Just conIx)) - ,Assignment elId (ConvBV Nothing elTy False - (Identifier pN (Just elIx))) - ] - in return (concat ports,netdecl:assigns ++ concat decls,pN) - _ -> error "Unexpected error for PortProduct" - - _ -> return ([(pN,hwty)],[],pN) - - assignId p hwty con i n = - Assignment i (Identifier p (Just (Indexed (hwty,con,n)))) - --- | Instantiate a TopEntity, and add the proper type-conversions where needed -mkTopUnWrapper - :: Id - -- ^ Name of the TopEntity component - -> Maybe TopEntity - -- ^ (maybe) a corresponding @TopEntity@ annotation - -> Manifest - -- ^ a corresponding @Manifest@ - -> (Identifier,HWType) - -- ^ The name and type of the signal to which to assign the result - -> [(Expr,HWType)] - -- ^ The arguments - -> [Declaration] - -- ^ Tick declarations - -> NetlistMonad [Declaration] -mkTopUnWrapper topEntity annM man dstId args tickDecls = do - let inTys = portInTypes man - outTys = portOutTypes man - inNames = portInNames man - outNames = portOutNames man - - -- component name - newInlineStrat <- opt_newInlineStrat <$> Lens.use clashOpts - mkIdFn <- Lens.use mkIdentifierFn - prefixM <- Lens.use componentPrefix - let topName = genTopComponentName newInlineStrat mkIdFn prefixM annM topEntity - topM = fmap (const topName) annM - - -- inputs - let iPortSupply = maybe (repeat Nothing) - (extendPorts . t_inputs) - annM - arguments <- zipWithM appendIdentifier (map (\a -> ("input",snd a)) args) [0..] - (_,arguments1) <- List.mapAccumLM (\acc (p,i) -> mkTopInput topM acc p i) - (zip inNames inTys) - (zip iPortSupply arguments) - let (iports,wrappers,idsI) = unzip3 arguments1 - inpAssigns = zipWith (argBV topM) idsI (map fst args) - - -- output - let oPortSupply = maybe - (repeat Nothing) - (extendPorts . (:[]) . t_output) - annM - - let iResult = inpAssigns ++ concat wrappers - result = ("result",snd dstId) - - instLabel0 <- extendIdentifier Basic topName ("_" `Text.append` fst dstId) - instLabel1 <- fromMaybe instLabel0 <$> Lens.view setName - instLabel2 <- affixName instLabel1 - instLabel3 <- mkUniqueIdentifier Basic instLabel2 - topOutputM <- mkTopOutput topM (zip outNames outTys) (head oPortSupply) result - - let - topCompDecl oports = - InstDecl - Entity - (Just topName) - topName - instLabel3 - [] - ( map (\(p,i,t) -> (Identifier p Nothing,In, t,Identifier i Nothing)) (concat iports) ++ - map (\(p,o,t) -> (Identifier p Nothing,Out,t,Identifier o Nothing)) oports) - - case topOutputM of - Nothing -> - pure (topCompDecl [] : iResult) - Just (_, (oports, unwrappers, idsO)) -> do - let outpAssign = Assignment (fst dstId) (resBV topM idsO) - pure (iResult ++ tickDecls ++ (topCompDecl oports:unwrappers) ++ [outpAssign]) - --- | Convert between BitVector for an argument -argBV - :: Maybe Identifier - -- ^ (maybe) Name of the _TopEntity_ - -> Either Identifier (Identifier, HWType) - -- ^ Either: - -- * A /normal/ argument - -- * An argument with a @PortName@ - -> Expr - -> Declaration -argBV _ (Left i) e = Assignment i e -argBV topM (Right (i,t)) e = Assignment i - . doConv t (fmap Just topM) False - $ doConv t (fmap (const Nothing) topM) True e - --- | Convert between BitVector for the result -resBV - :: Maybe Identifier - -- ^ (mabye) Name of the _TopEntity_ - -> Either Identifier (Identifier, HWType) - -- ^ Either: - -- * A /normal/ result - -- * A result with a @PortName@ - -> Expr -resBV _ (Left i) = Identifier i Nothing -resBV topM (Right (i,t)) = doConv t (fmap (const Nothing) topM) False - . doConv t (fmap Just topM) True - $ Identifier i Nothing - - --- | Add to/from-BitVector conversion logic -doConv - :: HWType - -- ^ We only need it for certain types - -> Maybe (Maybe Identifier) - -- ^ - -- * Nothing: No _given_ TopEntity, no need for conversion, this - -- happens when we have a _TestBench_, but no - -- _TopEntity_ annotation. - -- * Just Nothing: Converting to/from a BitVector for one of the - -- internally defined types. - -- * Just (Just top): Converting to/from a BitVector for one of the - -- types defined by @top@. - -> Bool - -- ^ - -- * True: convert to a BitVector - -- * False: convert from a BitVector - -> Expr - -- ^ The expression on top of which we have to add conversion logic - -> Expr -doConv _ Nothing _ e = e -doConv hwty (Just topM) b e = case hwty of - Vector {} -> ConvBV topM hwty b e - RTree {} -> ConvBV topM hwty b e - Product {} -> ConvBV topM hwty b e - _ -> e - --- | Generate input port mappings for the TopEntity -mkTopInput - :: Maybe Identifier - -- ^ (maybe) Name of the _TopEntity_ - -> [(Identifier,Identifier)] - -- ^ /Rendered/ input port names and types - -> Maybe PortName - -- ^ (maybe) The @PortName@ of a _TopEntity_ annotation for this input - -> (Identifier,HWType) - -> NetlistMonad ([(Identifier,Identifier)] - ,([(Identifier,Identifier,HWType)] - ,[Declaration] - ,Either Identifier (Identifier,HWType))) -mkTopInput topM inps pM = case pM of - Nothing -> go inps - Just p -> go' p inps - where - -- No @PortName@ - go inps'@((iN,_):rest) (i,hwty) = do - i' <- mkUniqueIdentifier Basic i - let iDecl = NetDecl Nothing i' hwty - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - arguments <- mapM (appendIdentifier (i',hwty'')) [0..sz-1] - (inps'',arguments1) <- List.mapAccumLM go inps' arguments - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier i' (Just (Indexed (hwty,10,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,iDecl:assigns++concat decls,Left i')) - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - arguments <- mapM (appendIdentifier (i',hwty'')) [0..2^d-1] - (inps'',arguments1) <- List.mapAccumLM go inps' arguments - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier i' (Just (Indexed (hwty,10,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,iDecl:assigns++concat decls,Left i')) - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - arguments <- zipWithM appendIdentifier (map (i,) hwtys) [0..] - (inps'',arguments1) <- List.mapAccumLM go inps' arguments - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier i' (Just (Indexed (hwty,0,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,iDecl:assigns++concat decls,Left i')) - else - throwAnnotatedSplitError $(curLoc) "Product" - - _ -> return (rest,([(iN,i',hwty)],[iDecl],Left i')) - - go [] _ = error "This shouldn't happen" - - -- With a @PortName@ - go' (PortName _) ((iN,iTy):inps') (_,hwty) = do - iN' <- mkUniqueIdentifier Extended iN - return (inps',([(iN,iN',hwty)] - ,[NetDecl' Nothing Wire iN' (Left iTy) Nothing] - ,Right (iN',hwty))) - - go' (PortName _) [] _ = error "This shouldnt happen" - - go' (PortProduct p ps) inps' (i,hwty) = do - let pN = portName p i - pN' <- mkUniqueIdentifier Extended pN - let pDecl = NetDecl Nothing pN' hwty - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - arguments <- mapM (appendIdentifier (pN',hwty'')) [0..sz-1] - (inps'',arguments1) <- - List.mapAccumLM (\acc (p',o') -> mkTopInput topM acc p' o') inps' - (zip (extendPorts ps) arguments) - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier pN' (Just (Indexed (hwty,10,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,pDecl:assigns ++ concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - arguments <- mapM (appendIdentifier (pN',hwty'')) [0..2^d-1] - (inps'',arguments1) <- - List.mapAccumLM (\acc (p',o') -> mkTopInput topM acc p' o') inps' - (zip (extendPorts ps) arguments) - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier pN' (Just (Indexed (hwty,10,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,pDecl:assigns ++ concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - arguments <- zipWithM appendIdentifier (map (pN',) hwtys) [0..] - (inps'',arguments1) <- - List.mapAccumLM (\acc (p',o') -> mkTopInput topM acc p' o') inps' - (zip (extendPorts ps) arguments) - let (ports,decls,ids) = unzip3 arguments1 - assigns = zipWith (argBV topM) ids - [ Identifier pN' (Just (Indexed (hwty,0,n))) - | n <- [0..]] - if null attrs then - return (inps'',(concat ports,pDecl:assigns ++ concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "Product" - - SP _ ((concat . map snd) -> [elTy]) -> do - let hwtys = [BitVector (conSize hwty'),elTy] - arguments <- zipWithM appendIdentifier (map (pN',) hwtys) [0..] - (inps'',arguments1) <- - List.mapAccumLM (\acc (p',o') -> mkTopInput topM acc p' o') inps' - (zip (extendPorts ps) arguments) - let (ports,decls,ids) = unzip3 arguments1 - case ids of - [conId,elId] -> do - let conIx = Sliced (BitVector (typeSize hwty') - ,typeSize hwty' - 1 - ,typeSize elTy - ) - elIx = Sliced (BitVector (typeSize hwty') - ,typeSize elTy - 1 - ,0 - ) - assigns = [argBV topM conId (Identifier pN (Just conIx)) - ,argBV topM elId (ConvBV Nothing elTy False - (Identifier pN (Just elIx))) - ] - return (inps'',(concat ports,pDecl:assigns ++ concat decls,Left pN')) - _ -> error "Unexpected error for PortProduct" - - _ -> return (tail inps',([(pN,pN',hwty)],[pDecl],Left pN')) - - --- | Consider the following type signature: --- --- @ --- f :: Signal dom (Vec 6 A) \`Annotate\` Attr "keep" --- -> Signal dom (Vec 6 B) --- @ --- --- What does the annotation mean, considering that Clash will split these --- vectors into multiple in- and output ports? Should we apply the annotation --- to all individual ports? How would we handle pin mappings? For now, we simply --- throw an error. This is a helper function to do so. -throwAnnotatedSplitError - :: String - -> String - -> NetlistMonad a -throwAnnotatedSplitError loc typ = do - (_,sp) <- Lens.use curCompNm - throw $ ClashException sp (loc ++ printf msg typ typ) Nothing - where - msg = unwords $ [ "Attempted to split %s into a number of HDL ports. This" - , "is not allowed in combination with attribute annotations." - , "You can annotate %s's components by splitting it up" - , "manually." ] - --- | Generate output port mappings for the TopEntity. Yields /Nothing/ if --- the output is Void -mkTopOutput - :: Maybe Identifier - -- ^ (maybe) Name of the _TopEntity_ - -> [(Identifier,Identifier)] - -- ^ /Rendered/ output port names and types - -> Maybe PortName - -- ^ (maybe) The @PortName@ of a _TopEntity_ annotation for this output - -> (Identifier,HWType) - -> NetlistMonad ( Maybe ( [(Identifier, Identifier)] - , ( [(Identifier, Identifier, HWType)] - , [Declaration] - , Either Identifier (Identifier,HWType) - ) - ) - ) -mkTopOutput _topM _outps _pM (_id, BiDirectional Out _) = return Nothing -mkTopOutput _topM _outps _pM (_id, Void _) = return Nothing -mkTopOutput topM outps pM (o, hwty) = - Just <$> mkTopOutput' topM outps pM (o, hwty) - --- | Generate output port mappings for the TopEntity -mkTopOutput' - :: Maybe Identifier - -- ^ (maybe) Name of the _TopEntity_ - -> [(Identifier,Identifier)] - -- ^ /Rendered/ output port names and types - -> Maybe PortName - -- ^ (maybe) The @PortName@ of a _TopEntity_ annotation for this output - -> (Identifier,HWType) - -> NetlistMonad ([(Identifier,Identifier)] - ,([(Identifier,Identifier,HWType)] - ,[Declaration] - ,Either Identifier (Identifier,HWType)) - ) -mkTopOutput' topM outps pM = case pM of - Nothing -> go outps - Just p -> go' p outps - where - -- No @PortName@ - go outps'@((oN,_):rest) (o,hwty) = do - o' <- mkUniqueIdentifier Extended o - let oDecl = NetDecl Nothing o' hwty - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - results <- mapM (appendIdentifier (o',hwty'')) [0..sz-1] - (outps'',results1) <- List.mapAccumLM go outps' results - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment o' (mkVectorChain sz hwty'' ids') - if null attrs then - return (outps'',(concat ports,oDecl:netassgn:concat decls,Left o')) - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - results <- mapM (appendIdentifier (o',hwty'')) [0..2^d-1] - (outps'',results1) <- List.mapAccumLM go outps' results - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment o' (mkRTreeChain d hwty'' ids') - if null attrs then - return (outps'',(concat ports,oDecl:netassgn:concat decls,Left o')) - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - results <- zipWithM appendIdentifier (map (o',) hwtys) [0..] - (outps'',results1) <- List.mapAccumLM go outps' results - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment o' (DataCon hwty (DC (hwty,0)) ids') - if null attrs then - return (outps'', (concat ports,oDecl:netassgn:concat decls,Left o')) - else - throwAnnotatedSplitError $(curLoc) "Product" - - _ -> return (rest,([(oN,o',hwty)],[oDecl],Left o')) - - go [] _ = error "This shouldn't happen" - - -- With a @PortName@ - go' (PortName _) ((oN,oTy):outps') (_,hwty) = do - oN' <- mkUniqueIdentifier Extended oN - return (outps',([(oN,oN',hwty)] - ,[NetDecl' Nothing Wire oN' (Left oTy) Nothing] - ,Right (oN',hwty))) - - go' (PortName _) [] _ = error "This shouldnt happen" - - go' (PortProduct p ps) outps' (o,hwty) = do - let pN = portName p o - pN' <- mkUniqueIdentifier Extended pN - let pDecl = NetDecl Nothing pN' hwty - let (attrs, hwty') = stripAttributes hwty - case hwty' of - Vector sz hwty'' -> do - results <- mapM (appendIdentifier (pN',hwty'')) [0..sz-1] - (outps'',results1) <- - List.mapAccumLM (\acc (p',o') -> mkTopOutput' topM acc p' o') outps' - (zip (extendPorts ps) results) - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment pN' (mkVectorChain sz hwty'' ids') - if null attrs then - return (outps'',(concat ports,pDecl:netassgn:concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "Vector" - - RTree d hwty'' -> do - results <- mapM (appendIdentifier (pN',hwty'')) [0..2^d-1] - (outps'',results1) <- - List.mapAccumLM (\acc (p',o') -> mkTopOutput' topM acc p' o') outps' - (zip (extendPorts ps) results) - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment pN' (mkRTreeChain d hwty'' ids') - if null attrs then - return (outps'',(concat ports,pDecl:netassgn:concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "RTree" - - Product _ _ hwtys -> do - results <- zipWithM appendIdentifier (map (pN',) hwtys) [0..] - (outps'',results1) <- - List.mapAccumLM (\acc (p',o') -> mkTopOutput' topM acc p' o') outps' - (zip (extendPorts ps) results) - let (ports,decls,ids) = unzip3 results1 - ids' = map (resBV topM) ids - netassgn = Assignment pN' (DataCon hwty (DC (hwty,0)) ids') - if null attrs then - return (outps'',(concat ports,pDecl:netassgn:concat decls,Left pN')) - else - throwAnnotatedSplitError $(curLoc) "Product" - - - SP _ ((concat . map snd) -> [elTy]) -> do - let hwtys = [BitVector (conSize elTy),elTy] - results <- zipWithM appendIdentifier (map (pN',) hwtys) [0..] - (outps'',results1) <- - List.mapAccumLM (\acc (p',o') -> mkTopOutput' topM acc p' o') outps' - (zip (extendPorts ps) results) - let (ports,decls,ids) = unzip3 results1 - ids1 = map (resBV topM) ids - ids2 = case ids1 of - [conId,elId] -> [conId,ConvBV Nothing elTy True elId] - _ -> error "Unexpected error for PortProduct" - netassgn = Assignment pN' (DataCon hwty (DC (BitVector (typeSize hwty),0)) ids2) - return (outps'',(concat ports,pDecl:netassgn:concat decls,Left pN')) - - _ -> return (tail outps',([(pN,pN',hwty)],[pDecl],Left pN')) - -concatPortDecls3 - :: [([(Identifier,Identifier,HWType)] - ,[Declaration] - ,Either Identifier (Identifier,HWType))] - -> ([(Identifier,Identifier,HWType)] - ,[Declaration] - ,[Either Identifier (Identifier,HWType)]) -concatPortDecls3 portDecls = case unzip3 portDecls of - (ps,decls,ids) -> (concat ps, concat decls, ids) - --- | Try to merge nested modifiers into a single modifier, needed by the VHDL --- and SystemVerilog backend. -nestM :: Modifier -> Modifier -> Maybe Modifier -nestM (Nested a b) m2 - | Just m1 <- nestM a b = maybe (Just (Nested m1 m2)) Just (nestM m1 m2) - | Just m2' <- nestM b m2 = maybe (Just (Nested a m2')) Just (nestM a m2') - -nestM (Indexed (Vector n t1,1,1)) (Indexed (Vector _ t2,1,0)) - | t1 == t2 = Just (Indexed (Vector n t1,10,1)) - -nestM (Indexed (Vector n t1,1,1)) (Indexed (Vector _ t2,10,k)) - | t1 == t2 = Just (Indexed (Vector n t1,10,k+1)) - -nestM (Indexed (RTree d1 t1,1,n)) (Indexed (RTree d2 t2,0,0)) - | t1 == t2 - , d1 >= 0 - , d2 >= 0 - = Just (Indexed (RTree d1 t1,10,n)) - -nestM (Indexed (RTree d1 t1,1,n)) (Indexed (RTree d2 t2,1,m)) - | t1 == t2 - , d1 >= 0 - , d2 >= 0 - = if | n == 1 && m == 1 -> let r = 2 ^ d1 - l = r - (2 ^ (d1-1) `div` 2) - in Just (Indexed (RTree (-1) t1, l, r)) - | n == 1 && m == 0 -> let l = 2 ^ (d1-1) - r = l + (l `div` 2) - in Just (Indexed (RTree (-1) t1, l, r)) - | n == 0 && m == 1 -> let l = (2 ^ (d1-1)) `div` 2 - r = 2 ^ (d1-1) - in Just (Indexed (RTree (-1) t1, l, r)) - | n == 0 && m == 0 -> let l = 0 - r = (2 ^ (d1-1)) `div` 2 - in Just (Indexed (RTree (-1) t1, l, r)) - | n > 1 || n < 0 -> error $ "nestM: n should be 0 or 1, not:" ++ show n - | m > 1 || m < 0 -> error $ "nestM: m should be 0 or 1, not:" ++ show m - | otherwise -> error $ "nestM: unexpected (n, m): " ++ show (n, m) -nestM (Indexed (RTree (-1) t1,l,_)) (Indexed (RTree d t2,10,k)) - | t1 == t2 - , d >= 0 - = Just (Indexed (RTree d t1,10,l+k)) - -nestM _ _ = Nothing - - --- | Determines if any type variables (exts) are bound in any of the given --- type or term variables (tms). It's currently only used to detect bound --- existentials, hence the name. -bindsExistentials - :: [TyVar] - -> [Var a] - -> Bool -bindsExistentials exts tms = any (`elem` freeVars) exts - where - freeVars = concatMap (Lens.toListOf typeFreeVars) (map varType tms) - -iteAlts :: HWType -> [Alt] -> Maybe (Term,Term) -iteAlts sHTy [(pat0,alt0),(pat1,alt1)] | validIteSTy sHTy = case pat0 of - DataPat dc _ _ -> case dcTag dc of - 2 -> Just (alt0,alt1) - _ -> Just (alt1,alt0) - LitPat (C.IntegerLiteral l) -> case l of - 1 -> Just (alt0,alt1) - _ -> Just (alt1,alt0) - DefaultPat -> case pat1 of - DataPat dc _ _ -> case dcTag dc of - 2 -> Just (alt1,alt0) - _ -> Just (alt0,alt1) - LitPat (C.IntegerLiteral l) -> case l of - 1 -> Just (alt1,alt0) - _ -> Just (alt0,alt1) - _ -> Nothing - _ -> Nothing - where - validIteSTy Bool = True - validIteSTy Bit = True - validIteSTy (Sum _ [_,_]) = True - validIteSTy (SP _ [_,_]) = True - validIteSTy (Unsigned 1) = True - validIteSTy (Index 2) = True - validIteSTy _ = False - -iteAlts _ _ = Nothing - --- | Run a NetlistMonad computation in the context of the given source ticks and --- name modifier ticks -withTicks - :: [TickInfo] - -> ([Declaration] -> NetlistMonad a) - -- ^ The source ticks are turned into 'TickDecl's and are passed as an argument - -- to the NetlistMonad computation. Name modifier ticks will change the local - -- environment for the NetlistMonad computation. - -> NetlistMonad a -withTicks ticks0 k = do - let ticks1 = List.nub ticks0 - go [] (reverse ticks1) - where - go decls [] = k (reverse decls) - - go decls (DeDup:ticks) = go decls ticks - - go decls (NoDeDup:ticks) = go decls ticks - - go decls (SrcSpan sp:ticks) = - go (TickDecl (Text.pack (showSDocUnsafe (ppr sp))):decls) ticks - - go decls (NameMod m nm0:ticks) = do - tcm <- Lens.use tcCache - case runExcept (tyLitShow tcm nm0) of - Right nm1 -> local (modName m nm1) (go decls ticks) - _ -> go decls ticks - - modName PrefixName (Text.pack -> s2) env@(NetlistEnv {_prefixName = s1}) - | Text.null s1 = env {_prefixName = s2} - | otherwise = env {_prefixName = s1 <> "_" <> s2} - modName SuffixName (Text.pack -> s2) env@(NetlistEnv {_suffixName = s1}) - | Text.null s1 = env {_suffixName = s2} - | otherwise = env {_suffixName = s2 <> "_" <> s1} - modName SuffixNameP (Text.pack -> s2) env@(NetlistEnv {_suffixName = s1}) - | Text.null s1 = env {_suffixName = s2} - | otherwise = env {_suffixName = s1 <> "_" <> s2} - modName SetName (Text.pack -> s) env = env {_setName = Just s} - --- | Add the pre- and suffix names in the current environment to the given --- identifier -affixName - :: Identifier - -> NetlistMonad Identifier -affixName nm0 = do - NetlistEnv pre suf _ <- ask - let nm1 = if Text.null pre then nm0 else pre <> "_" <> nm0 - nm2 = if Text.null suf then nm1 else nm1 <> "_" <> suf - return nm2 +{-# LANGUAGE MagicHash #-} +#if !MIN_VERSION_ghc(8,8,0) +{-# LANGUAGE MonadFailDesugaring #-} +#endif +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Clash.Netlist.Util where + +import Data.Coerce (coerce) +import Control.Error (hush) +import Control.Exception (throw) +import Control.Lens ((.=)) +import qualified Control.Lens as Lens +import Control.Monad (when, zipWithM) +import Control.Monad.Extra (concatMapM) +import Control.Monad.Reader (ask, local) +import qualified Control.Monad.State as State +import Control.Monad.State.Strict + (State, evalState, get, modify, runState) +import Control.Monad.Trans.Except + (ExceptT (..), runExcept, runExceptT, throwE) +import Data.Either (partitionEithers) +import Data.Foldable (Foldable(toList)) +import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.IntSet as IntSet +import Control.Applicative (Alternative((<|>))) +import Data.List (unzip4, partition) +import qualified Data.List as List +import Data.Maybe + (catMaybes, fromMaybe, isNothing, mapMaybe, isJust, listToMaybe, maybeToList) +import Text.Printf (printf) +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup ((<>)) +#endif +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Lazy (toStrict) +import Data.Text.Prettyprint.Doc.Extra +import TextShow (showt) + +#if MIN_VERSION_ghc(9,0,0) +import GHC.Utils.Monad (zipWith3M) +import GHC.Utils.Outputable (ppr, showSDocUnsafe) +#else +import MonadUtils (zipWith3M) +import Outputable (ppr, showSDocUnsafe) +#endif + +import Clash.Annotations.TopEntity + (TopEntity(..), PortName(..), defSyn) +import Clash.Annotations.BitRepresentation.ClashLib + (coreToType') +import Clash.Annotations.BitRepresentation.Internal + (CustomReprs, ConstrRepr'(..), DataRepr'(..), getDataRepr, + uncheckedGetConstrRepr) +import Clash.Backend (HWKind(..), hdlHWTypeKind) +import Clash.Core.DataCon (DataCon (..)) +import Clash.Core.EqSolver (typeEq) +import Clash.Core.FreeVars (localIdOccursIn, typeFreeVars, typeFreeVars') +import qualified Clash.Core.Literal as C +import Clash.Core.Name + (Name (..), appendToName, nameOcc) +import Clash.Core.Pretty (showPpr) +import Clash.Core.Subst + (Subst (..), extendIdSubst, extendIdSubstList, extendInScopeId, + extendInScopeIdList, mkSubst, substTm) +import Clash.Core.Term + (primMultiResult, MultiPrimInfo(..), Alt, LetBinding, Pat (..), Term (..), TickInfo (..), NameMod (..), + IsMultiPrim (..), collectArgsTicks, collectTicks, collectBndrs, PrimInfo(primName), mkTicks, stripTicks) +import Clash.Core.TermInfo +import Clash.Core.TyCon + (TyCon (FunTyCon), TyConName, TyConMap, tyConDataCons) +import Clash.Core.Type (Type (..), TypeView (..), + coreView1, splitTyConAppM, tyView, TyVar) +import Clash.Core.Util + (substArgTys, tyLitShow) +import Clash.Core.Var + (Id, Var (..), mkLocalId, modifyVarName, Attr') +import Clash.Core.VarEnv + (InScopeSet, extendInScopeSetList, uniqAway, lookupVarEnv) +import {-# SOURCE #-} Clash.Netlist.BlackBox +import {-# SOURCE #-} Clash.Netlist.BlackBox.Util +import Clash.Netlist.BlackBox.Types + (bbResultNames, BlackBoxMeta(BlackBoxMeta)) +import qualified Clash.Netlist.Id as Id +import Clash.Netlist.Types as HW +import Clash.Primitives.Types +import Clash.Unique +import Clash.Util +import qualified Clash.Util.Interpolate as I + +hmFindWithDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v +#if MIN_VERSION_unordered_containers(0,2,11) +hmFindWithDefault = HashMap.findWithDefault +#else +hmFindWithDefault = HashMap.lookupDefault +#endif + +-- | Generate a simple port_name expression. See: +-- +-- https://www.hdlworks.com/hdl_corner/vhdl_ref/VHDLContents/PortMap.htm +-- +-- This function will simply make the left part of a single port map, e.g. "Rst" +-- in: +-- +-- Rst => Reset +-- +-- If you need more complex constructions, e.g. +-- +-- Q(3 downto 1) +-- +-- you can build an Expr manually. +instPort :: Text -> Expr +instPort pn = Identifier (Id.unsafeMake pn) Nothing + +-- | Throw away information indicating which constructor fields were filtered +-- due to being void. +stripFiltered :: FilteredHWType -> HWType +stripFiltered (FilteredHWType hwty _filtered) = hwty + +-- | Strip as many "Void" layers as possible. Might still return a Void if the +-- void doesn't contain a hwtype. +stripVoid :: HWType -> HWType +stripVoid (Void (Just e)) = stripVoid e +stripVoid e = e + +flattenFiltered :: FilteredHWType -> [[Bool]] +flattenFiltered (FilteredHWType _hwty filtered) = map (map fst) filtered + +isVoidMaybe :: Bool -> Maybe HWType -> Bool +isVoidMaybe dflt Nothing = dflt +isVoidMaybe _dflt (Just t) = isVoid t + +-- | Determines if type is a zero-width construct ("void") +isVoid :: HWType -> Bool +isVoid Void {} = True +isVoid _ = False + +-- | Same as @isVoid@, but on @FilteredHWType@ instead of @HWType@ +isFilteredVoid :: FilteredHWType -> Bool +isFilteredVoid = isVoid . stripFiltered + +-- | Split a normalized term into: a list of arguments, a list of let-bindings, +-- and a variable reference that is the body of the let-binding. Returns a +-- String containing the error if the term was not in a normalized form. +splitNormalized + :: TyConMap + -> Term + -> (Either String ([Id],[LetBinding],Id)) +splitNormalized tcm expr = case collectBndrs expr of + (args, collectTicks -> (Letrec xes e, ticks)) + | (tmArgs,[]) <- partitionEithers args -> case stripTicks e of + Var v -> Right (tmArgs, fmap (second (`mkTicks` ticks)) xes,v) + _ -> Left ($(curLoc) ++ "Not in normal form: res not simple var") + | otherwise -> Left ($(curLoc) ++ "Not in normal form: tyArgs") + _ -> + Left ($(curLoc) ++ "Not in normal form: no Letrec:\n\n" ++ showPpr expr ++ + "\n\nWhich has type:\n\n" ++ showPpr ty) + where + ty = termType tcm expr + +-- | Same as @unsafeCoreTypeToHWType@, but discards void filter information +unsafeCoreTypeToHWType' + :: SrcSpan + -- ^ Approximate location in original source file + -> String + -> (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -> CustomReprs + -> TyConMap + -> Type + -> State HWMap HWType +unsafeCoreTypeToHWType' sp loc builtInTranslation reprs m ty = + stripFiltered <$> (unsafeCoreTypeToHWType sp loc builtInTranslation reprs m ty) + +-- | Converts a Core type to a HWType given a function that translates certain +-- builtin types. Errors if the Core type is not translatable. +unsafeCoreTypeToHWType + :: SrcSpan + -- ^ Approximate location in original source file + -> String + -> (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -> CustomReprs + -> TyConMap + -> Type + -> State HWMap FilteredHWType +unsafeCoreTypeToHWType sp loc builtInTranslation reprs m ty = + either (\msg -> throw (ClashException sp (loc ++ msg) Nothing)) id <$> + coreTypeToHWType builtInTranslation reprs m ty + +-- | Same as @unsafeCoreTypeToHWTypeM@, but discards void filter information +unsafeCoreTypeToHWTypeM' + :: String + -> Type + -> NetlistMonad HWType +unsafeCoreTypeToHWTypeM' loc ty = + stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty + +-- | Converts a Core type to a HWType within the NetlistMonad; errors on failure +unsafeCoreTypeToHWTypeM + :: String + -> Type + -> NetlistMonad FilteredHWType +unsafeCoreTypeToHWTypeM loc ty = do + (_,cmpNm) <- Lens.use curCompNm + tt <- Lens.use typeTranslator + reprs <- Lens.use customReprs + tcm <- Lens.use tcCache + htm0 <- Lens.use htyCache + let (hty,htm1) = runState (unsafeCoreTypeToHWType cmpNm loc tt reprs tcm ty) htm0 + htyCache Lens..= htm1 + return hty + +-- | Same as @coreTypeToHWTypeM@, but discards void filter information +coreTypeToHWTypeM' + :: Type + -- ^ Type to convert to HWType + -> NetlistMonad (Maybe HWType) +coreTypeToHWTypeM' ty = + fmap stripFiltered <$> coreTypeToHWTypeM ty + + +-- | Converts a Core type to a HWType within the NetlistMonad; 'Nothing' on failure +coreTypeToHWTypeM + :: Type + -- ^ Type to convert to HWType + -> NetlistMonad (Maybe FilteredHWType) +coreTypeToHWTypeM ty = do + tt <- Lens.use typeTranslator + reprs <- Lens.use customReprs + tcm <- Lens.use tcCache + htm0 <- Lens.use htyCache + let (hty,htm1) = runState (coreTypeToHWType tt reprs tcm ty) htm0 + htyCache Lens..= htm1 + return (hush hty) + +-- | Constructs error message for unexpected projections out of a type annotated +-- with a custom bit representation. +unexpectedProjectionErrorMsg + :: DataRepr' + -> Int + -- ^ Constructor index + -> Int + -- ^ Field index + -> String +unexpectedProjectionErrorMsg dataRepr cI fI = + "Unexpected projection of zero-width type: " ++ show (drType dataRepr) + ++ ". Tried to make a projection of field " ++ show fI ++ " of " + ++ constrNm ++ ". Did you try to project a field marked as zero-width" + ++ " by a custom bit representation annotation?" + where + constrNm = show (crName (drConstrs dataRepr !! cI)) + +-- | Helper function of 'maybeConvertToCustomRepr' +convertToCustomRepr + :: HasCallStack + => CustomReprs + -> DataRepr' + -> HWType + -> HWType +convertToCustomRepr reprs dRepr@(DataRepr' name' size constrs) hwTy = + if length constrs == nConstrs then + if size <= 0 then + Void (Just cs) + else + cs + else + error (unwords + [ "Type", show name', "has", show nConstrs, "constructor(s), " + , "but the custom bit representation only specified", show (length constrs) + , "constructors." + ]) + where + cs = insertVoids $ case hwTy of + Sum name conIds -> + CustomSum name dRepr size (map packSum conIds) + SP name conIdsAndFieldTys -> + CustomSP name dRepr size (map packSP conIdsAndFieldTys) + Product name maybeFieldNames fieldTys + | [ConstrRepr' _cName _pos _mask _val fieldAnns] <- constrs -> + CustomProduct name dRepr size maybeFieldNames (zip fieldAnns fieldTys) + _ -> + error + ( "Found a custom bit representation annotation " ++ show dRepr ++ ", " + ++ "but it was applied to an unsupported HWType: " ++ show hwTy ++ ".") + + nConstrs :: Int + nConstrs = case hwTy of + (Sum _name conIds) -> length conIds + (SP _name conIdsAndFieldTys) -> length conIdsAndFieldTys + (Product {}) -> 1 + _ -> error ("Unexpected HWType: " ++ show hwTy) + + packSP (name, tys) = (uncheckedGetConstrRepr name reprs, name, tys) + packSum name = (uncheckedGetConstrRepr name reprs, name) + + -- Replace some "hwTy" with "Void (Just hwTy)" if the custom bit + -- representation indicated that field is represented by zero bits. We can't + -- simply remove them, as we'll later have to deal with an "overapplied" + -- constructor. If we remove the arguments altogether, we wouldn't know which + -- - on their own potentially non-void! - arguments to ignore. + insertVoids :: HWType -> HWType + insertVoids (CustomSP i d s constrs0) = + CustomSP i d s (map go0 constrs0) + where + go0 (con@(ConstrRepr' _ _ _ _ fieldAnns), i0, hwTys) = + (con, i0, zipWith go1 fieldAnns hwTys) + go1 0 hwTy0 = Void (Just hwTy0) + go1 _ hwTy0 = hwTy0 + insertVoids (CustomProduct i d s f fieldAnns) = + CustomProduct i d s f (map go fieldAnns) + where + go (0, hwTy0) = (0, Void (Just hwTy0)) + go (n, hwTy0) = (n, hwTy0) + insertVoids hwTy0 = hwTy0 + +-- | Given a map containing custom bit representation, a type, and the same +-- type represented as HWType, convert the HWType to a CustomSP/CustomSum if +-- it has a custom bit representation. +maybeConvertToCustomRepr + :: CustomReprs + -- ^ Map containing all custom representations index on its type + -> Type + -- ^ Custom reprs are index on type, so we need the clash core type to look + -- it up. + -> FilteredHWType + -- ^ Type of previous argument represented as a HWType + -> FilteredHWType +maybeConvertToCustomRepr reprs (coreToType' -> Right tyName) (FilteredHWType hwTy filtered) + | Just dRepr <- getDataRepr tyName reprs = + FilteredHWType + (convertToCustomRepr reprs dRepr hwTy) + [ [ (fieldAnn == 0, hwty) | ((_, hwty), fieldAnn) <- zip fields (crFieldAnns constr) ] + | (fields, constr) <- zip filtered (drConstrs dRepr)] +maybeConvertToCustomRepr _reprs _ty hwTy = hwTy + +-- | Same as @coreTypeToHWType@, but discards void filter information +coreTypeToHWType' + :: (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -> CustomReprs + -> TyConMap + -> Type + -- ^ Type to convert to HWType + -> State HWMap (Either String HWType) +coreTypeToHWType' builtInTranslation reprs m ty = + fmap stripFiltered <$> coreTypeToHWType builtInTranslation reprs m ty + + +-- | Converts a Core type to a HWType given a function that translates certain +-- builtin types. Returns a string containing the error message when the Core +-- type is not translatable. +coreTypeToHWType + :: (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -> CustomReprs + -> TyConMap + -> Type + -- ^ Type to convert to HWType + -> State HWMap (Either String FilteredHWType) +coreTypeToHWType builtInTranslation reprs m ty = do + htyM <- HashMap.lookup ty <$> get + case htyM of + Just hty -> return hty + _ -> do + hty0M <- builtInTranslation reprs m ty + hty1 <- go hty0M ty + modify (HashMap.insert ty hty1) + return hty1 + where + -- Try builtin translation; for now this is hardcoded to be the one in ghcTypeToHWType + go :: Maybe (Either String FilteredHWType) + -> Type + -> State (HashMap Type (Either String FilteredHWType)) + (Either String FilteredHWType) + go (Just hwtyE) _ = pure $ maybeConvertToCustomRepr reprs ty <$> hwtyE + -- Strip transparant types: + go _ (coreView1 m -> Just ty') = + coreTypeToHWType builtInTranslation reprs m ty' + -- Try to create hwtype based on AST: + go _ (tyView -> TyConApp tc args) = runExceptT $ do + hwty <- mkADT builtInTranslation reprs m (showPpr ty) tc args + return (maybeConvertToCustomRepr reprs ty hwty) + -- All methods failed: + go _ _ = return $ Left $ "Can't translate non-tycon type: " ++ showPpr ty + +-- | Generates original indices in list before filtering, given a list of +-- removed indices. +-- +-- >>> originalIndices [False, False, True, False] +-- [0,1,3] +originalIndices + :: [Bool] + -- ^ Were voids. Length must be less than or equal to n. + -> [Int] + -- ^ Original indices +originalIndices wereVoids = + [i | (i, void) <- zip [0..] wereVoids, not void] + +-- | Converts an algebraic Core type (split into a TyCon and its argument) to a HWType. +mkADT + :: (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -- ^ Hardcoded Type -> HWType translator + -> CustomReprs + -> TyConMap + -- ^ TyCon cache + -> String + -- ^ String representation of the Core type for error messages + -> TyConName + -- ^ The TyCon + -> [Type] + -- ^ Its applied arguments + -> ExceptT String (State HWMap) FilteredHWType + -- ^ An error string or a tuple with the type and possibly a list of + -- removed arguments. +mkADT _ _ m tyString tc _ + | isRecursiveTy m tc + = throwE $ $(curLoc) ++ "Can't translate recursive type: " ++ tyString + +mkADT builtInTranslation reprs m tyString tc args = case tyConDataCons (m `lookupUniqMap'` tc) of + [] -> return (FilteredHWType (Void Nothing) []) + dcs -> do + let tcName = nameOcc tc + substArgTyss = map (`substArgTys` args) dcs + argHTyss0 <- mapM (mapM (ExceptT . coreTypeToHWType builtInTranslation reprs m)) substArgTyss + let argHTyss1 = map (\tys -> zip (map isFilteredVoid tys) tys) argHTyss0 + let areVoids = map (map fst) argHTyss1 + let filteredArgHTyss = map (map snd . filter (not . fst)) argHTyss1 + + -- Every alternative is annotated with some examples. Be sure to read them. + case (dcs, filteredArgHTyss) of + _ | any (hasUnconstrainedExistential m) dcs -> + throwE $ $(curLoc) ++ + "Can't translate data types with unconstrained existentials: " ++ + tyString + -- Type has one constructor and that constructor has a single field, + -- modulo empty fields if keepVoid is False. Examples of such fields + -- are: + -- + -- >>> data ABC = ABC Int + -- >>> data DEF = DEF Int () + -- + -- Notice that @DEF@'s constructor has an "empty" second argument. The + -- second field of FilteredHWType would then look like: + -- + -- >>> [[False, True]] + (_:[],[[elemTy]]) -> + return (FilteredHWType (stripFiltered elemTy) argHTyss1) + + -- Type has one constructor, but multiple fields modulo empty fields + -- (see previous case for more thorough explanation). Examples: + -- + -- >>> data GHI = GHI Int Int + -- >>> data JKL = JKL Int () Int + -- + -- In the second case the second field of FilteredHWType would be + -- [[False, True, False]] + ([dcFieldLabels -> labels0],[elemTys@(_:_)]) -> do + labelsM <- + if null labels0 then + return Nothing + else + -- Filter out labels belonging to arguments filtered due to being + -- void. See argHTyss1. + let areNotVoids = case areVoids of + areVoid:_ -> map not areVoid + _ -> error "internal error: insufficient areVoids" + labels1 = filter fst (zip areNotVoids labels0) + labels2 = map snd labels1 + in return (Just labels2) + let hwty = Product tcName labelsM (map stripFiltered elemTys) + return (FilteredHWType hwty argHTyss1) + + -- Either none of the constructors have fields, or they have been filtered + -- due to them being empty. Examples: + -- + -- >>> data MNO = M | N | O + -- >>> data PQR = P () | Q | R () + -- >>> data STU = STU + -- >>> data VWX + (_, concat -> []) + -- If none of the dataconstructors have fields, and there are 1 or less + -- of them, this type only has one inhabitant. It can therefore be + -- represented by zero bits, and is therefore empty: + | length dcs <= 1 -> case argHTyss0 of + [argHTys0] -> + -- We need this to preserve constraint-tuples of `KnownDomains` + let argHTys1 = map (stripVoid . stripFiltered) argHTys0 + in return (FilteredHWType + (Void (Just (Product tcName Nothing argHTys1))) + argHTyss1) + _ -> return (FilteredHWType (Void Nothing) argHTyss1) + -- None of the dataconstructors have fields. This type is therefore a + -- simple Sum type. + | otherwise -> + return (FilteredHWType (Sum tcName $ map (nameOcc . dcName) dcs) argHTyss1) + + -- A sum of product, due to multiple constructors, where at least one + -- of the constructor has one or more fields modulo empty fields. Example: + -- + -- >>> data YZA = Y Int | Z () | A + (_,elemHTys) -> + return $ FilteredHWType (SP tcName $ zipWith + (\dc tys -> ( nameOcc (dcName dc), tys)) + dcs (map stripFiltered <$> elemHTys)) argHTyss1 + +-- | Determine whether a data constructor has unconstrained existential type +-- variables, i.e. those that cannot be inferred by the (potential) constraints +-- between the existential type variables and universal type variables. +-- +-- So here we have an example of a constrained existential: +-- +-- data Vec :: Nat -> Type -> Type +-- where +-- Nil :: Vec 0 a +-- Cons :: forall m . (n ~ m + 1) => a -> Vec m a -> Vec n a +-- +-- where we can generate a type for `m` when we know `n` (by doing `n-1`). +-- +-- And here is an example of an unconstrained existential: +-- +-- data SomeSNat where +-- where +-- SomeSNat :: forall m . SNat m -> SomeSNat +-- +-- where there is no way to generate a type for `m` from any context. +-- +-- So why do we care? Because terms need to be completely monomorphic in order +-- to be translated to circuits. And having a topEntity lambda-bound variable +-- with an unconstrained existential type prevents us from achieving a fully +-- monomorphic term. +hasUnconstrainedExistential + :: TyConMap + -> DataCon + -> Bool +hasUnconstrainedExistential tcm dc = + let eTVs = dcExtTyVars dc + uTVs = dcUnivTyVars dc + constraints = mapMaybe (typeEq tcm) (dcArgTys dc) + + -- Is the existential `eTV` constrained by the constraint `(ty1,ty2)` + isConstrainedBy eTV (ty1,ty2) = + let -- Free FVs in the LHS and RHS of the constraint that are not the + -- in the set of universal type variables of the constructor. + ty1FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce) + IntSet.empty) + ty1 + ty2FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce) + IntSet.empty) + ty2 + + -- Determine whether `eTV` can be generated from one side of a + -- constraint, under the assumption that the other side of the + -- constraint mentions no existential type variables. + isGenerative :: + -- Side (LHS or RHS) of a constraint + Type -> + -- Its free type variables (that are no in the set of universal + -- type variables) + [TyVar] -> + Bool + isGenerative t efvs = case tyView t of + TyConApp tcNm _ + | Just (FunTyCon {}) <- lookupUniqMap tcNm tcm + -- For type families we can only "calculate" the `eTV` if it is + -- the only free variable. e.g. we can work out from `n + 1 ~ 4` + -- that `n ~ 3`, but can't do anything for `n + m ~ 4`. + -> [eTV] == efvs + | otherwise + -- Normal type constructors are fully generative, e.g. given: + -- DomainConfiguration a b ~ DomainConfiguration "System" 10000 + -- + -- we can infer both `a ~ "System"` and `b ~ 10000` + -> eTV `elem` efvs + FunTy {} + -- Functions are also fully generative + -> eTV `elem` efvs + OtherType other -> case other of + VarTy v -> v == eTV + LitTy _ -> False + -- Anything else, like some higher-kinded quantified type we + -- just give up for now. TODO: implement this + _ -> False + + onlyTy1 = isGenerative ty1 ty1FEVs && null ty2FEVs + onlyTy2 = isGenerative ty2 ty2FEVs && null ty1FEVs + in onlyTy1 || onlyTy2 + + -- The existential type variables that are not constrained by any of the + -- constraints. + unconstrainedETVs = + filter (\v -> not (any (isConstrainedBy v) constraints)) eTVs + + in not (null unconstrainedETVs) + + +-- | Simple check if a TyCon is recursively defined. +isRecursiveTy :: TyConMap -> TyConName -> Bool +isRecursiveTy m tc = case tyConDataCons (m `lookupUniqMap'` tc) of + [] -> False + dcs -> let argTyss = map dcArgTys dcs + argTycons = (map fst . catMaybes) $ (concatMap . map) splitTyConAppM argTyss + in tc `elem` argTycons + +-- | Determines if a Core type is translatable to a HWType given a function that +-- translates certain builtin types. +representableType + :: (CustomReprs -> TyConMap -> Type -> + State HWMap (Maybe (Either String FilteredHWType))) + -> CustomReprs + -> Bool + -- ^ String considered representable + -> TyConMap + -> Type + -> Bool +representableType builtInTranslation reprs stringRepresentable m = + either (const False) isRepresentable . + flip evalState HashMap.empty . + coreTypeToHWType' builtInTranslation reprs m + where + isRepresentable hty = case hty of + String -> stringRepresentable + Vector _ elTy -> isRepresentable elTy + RTree _ elTy -> isRepresentable elTy + Product _ _ elTys -> all isRepresentable elTys + SP _ elTyss -> all (all isRepresentable . snd) elTyss + BiDirectional _ t -> isRepresentable t + Annotated _ ty -> isRepresentable ty + _ -> True + +-- | Determines the bitsize of a type. For types that don't get turned +-- into real values in hardware (string, integer) the size is 0. +typeSize :: HWType + -> Int +typeSize (Void {}) = 0 +typeSize FileType = 32 -- (ref. page 287 of IEEE 1364-2005) +typeSize String = 0 +typeSize Integer = 0 +typeSize (KnownDomain {}) = 0 +typeSize Bool = 1 +typeSize Bit = 1 +typeSize (Clock _) = 1 +typeSize (Reset _) = 1 +typeSize (Enable _) = 1 +typeSize (BitVector i) = i +typeSize (Index 0) = 0 +typeSize (Index 1) = 1 +typeSize (Index u) = fromMaybe 0 (clogBase 2 u) +typeSize (Signed i) = i +typeSize (Unsigned i) = i +typeSize (Vector n el) = n * typeSize el +typeSize (RTree d el) = (2^d) * typeSize el +typeSize t@(SP _ cons) = conSize t + + maximum (map (sum . map typeSize . snd) cons) +typeSize (Sum _ dcs) = fromMaybe 0 . clogBase 2 . toInteger $ length dcs +typeSize (Product _ _ tys) = sum $ map typeSize tys +typeSize (BiDirectional In h) = typeSize h +typeSize (BiDirectional Out _) = 0 +typeSize (CustomSP _ _ size _) = fromIntegral size +typeSize (CustomSum _ _ size _) = fromIntegral size +typeSize (CustomProduct _ _ size _ _) = fromIntegral size +typeSize (Annotated _ ty) = typeSize ty + +-- | Determines the bitsize of the constructor of a type +conSize :: HWType + -> Int +conSize (SP _ cons) = fromMaybe 0 . clogBase 2 . toInteger $ length cons +conSize t = typeSize t + +-- | Gives the length of length-indexed types +typeLength :: HWType + -> Int +typeLength (Vector n _) = n +typeLength _ = 0 + +-- | Gives the HWType corresponding to a term. Returns an error if the term has +-- a Core type that is not translatable to a HWType. +termHWType :: String + -> Term + -> NetlistMonad HWType +termHWType loc e = do + m <- Lens.use tcCache + let ty = termType m e + stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty + +-- | Gives the HWType corresponding to a term. Returns 'Nothing' if the term has +-- a Core type that is not translatable to a HWType. +termHWTypeM + :: Term + -- ^ Term to convert to HWType + -> NetlistMonad (Maybe FilteredHWType) +termHWTypeM e = do + m <- Lens.use tcCache + let ty = termType m e + coreTypeToHWTypeM ty + +isBiSignalIn :: HWType -> Bool +isBiSignalIn (BiDirectional In _) = True +isBiSignalIn _ = False + +isBiSignalOut :: HWType -> Bool +isBiSignalOut (BiDirectional Out _) = True +isBiSignalOut _ = False + +containsBiSignalIn + :: HWType + -> Bool +containsBiSignalIn (BiDirectional In _) = True +containsBiSignalIn (Product _ _ tys) = any containsBiSignalIn tys +containsBiSignalIn (SP _ tyss) = any (any containsBiSignalIn . snd) tyss +containsBiSignalIn (Vector _ ty) = containsBiSignalIn ty +containsBiSignalIn (RTree _ ty) = containsBiSignalIn ty +containsBiSignalIn _ = False + +-- | Uniquely rename all the variables and their references in a normalized +-- term +mkUniqueNormalized + :: HasCallStack + => InScopeSet + -> Maybe (Maybe TopEntity) + -- ^ Top entity annotation where: + -- + -- * Nothing: term is not a top entity + -- * Just Nothing: term is a top entity, but has no explicit annotation + -- * Just (Just ..): term is a top entity, and has an explicit annotation + -> ( [Id] + , [LetBinding] + , Id + ) + -> NetlistMonad + ([Bool] + ,[(Identifier,HWType)] + ,[Declaration] + ,[(Identifier,HWType)] + ,[Declaration] + ,[LetBinding] + ,Maybe Id) +mkUniqueNormalized is0 topMM (args, binds, res) = do + -- Generate port names and add them to set of seen identifiers + argHwtys <- mapM (unsafeCoreTypeToHWTypeM $(curLoc) . varType) args + resHwty <- unsafeCoreTypeToHWTypeM $(curLoc) (varType res) + etopM <- + mapM + (expandTopEntityOrErrM (zip (map Just args) argHwtys) (Just res, resHwty)) + topMM + + -- Make arguments unique + let (bndrs, exprs) = unzip binds + let is1 = is0 `extendInScopeSetList` (args ++ bndrs) + (wereVoids, iports, iwrappers, substArgs) <- + mkUniqueArguments (mkSubst is1) etopM args + + -- Make result unique. This might yield 'Nothing' in which case the result + -- was a single BiSignalOut. This is superfluous in the HDL, as the argument + -- will already contain a bidirectional signal complementing the BiSignalOut. + resM <- mkUniqueResult substArgs etopM res + case resM of + Just (oports, owrappers, res1, subst0) -> do + + -- Collect new names, see 'renameBinder' for more information + (listToMaybe -> resRenameM0, HashMap.fromList -> renames0) <- + partition ((== res) . fst) <$> concatMapM renameBinder binds + + let + -- Is the result variable read by any of the other binders? In that case + -- we need to add a redirection as most synthesis tools don't allow reads + -- from output ports. Note that if the result is renamed anyway, we don't + -- have to do anything here. + resultRead = any (localIdOccursIn res) exprs + recResult = modifyVarName (`appendToName` "_rec") res + resRenameM1 = resRenameM0 <|> orNothing resultRead (res, recResult) + + (resN, extraBind, subst1) <- + case resRenameM1 of + Nothing -> + -- Result binder was not renamed, so we can assign result expression + -- directly to new name given by 'res1' + pure (res1, Nothing, subst0) + Just (_, newName0) -> do + -- Result binder was renamed. We cannot rename 'res1', so we need + -- to create an indirection. + ([newName1], s) <- mkUnique subst0 [newName0] + pure (newName1, Just (res1, Var newName1), s) + + let + -- Result binder is already unique, so don't rename that + renames1 = [(b, hmFindWithDefault b b renames0) | b <- bndrs] + (renamesL0, (_:renamesR0)) = break ((==res) . fst) renames1 + + (renamesL1, subst2) <- mkUnique subst1 (map snd renamesL0) + (renamesR1, subst3) <- mkUnique subst2 (map snd renamesR0) + + let + exprs1 = map (substTm "mkUniqueNormalized1" subst3) exprs + binds0 = zip (renamesL1 <> [resN] <> renamesR1) exprs1 + binds1 = binds0 <> maybeToList extraBind + + -- Return the uniquely named arguments, let-binders, and result + return (wereVoids, iports, iwrappers, oports, owrappers, binds1, Just res1) + + Nothing -> do + (bndrs1, substArgs1) <- mkUnique substArgs bndrs + let binds1 = zip bndrs1 (map (substTm "mkUniqueNormalized2" substArgs1) exprs) + return (wereVoids, iports, iwrappers, [], [], binds1, Nothing) + +-- | Produce a 'Just' when predicate is True, else Nothing +orNothing :: Bool -> a -> Maybe a +orNothing True a = Just a +orNothing False _ = Nothing + +-- | Set the name of the binder if the given term is a blackbox requesting +-- a specific name for the result binder. It might return multiple names in +-- case of a multi result primitive. +-- +renameBinder :: (Id, Term) -> NetlistMonad [(Id, Id)] +renameBinder (i, collectArgsTicks -> (k, args, ticks)) = withTicks ticks $ \_ -> do + case k of + Prim p -> + case primMultiResult p of + SingleResult -> extractPrimWarnOrFail (primName p) >>= goSingle p + MultiResult -> extractPrimWarnOrFail (primName p) >>= goMulti p + _ -> pure [] + where + -- Routine for multi result primitives. For more info: + -- 'Clash.Normalize.Transformations.setupMultiResultPrim'. + goMulti :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)] + goMulti pInfo (BlackBoxHaskell{function=(_, function)}) = do + tcm <- Lens.use tcCache + let mpInfo@MultiPrimInfo{mpi_resultTypes} = multiPrimInfo' tcm pInfo + let (args1, resIds) = splitMultiPrimArgs mpInfo args + funRes <- preserveVarEnv (function False (primName pInfo) args1 mpi_resultTypes) + let BlackBoxMeta{bbResultNames} = either error fst funRes + go (primName pInfo) resIds args1 bbResultNames + goMulti _ _ = pure [] + + -- Routine for single result primitives (the default kind of primitive) + goSingle :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)] + goSingle pInfo (BlackBoxHaskell{function=(_, function)}) = do + funRes <- preserveVarEnv (function False (primName pInfo) args [varType i]) + case either error fst funRes of + BlackBoxMeta{bbResultNames=[bbResultName]} -> + go (primName pInfo) [i] args [bbResultName] + _ -> pure [] + goSingle pInfo (BlackBox{resultNames=[resultName]}) = do + go (primName pInfo) [i] args [resultName] + goSingle _ _ = pure [] + + go :: Text -> [Id] -> [Either Term Type] -> [BlackBox] -> NetlistMonad [(Id, Id)] + go nm is0 bbArgs bbResultTemplates = do + (bbCtx, _) <- preserveVarEnv (mkBlackBoxContext nm is0 bbArgs) + be <- Lens.use backend + let + _sameName i0 i1 = nameOcc (varName i0) == nameOcc (varName i1) + newNames = map (evalBlackBox be bbCtx) bbResultTemplates + modName newRetName = modifyVarName (\n -> n {nameOcc = newRetName}) + is1 = zipWith modName newNames is0 + + -- TODO: _sameName check disabled due to + -- https://github.com/clash-lang/clash-compiler/issues/1566 + -- Don't rename if we didn't change any names, it will cause superfluous + -- redirections in 'mkUniqueNormalized'. + -- pure (if and (zipWith sameName is0 is1) then [] else zip is0 is1) + pure (zip is0 is1) + +-- | Render a blackbox given its context. Renders _just_ the blackbox, not any +-- corresponding includes, libraries, and so forth. +evalBlackBox :: HasCallStack => SomeBackend -> BlackBoxContext -> BlackBox -> Text +evalBlackBox (SomeBackend s) bbCtx bb + | BBFunction _bbName _bbHash (TemplateFunction _usedArgs _verifFunc func) <- bb = + let layout = LayoutOptions (AvailablePerLine 120 0.4) in + toStrict (renderLazy (layoutPretty layout (State.evalState (func bbCtx) s))) + | BBTemplate bbt <- bb = + toStrict ((State.evalState (renderTemplate bbCtx bbt) s) 0) + +mkUniqueArguments + :: Subst + -> Maybe (ExpandedTopEntity Identifier) + -- ^ Top entity annotation where: + -- + -- * Nothing: term is not a top entity + -- * Just ..: term is a top entity + -> [Id] + -> NetlistMonad + ( [Bool] -- Were voids + , [(Identifier,HWType)] -- Arguments and their types + , [Declaration] -- Extra declarations + , Subst -- Substitution with new vars in scope + ) +mkUniqueArguments subst0 Nothing args = do + (args', subst1) <- mkUnique subst0 args + ports <- mapM idToInPort args' + return (map isNothing ports, catMaybes ports, [], subst1) + +mkUniqueArguments subst0 (Just (ExpandedTopEntity{..})) args = do + (ports, decls, subst1) <- (unzip3 . catMaybes) <$> zipWithM go et_inputs args + return ( map isNothing et_inputs + , concat ports + , concat decls + , extendInScopeIdList (extendIdSubstList subst0 (map snd subst1)) + (map fst subst1)) + where + go Nothing _var = + pure Nothing + go (Just port) var = do + (ports, decls, _, portI) <- mkTopInput port + let portName = Id.toText portI + pId = mkLocalId (varType var) (setRepName portName (varName var)) + return (Just (ports, decls, (pId, (var, Var pId)))) + + +mkUniqueResult + :: Subst + -> Maybe (ExpandedTopEntity Identifier) + -- ^ Top entity annotation where: + -- + -- * Nothing: term is not a top entity + -- * Just ..: term is a top entity + -> Id + -> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Id,Subst)) +mkUniqueResult subst0 Nothing res = do + ([res'],subst1) <- mkUnique subst0 [res] + portM <- idToOutPort res' + case portM of + Just port -> return (Just ([port],[],res',subst1)) + _ -> return Nothing + +mkUniqueResult _subst0 (Just (ExpandedTopEntity{et_output=Nothing})) _res = + pure Nothing +mkUniqueResult subst0 (Just (ExpandedTopEntity{et_output=Just iPort})) res = do + (_, sp) <- Lens.use curCompNm + (FilteredHWType hwty _) <- unsafeCoreTypeToHWTypeM $(curLoc) (varType res) + when (containsBiSignalIn hwty) + (throw (ClashException sp ($(curLoc) ++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Nothing)) + (ports, decls, portI) <- mkTopOutput iPort + let pO = setRepName (Id.toText portI) (varName res) + pOId = mkLocalId (varType res) pO + subst1 = extendInScopeId (extendIdSubst subst0 res (Var pOId)) pOId + return (Just (ports, decls, pOId, subst1)) + +-- | Same as idToPort, but +-- * Throws an error if the port is a composite type with a BiSignalIn +idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType)) +idToInPort var = do + (_, sp) <- Lens.use curCompNm + portM <- idToPort var + case portM of + Just (_,hty) -> do + when (containsBiSignalIn hty && not (isBiSignalIn hty)) + (throw (ClashException sp ($(curLoc) ++ "BiSignalIn currently cannot be part of a composite type when it's a function's argument") Nothing)) + return portM + _ -> return Nothing + +-- | Same as idToPort, but: +-- * Throws an error if port is of type BiSignalIn +idToOutPort :: Id -> NetlistMonad (Maybe (Identifier,HWType)) +idToOutPort var = do + (_, srcspan) <- Lens.use curCompNm + portM <- idToPort var + case portM of + Just (_,hty) -> do + when (containsBiSignalIn hty) + (throw (ClashException srcspan ($(curLoc) ++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Nothing)) + return portM + _ -> return Nothing + +idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType)) +idToPort var = do + hwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (varType var) + if isVoid hwTy + then return Nothing + else return (Just (id2identifier var, hwTy)) + +id2type :: Id -> Type +id2type = varType + +id2identifier :: Id -> Identifier +id2identifier = Id.unsafeMake . nameOcc . varName + +setRepName :: Text -> Name a -> Name a +setRepName s (Name sort' _ i loc) = Name sort' s i loc + +-- | Make a set of IDs unique; also returns a substitution from old ID to new +-- updated unique ID. +mkUnique + :: Subst + -- ^ Existing substitution + -> [Id] + -- ^ IDs to make unique + -> NetlistMonad ([Id],Subst) + -- ^ (Unique IDs, update substitution) +mkUnique = go [] + where + go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id],Subst) + go processed subst [] = return (reverse processed,subst) + go processed subst@(Subst isN _ _ _) (i:is) = do + iN <- Id.toText <$> Id.fromCoreId i + let i' = uniqAway isN (modifyVarName (setRepName iN) i) + subst' = extendInScopeId (extendIdSubst subst i (Var i')) i' + go (i':processed) + subst' + is + +-- | Preserve the complete state before running an action, and restore it +-- afterwards. +preserveState + :: NetlistMonad a + -> NetlistMonad a +preserveState action = do + state <- State.get + val <- action + State.put state + pure val + +-- | Preserve the Netlist '_curCompNm','_seenIds' when executing +-- a monadic action +preserveVarEnv + :: NetlistMonad a + -> NetlistMonad a +preserveVarEnv action = do + -- store state + vComp <- Lens.use curCompNm + vSeen <- Lens.use seenIds + -- perform action + val <- action + -- restore state + curCompNm .= vComp + seenIds .= vSeen + return val + +dcToLiteral :: HWType -> Int -> Literal +dcToLiteral Bool 1 = BoolLit False +dcToLiteral Bool 2 = BoolLit True +dcToLiteral _ i = NumLit (toInteger i-1) + +-- * TopEntity Annotations + +extendPorts :: [PortName] -> [Maybe PortName] +extendPorts ps = map Just ps ++ repeat Nothing + +-- | Prefix given string before portnames /except/ when this string is empty. +prefixParent :: String -> PortName -> PortName +prefixParent "" p = p +prefixParent parent (PortName p) = PortName (parent <> "_" <> p) +prefixParent parent (PortProduct "" ps) = PortProduct parent ps +prefixParent parent (PortProduct p ps) = PortProduct (parent <> "_" <> p) ps + +mkAssign :: Identifier -> HWType -> Expr -> [Declaration] +mkAssign id_ hwty expr = [NetDecl Nothing id_ hwty, Assignment id_ expr] + +-- | See 'toPrimitiveType' / 'fromPrimitiveType' +convPrimitiveType :: HWType -> a -> NetlistMonad a -> NetlistMonad a +convPrimitiveType hwty a action = do + b <- Lens.use backend + let kind = case b of {SomeBackend s -> State.evalState (hdlHWTypeKind hwty) s} + case kind of + UserType -> action + SynonymType -> pure a + PrimitiveType -> pure a + +-- | Top entities only expose primitive types or types that don't need explicit +-- conversion to a primitive type (i.e., no types from the '_types' module). This +-- function converts from a custom type to a primitive type if needed. +-- +-- See 'HWKind' for more info on primitive type kinds. +toPrimitiveType + :: Identifier + -> HWType + -> NetlistMonad ([Declaration], Identifier, Expr, HWType) +toPrimitiveType id0 hwty0 = convPrimitiveType hwty0 dflt $ do + id1 <- Id.next id0 + pure (mkAssign id1 hwty1 expr, id1, expr, hwty1) + where + dflt = ([], id0, Identifier id0 Nothing, hwty0) + hwty1 = BitVector (typeSize hwty0) + expr = ToBv Nothing hwty0 (Identifier id0 Nothing) + +-- | Top entities only expose primitive types or types that don't need explicit +-- conversion to a primitive type (i.e., no types from the '_types' module). This +-- function converts from a primitive type to a custom type if needed. +-- +-- See 'HWKind' for more info on primitive type kinds. +fromPrimitiveType + :: Identifier + -> HWType + -> NetlistMonad ([Declaration], Identifier, Expr, HWType) +fromPrimitiveType id0 hwty0 = convPrimitiveType hwty0 dflt $ do + id1 <- Id.next id0 + pure (mkAssign id1 hwty0 expr, id1, expr, hwty1) + where + dflt = ([], id0, Identifier id0 Nothing, hwty0) + hwty1 = BitVector (typeSize hwty0) + expr = FromBv Nothing hwty0 (Identifier id0 Nothing) + +-- | Create port names for the declaration of a top entity. For /instantiation/ +-- see 'mkTopInstInput'. +mkTopInput + :: ExpandedPortName Identifier + -- ^ Port name description + -> NetlistMonad ([(Identifier, HWType)], [Declaration], Expr, Identifier) + -- ^ (port names, signal decls for intermediate signals, argument expr, argument id) +mkTopInput (ExpandedPortName hwty0 i0) = do + (decls, i1, expr, hwty1) <- fromPrimitiveType i0 hwty0 + return ([(i0, hwty1)], decls, expr, i1) + +mkTopInput epp@(ExpandedPortProduct p hwty ps) = do + pN <- Id.make p + let netdecl = NetDecl Nothing pN hwty + case hwty of + Vector sz eHwty -> do + (ports, _, exprs, _) <- unzip4 <$> mapM mkTopInput ps + let vecExpr = mkVectorChain sz eHwty exprs + netassgn = Assignment pN vecExpr + return (concat ports, [netdecl, netassgn], vecExpr, pN) + + RTree d eHwty -> do + (ports, _, exprs, _) <- unzip4 <$> mapM mkTopInput ps + let trExpr = mkRTreeChain d eHwty exprs + netassgn = Assignment pN trExpr + return (concat ports, [netdecl, netassgn], trExpr, pN) + + Product _ _ _ -> do + (ports, _, exprs, _) <- unzip4 <$> mapM mkTopInput ps + case exprs of + [expr] -> + let netassgn = Assignment pN expr in + return (concat ports, [netdecl, netassgn], expr, pN) + _ -> + let + dcExpr = DataCon hwty (DC (hwty, 0)) exprs + netassgn = Assignment pN dcExpr + in + return (concat ports, [netdecl, netassgn], dcExpr, pN) + + SP _ ((concat . map snd) -> [elTy]) -> do + (ports, _, exprs, _) <- unzip4 <$> mapM mkTopInput ps + case exprs of + [conExpr, elExpr] -> do + let dcExpr = DataCon hwty (DC (BitVector (typeSize hwty), 0)) + [conExpr, ToBv Nothing elTy elExpr] + netassgn = Assignment pN dcExpr + return (concat ports, [netdecl, netassgn], dcExpr, pN) + _ -> error $ $(curLoc) ++ "Internal error" + + _ -> + -- 'expandTopEntity' should have made sure this isn't possible + error $ $(curLoc) ++ "Internal error: " ++ show epp + +portProductError :: String -> HWType -> ExpandedPortName Identifier -> a +portProductError loc hwty portProduct = error $ loc ++ [I.i| + #{loc}PortProduct used, but did not see Vector, RTree, or Product. Saw the + following instead: + + #{hwty} + + PortProduct used: + + #{portProduct} + + Note that the PortProduct as shown above might is only indicative, and might + not correspond exactly to the one given in the Clash design. |] + +-- | Create a Vector chain for a list of 'Identifier's +mkVectorChain :: Int + -> HWType + -> [Expr] + -> Expr +mkVectorChain _ elTy [] = DataCon (Vector 0 elTy) VecAppend [] +mkVectorChain _ elTy [e] = DataCon (Vector 1 elTy) VecAppend + [e] +mkVectorChain sz elTy (e:es) = DataCon (Vector sz elTy) VecAppend + [ e + , mkVectorChain (sz-1) elTy es + ] + +-- | Create a RTree chain for a list of 'Identifier's +mkRTreeChain :: Int + -> HWType + -> [Expr] + -> Expr +mkRTreeChain _ elTy [e] = DataCon (RTree 0 elTy) RTreeAppend + [e] +mkRTreeChain d elTy es = + let (esL,esR) = splitAt (length es `div` 2) es + in DataCon (RTree d elTy) RTreeAppend + [ mkRTreeChain (d-1) elTy esL + , mkRTreeChain (d-1) elTy esR + ] + +genComponentName + :: Bool + -- ^ New inline strategy enabled + -> Maybe Text + -- ^ Component name prefix + -> Id + -- ^ Create component name based on this Core Id + -> Text +genComponentName newInlineStrat prefixM nm = + Text.intercalate "_" (prefix ++ [fn1]) + where + nm0 = Text.splitOn "." (nameOcc (varName nm)) + fn0 = Id.stripDollarPrefixes (last nm0) + fn1 = if Text.null fn0 then "Component" else fn0 + prefix = fromMaybe (if newInlineStrat then [] else init nm0) (pure <$> prefixM) + +genTopName + :: IdentifierSetMonad m + => Maybe Text + -- ^ Top entity name prefix + -> TopEntity + -- ^ Top entity annotation + -> m Identifier + -- ^ New identifier +genTopName prefixM ann = + case prefixM of + Just prefix | not (Text.null prefix) -> + Id.addRaw (Text.concat [prefix, "_", Text.pack (t_name ann)]) + _ -> + Id.addRaw (Text.pack (t_name ann)) + +-- | Strips one or more layers of attributes from a HWType; stops at first +-- non-Annotated. Accumulates all attributes of nested annotations. +stripAttributes + :: HWType + -> ([Attr'], HWType) +-- Recursively strip type, accumulate attrs: +stripAttributes (Annotated attrs typ) = + let (attrs', typ') = stripAttributes typ + in (attrs ++ attrs', typ') +-- Not an annotated type, so just return it: +stripAttributes typ = ([], typ) + +-- | Create output port names for the declaration of a top entity. For +-- /instantiation/ see 'mkTopInstOutput'. +mkTopOutput + :: ExpandedPortName Identifier + -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier) +mkTopOutput (ExpandedPortName hwty0 i0) = do + i1 <- Id.next i0 + (_, _, bvExpr, hwty1) <- toPrimitiveType i1 hwty0 + if hwty0 == hwty1 then + -- No type conversion happened, so we can just request caller to assign to + -- port name directly. + return ([(i0, hwty0)], [], i0) + else + -- Type conversion happened, so we must use intermediate variable. + return ([(i0, hwty1)], [Assignment i0 bvExpr, NetDecl Nothing i1 hwty0], i1) + +mkTopOutput epp@(ExpandedPortProduct p hwty ps) = do + pN <- Id.make p + let netdecl = NetDecl Nothing pN hwty + case hwty of + Vector {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopOutput ps + let assigns = zipWith (assignId pN hwty 10) ids [0..] + return (concat ports, netdecl:assigns ++ concat decls, pN) + + RTree {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopOutput ps + let assigns = zipWith (assignId pN hwty 10) ids [0..] + return (concat ports, netdecl:assigns ++ concat decls, pN) + + Product {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopOutput ps + case ids of + [i] -> let assign = Assignment i (Identifier pN Nothing) + in return (concat ports, netdecl:assign:concat decls, pN) + + _ -> let assigns = zipWith (assignId pN hwty 0) ids [0..] + in return (concat ports, netdecl:assigns ++ concat decls, pN) + + SP _ ((concat . map snd) -> [elTy]) -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopOutput ps + case ids of + [conId, elId] -> + let conIx = Sliced ( BitVector (typeSize hwty) + , typeSize hwty - 1 + , typeSize elTy ) + elIx = Sliced ( BitVector (typeSize hwty) + , typeSize elTy - 1 + , 0 ) + assigns = [ Assignment conId (Identifier pN (Just conIx)) + , Assignment elId (FromBv Nothing elTy + (Identifier pN (Just elIx))) + ] + in return (concat ports, netdecl:assigns ++ concat decls, pN) + _ -> error $ $(curLoc) ++ "Internal error" + -- 'expandTopEntity' should have made sure this isn't possible + _ -> error $ $(curLoc) ++ "Internal error: " ++ show epp + + where + assignId p_ hwty_ con i n = + Assignment i (Identifier p_ (Just (Indexed (hwty_, con, n)))) + +mkTopCompDecl + :: Maybe Text + -- ^ Library entity is defined in + -> [Attr'] + -- ^ Attributes to add to generate code + -> Identifier + -- ^ The component's (or entity's) name + -> Identifier + -- ^ Instance label + -> [(Expr, HWType, Expr)] + -- ^ List of parameters for this component (param name, param type, param value) + -> [InstancePort] + -- ^ Input port assignments + -> [InstancePort] + -- ^ Output port assignments + -> Declaration +mkTopCompDecl lib attrs name instName params inputs outputs = + InstDecl Entity lib attrs name instName params (IndexedPortMap ports) + where + ports = map (toPort In) inputs ++ map (toPort Out) outputs + toExpr id_ = Identifier id_ Nothing + toPort dir ip = (dir, (ip_type ip), toExpr (ip_id ip)) + +-- | Instantiate a TopEntity, and add the proper type-conversions where needed +mkTopUnWrapper + :: Id + -- ^ Name of the TopEntity component + -> ExpandedTopEntity Identifier + -- ^ A corresponding @TopEntity@ annotation + -> (Identifier, HWType) + -- ^ The name and type of the signal to which to assign the result + -> [(Expr,HWType)] + -- ^ The arguments with voids filtered. + -> [Declaration] + -- ^ Tick declarations + -> NetlistMonad [Declaration] +mkTopUnWrapper topEntity annM dstId args tickDecls = do + -- component name + compNameM <- lookupVarEnv topEntity <$> Lens.use componentNames + let + topName = Id.toText topIdentifier + topIdentifier = flip fromMaybe compNameM (error [I.i| + Internal error in 'mkTopUnWrapper': tried to lookup (netlist) name + of #{showPpr (varName topEntity)}, but couldn't find it in NetlistState's + 'componentNames'. This should have been put there by 'runNetlistMonad' / + 'genNames'. |]) + + -- inputs + (iports, wrappers, idsI) <- unzip3 <$> mapM mkTopInstInput (catMaybes (et_inputs annM)) + let inpAssigns = zipWith Assignment idsI (map fst args) + + -- output + let + iResult = inpAssigns ++ concat wrappers + instLabel0 = Text.concat [topName, "_", Id.toText (fst dstId)] + + instLabel1 <- fromMaybe instLabel0 <$> Lens.view setName + instLabel2 <- affixName instLabel1 + instLabel3 <- Id.makeBasic instLabel2 + topOutputM <- traverse mkTopInstOutput (et_output annM) + + let topDecl = mkTopCompDecl (Just topName) [] topIdentifier instLabel3 [] (concat iports) + + case topOutputM of + Nothing -> + pure (topDecl [] : iResult) + Just (oports, unwrappers, id0) -> do + let outpAssign = Assignment (fst dstId) (Identifier id0 Nothing) + pure (iResult ++ tickDecls ++ (topDecl oports:unwrappers) ++ [outpAssign]) + +data InstancePort = InstancePort + { ip_id :: Identifier + -- ^ Identifier to assign. Top entities are instantiated using positional + -- arguments, so this doesn't hold a port name. + , ip_type :: HWType + -- ^ Type assigned to port + } + +-- | Generate input port(s) associated with a single argument for an +-- instantiation of a top entity. This function composes the input ports into +-- a single signal and returns its name. +mkTopInstInput + :: ExpandedPortName Identifier + -- ^ The @PortName@ of a _TopEntity_ annotation for this input. + -> NetlistMonad ([InstancePort], [Declaration], Identifier) + -- ^ (ports to assign, declarations for intermediate signals, argument signal) +mkTopInstInput (ExpandedPortName hwty0 pN) = do + pN' <- Id.next pN + (decls, pN'', _bvExpr, hwty1) <- toPrimitiveType pN' hwty0 + return ( [InstancePort pN'' hwty1] + , NetDecl Nothing pN' hwty0 : decls + , pN' ) + +mkTopInstInput epp@(ExpandedPortProduct pNameHint hwty0 ps) = do + pName <- Id.make pNameHint + + let + pDecl = NetDecl Nothing pName hwty0 + (attrs, hwty1) = stripAttributes hwty0 + indexPN constr n = Identifier pName (Just (Indexed (hwty0, constr, n))) + + case hwty1 of + Vector {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps + let assigns = zipWith Assignment ids (map (indexPN 10) [0..]) + if null attrs then + return (concat ports, pDecl:assigns ++ concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "Vector" + + RTree {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps + let assigns = zipWith Assignment ids (map (indexPN 10) [0..]) + if null attrs then + return (concat ports, pDecl:assigns ++ concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "RTree" + + Product {} -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps + let assigns = zipWith Assignment ids (map (indexPN 0) [0..]) + if null attrs then + return (concat ports, pDecl:assigns ++ concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "Product" + + SP _ ((concat . map snd) -> [elTy]) -> do + (ports, decls, ids) <- unzip3 <$> mapM mkTopInstInput ps + case ids of + [conId,elId] -> do + let + conIx = Sliced + ( BitVector (typeSize hwty1) + , typeSize hwty1 - 1 + , typeSize elTy ) + + elIx = Sliced + ( BitVector (typeSize hwty1) + , typeSize elTy - 1 + , 0 ) + + assigns = + [ Assignment conId (Identifier pName (Just conIx)) + , Assignment elId (FromBv Nothing elTy (Identifier pName (Just elIx))) ] + + return (concat ports, pDecl:assigns ++ concat decls, pName) + _ -> error "Internal error: Unexpected error for PortProduct" + _ -> + portProductError $(curLoc) hwty0 epp + + +-- | Consider the following type signature: +-- +-- @ +-- f :: Signal dom (Vec 6 A) \`Annotate\` Attr "keep" +-- -> Signal dom (Vec 6 B) +-- @ +-- +-- What does the annotation mean, considering that Clash will split these +-- vectors into multiple in- and output ports? Should we apply the annotation +-- to all individual ports? How would we handle pin mappings? For now, we simply +-- throw an error. This is a helper function to do so. +throwAnnotatedSplitError + :: String + -> String + -> NetlistMonad a +throwAnnotatedSplitError loc typ = do + (_,sp) <- Lens.use curCompNm + throw $ ClashException sp (loc ++ printf msg typ typ) Nothing + where + msg = unwords $ [ "Attempted to split %s into a number of HDL ports. This" + , "is not allowed in combination with attribute annotations." + , "You can annotate %s's components by splitting it up" + , "manually." ] + +-- | Generate output port(s) for an instantiation of a top entity. This function +-- combines all output ports into a signal identifier and returns its name. +mkTopInstOutput + :: HasCallStack + => ExpandedPortName Identifier + -- ^ The @PortName@ of a _TopEntity_ annotation for this output + -> NetlistMonad ([InstancePort], [Declaration], Identifier) + -- ^ (ports to assign, declarations for intermediate signals, result signal) +mkTopInstOutput (ExpandedPortName hwty0 portName) = do + assignName0 <- Id.next portName + (decls, assignName1, _expr, hwty1) <- fromPrimitiveType assignName0 hwty0 + return ( [InstancePort assignName0 hwty1] + , NetDecl Nothing assignName0 hwty1 : decls + , assignName1 ) + +mkTopInstOutput epp@(ExpandedPortProduct productNameHint hwty ps) = do + pName <- Id.make productNameHint + let pDecl = NetDecl Nothing pName hwty + (attrs, hwty') = stripAttributes hwty + case hwty' of + Vector sz hwty'' -> do + (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps + let ids1 = map (flip Identifier Nothing) ids0 + netassgn = Assignment pName (mkVectorChain sz hwty'' ids1) + if null attrs then + return (concat ports, pDecl:netassgn:concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "Vector" + + RTree d hwty'' -> do + (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps + let ids1 = map (flip Identifier Nothing) ids0 + netassgn = Assignment pName (mkRTreeChain d hwty'' ids1) + if null attrs then + return (concat ports, pDecl:netassgn:concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "RTree" + + Product {} -> do + (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps + let ids1 = map (flip Identifier Nothing) ids0 + netassgn = Assignment pName (DataCon hwty (DC (hwty,0)) ids1) + if null attrs then + return (concat ports, pDecl:netassgn:concat decls, pName) + else + throwAnnotatedSplitError $(curLoc) "Product" + + SP _ ((concat . map snd) -> [elTy]) -> do + (ports, decls, ids0) <- unzip3 <$> mapM mkTopInstOutput ps + let ids1 = map (flip Identifier Nothing) ids0 + ids2 = case ids1 of + [conId, elId] -> [conId, ToBv Nothing elTy elId] + _ -> error "Unexpected error for PortProduct" + netassgn = Assignment pName (DataCon hwty (DC (BitVector (typeSize hwty),0)) ids2) + return (concat ports, pDecl:netassgn:concat decls, pName) + + _ -> + portProductError $(curLoc) hwty' epp + +-- | Try to merge nested modifiers into a single modifier, needed by the VHDL +-- and SystemVerilog backend. +nestM :: Modifier -> Modifier -> Maybe Modifier +nestM (Nested a b) m2 + | Just m1 <- nestM a b = maybe (Just (Nested m1 m2)) Just (nestM m1 m2) + | Just m2' <- nestM b m2 = maybe (Just (Nested a m2')) Just (nestM a m2') + +nestM (Indexed (Vector n t1,1,1)) (Indexed (Vector _ t2,1,0)) + | t1 == t2 = Just (Indexed (Vector n t1,10,1)) + +nestM (Indexed (Vector n t1,1,1)) (Indexed (Vector _ t2,10,k)) + | t1 == t2 = Just (Indexed (Vector n t1,10,k+1)) + +nestM (Indexed (RTree d1 t1,1,n)) (Indexed (RTree d2 t2,0,0)) + | t1 == t2 + , d1 >= 0 + , d2 >= 0 + = Just (Indexed (RTree d1 t1,10,n)) + +nestM (Indexed (RTree d1 t1,1,n)) (Indexed (RTree d2 t2,1,m)) + | t1 == t2 + , d1 >= 0 + , d2 >= 0 + = if | n == 1 && m == 1 -> let r = 2 ^ d1 + l = r - (2 ^ (d1-1) `div` 2) + in Just (Indexed (RTree (-1) t1, l, r)) + | n == 1 && m == 0 -> let l = 2 ^ (d1-1) + r = l + (l `div` 2) + in Just (Indexed (RTree (-1) t1, l, r)) + | n == 0 && m == 1 -> let l = (2 ^ (d1-1)) `div` 2 + r = 2 ^ (d1-1) + in Just (Indexed (RTree (-1) t1, l, r)) + | n == 0 && m == 0 -> let l = 0 + r = (2 ^ (d1-1)) `div` 2 + in Just (Indexed (RTree (-1) t1, l, r)) + | n > 1 || n < 0 -> error $ "nestM: n should be 0 or 1, not:" ++ show n + | m > 1 || m < 0 -> error $ "nestM: m should be 0 or 1, not:" ++ show m + | otherwise -> error $ "nestM: unexpected (n, m): " ++ show (n, m) +nestM (Indexed (RTree (-1) t1,l,_)) (Indexed (RTree d t2,10,k)) + | t1 == t2 + , d >= 0 + = Just (Indexed (RTree d t1,10,l+k)) + +nestM _ _ = Nothing + + +-- | Determines if any type variables (exts) are bound in any of the given +-- type or term variables (tms). It's currently only used to detect bound +-- existentials, hence the name. +bindsExistentials + :: [TyVar] + -> [Var a] + -> Bool +bindsExistentials exts tms = any (`elem` freeVars) exts + where + freeVars = concatMap (Lens.toListOf typeFreeVars) (map varType tms) + +iteAlts :: HWType -> [Alt] -> Maybe (Term,Term) +iteAlts sHTy [(pat0,alt0),(pat1,alt1)] | validIteSTy sHTy = case pat0 of + DataPat dc _ _ -> case dcTag dc of + 2 -> Just (alt0,alt1) + _ -> Just (alt1,alt0) + LitPat (C.IntegerLiteral l) -> case l of + 1 -> Just (alt0,alt1) + _ -> Just (alt1,alt0) + DefaultPat -> case pat1 of + DataPat dc _ _ -> case dcTag dc of + 2 -> Just (alt1,alt0) + _ -> Just (alt0,alt1) + LitPat (C.IntegerLiteral l) -> case l of + 1 -> Just (alt1,alt0) + _ -> Just (alt0,alt1) + _ -> Nothing + _ -> Nothing + where + validIteSTy Bool = True + validIteSTy Bit = True + validIteSTy (Sum _ [_,_]) = True + validIteSTy (SP _ [_,_]) = True + validIteSTy (Unsigned 1) = True + validIteSTy (Index 2) = True + validIteSTy _ = False + +iteAlts _ _ = Nothing + +-- | Run a NetlistMonad computation in the context of the given source ticks and +-- name modifier ticks +withTicks + :: [TickInfo] + -> ([Declaration] -> NetlistMonad a) + -- ^ The source ticks are turned into 'TickDecl's and are passed as an argument + -- to the NetlistMonad computation. Name modifier ticks will change the local + -- environment for the NetlistMonad computation. + -> NetlistMonad a +withTicks ticks0 k = do + let ticks1 = List.nub ticks0 + go [] (reverse ticks1) + where + go decls [] = k (reverse decls) + + go decls (DeDup:ticks) = go decls ticks + + go decls (NoDeDup:ticks) = go decls ticks + + go decls (SrcSpan sp:ticks) = + go (TickDecl (Text.pack (showSDocUnsafe (ppr sp))):decls) ticks + + go decls (NameMod m nm0:ticks) = do + tcm <- Lens.use tcCache + case runExcept (tyLitShow tcm nm0) of + Right nm1 -> local (modName m nm1) (go decls ticks) + _ -> go decls ticks + + modName PrefixName (Text.pack -> s2) env@(NetlistEnv {_prefixName = s1}) + | Text.null s1 = env {_prefixName = s2} + | otherwise = env {_prefixName = s1 <> "_" <> s2} + modName SuffixName (Text.pack -> s2) env@(NetlistEnv {_suffixName = s1}) + | Text.null s1 = env {_suffixName = s2} + | otherwise = env {_suffixName = s2 <> "_" <> s1} + modName SuffixNameP (Text.pack -> s2) env@(NetlistEnv {_suffixName = s1}) + | Text.null s1 = env {_suffixName = s2} + | otherwise = env {_suffixName = s1 <> "_" <> s2} + modName SetName (Text.pack -> s) env = env {_setName = Just s} + +-- | Add the pre- and suffix names in the current environment to the given +-- identifier +affixName + :: Text + -> NetlistMonad Text +affixName nm0 = do + NetlistEnv pre suf _ <- ask + let nm1 = if Text.null pre then nm0 else pre <> "_" <> nm0 + nm2 = if Text.null suf then nm1 else nm1 <> "_" <> suf + return nm2 + +-- | Errors 'expandTopEntity' might yield +data ExpandError + -- | Synthesis attributes are not supported on PortProducts + = AttrError [Attr'] + -- | Something was annotated as being a PortProduct, but wasn't one + | PortProductError PortName HWType + +-- | Same as 'expandTopEntity', but also adds identifiers to the identifier +-- set of the monad. +expandTopEntityOrErrM + :: (HasCallStack, IdentifierSetMonad m) + => [(Maybe Id, FilteredHWType)] + -- ^ Arguments. Ids are used as name hints. + -> (Maybe Id, FilteredHWType) + -- ^ Result. Id is used as name hint. + -> Maybe TopEntity + -- ^ If /Nothing/, an expanded top entity will be generated as if /defSyn/ + -- was passed. + -> m (ExpandedTopEntity Identifier) + -- ^ Either some error (see "ExpandError") or and expanded top entity. All + -- identifiers in the expanded top entity will be added to NetlistState's + -- IdentifierSet. +expandTopEntityOrErrM ihwtys ohwty topM = do + is <- identifierSetM id + let ett = expandTopEntityOrErr is ihwtys ohwty topM + Id.addMultiple (toList ett) + pure ett + +-- | Take a top entity and /expand/ its port names. I.e., make sure that every +-- port that should be generated in the HDL is part of the data structure. +expandTopEntityOrErr + :: HasCallStack + => IdentifierSet + -- ^ Settings of this IdentifierSet will be used to generate valid + -- identifiers. Note that the generated identifiers are /not/ guaranteed to be + -- unique w.r.t. this set. + -> [(Maybe Id, FilteredHWType)] + -- ^ Arguments. Ids are used as name hints. + -> (Maybe Id, FilteredHWType) + -- ^ Result. Id is used as name hint. + -> Maybe TopEntity + -- ^ If /Nothing/, an expanded top entity will be generated as if /defSyn/ + -- was passed. + -> ExpandedTopEntity Identifier + -- ^ Either some error (see "ExpandError") or and expanded top entity. All + -- identifiers in the expanded top entity will be added to NetlistState's + -- IdentifierSet. +expandTopEntityOrErr is ihwtys ohwty topM = do + case expandTopEntity ihwtys ohwty topM of + Left (AttrError attrs) -> + (error [I.i| + Cannot use attribute annotations on product types of top entities. Saw + annotation: + + #{attrs} + |]) + Left (PortProductError pn hwty) -> + (error [I.i| + Saw a PortProduct in a Synthesize annotation: + + #{pn} + + but the port type: + + #{hwty} + + is not a product! + |]) + Right eTop -> + evalState (traverse (either Id.addRaw Id.make) eTop) (Id.clearSet is) + +-- | Take a top entity and /expand/ its port names. I.e., make sure that every +-- port that should be generated in the HDL is part of the data structure. It +-- works on "FilteredHWType" in order to generate stable port names. +expandTopEntity + :: HasCallStack + => [(Maybe Id, FilteredHWType)] + -- ^ Arguments. Ids are used as name hints. + -> (Maybe Id, FilteredHWType) + -- ^ Result. Id is used as name hint. + -> Maybe TopEntity + -- ^ Top entity to expand + -> Either ExpandError (ExpandedTopEntity (Either Text Text)) + -- ^ Either some error (see "ExpandError") or and expanded top entity. The + -- expanded top entity in turn contains an Either too. /Left/ means that + -- the name was supplied by the user and should be inserted at verbatim, + -- /Right/ is a name generated by Clash. +expandTopEntity ihwtys (oId, ohwty) topEntityM = do + -- TODO 1: Check sizes against number of PortProduct fields + -- TODO 2: Warn about duplicate fields + let + Synthesize{..} = fromMaybe (defSyn (error $(curLoc))) topEntityM + argHints = map (maybe "arg" (Id.toText . id2identifier) . fst) ihwtys + resHint = maybe "result" (Id.toText . id2identifier) oId + + inputs <- zipWith3M goInput argHints (map snd ihwtys) (extendPorts t_inputs) + + output <- + -- BiSignalOut signals are filtered as their counterpart - BiSignalIn - will + -- be printed as an inout port in HDL. + if isVoid (stripFiltered ohwty) || isBiSignalOut (stripFiltered ohwty) then + pure Nothing + else + Just <$> goPort resHint ohwty t_output + + pure (ExpandedTopEntity { + et_inputs = inputs + , et_output = output + }) + where + goInput + :: Text + -> FilteredHWType + -> Maybe PortName + -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text))) + goInput hint fHwty@(FilteredHWType hwty _) pM + | isVoid hwty = Right Nothing + | otherwise = Just <$> go hint fHwty pM + + -- Vector and RTree are hardcoded as product types, even when instantiated as + -- /Vec 1 a/ or /RTree 0 a/ respectively. + isProduct :: FilteredHWType -> Bool + isProduct (FilteredHWType (CustomProduct {}) _) = + -- CustomProducts are not yet support in mkTopInput/mkTopOutput so we can't treat + -- them as product types. + -- FIXME: Support CustomProduct in top entity annotations + False + isProduct (FilteredHWType (Vector {}) _) = True + isProduct (FilteredHWType (RTree {}) _) = True + isProduct (FilteredHWType _ [(_:_:_)]) = True + isProduct _ = False + + go + :: Text + -> FilteredHWType + -> Maybe PortName + -> Either ExpandError (ExpandedPortName (Either Text Text)) + go hint hwty Nothing = goNoPort hint hwty + go hint hwty (Just p) = goPort hint hwty p + + goPort + :: Text + -> FilteredHWType + -> PortName + -> Either ExpandError (ExpandedPortName (Either Text Text)) + goPort hint fHwty@(FilteredHWType hwty _) (PortName "") = + -- TODO: The following logic makes using /no/ top entity annotation and + -- TODO: using 'defSyn' behave differently. This is probably not what we + -- TODO: want. + if isJust topEntityM then + -- If top entity annotation was explicitly given, render a single port + pure (ExpandedPortName hwty (Right hint)) + else + -- Treat empty 'PortName's as an non-annotated port if no explicit + -- synthesize annotation was given. + goNoPort hint fHwty + goPort _hint (FilteredHWType hwty _) (PortName pn) = + pure (ExpandedPortName hwty (Left (Text.pack pn))) + goPort hint0 fHwty@(FilteredHWType hwty0 fields0) pp@(PortProduct p ps0) + -- Attrs not allowed on product types + | isProduct fHwty + , (_:_) <- attrs + = Left (AttrError attrs) + + -- Product types (products, vec, rtree) of which all but one field are + -- zero-width. + | isProduct fHwty + , [fields1] <- fields0 + , ((_:_), [_]) <- partition fst fields1 + = case [go h t p_ | (h, (False, t), p_) <- zip3 hints fields1 ps1] of + port:_ -> port + _ -> error "internal error: insuffient ports" + + -- Product types (products, vec, rtree) + | isProduct fHwty + , [fields1] <- fields0 + = ExpandedPortProduct hint1 hwty1 <$> + sequence [go h t p_ | (h, (False, t), p_) <- zip3 hints fields1 ps1] + + -- Things like "Maybe a" are allowed to be split up using a port + -- annotation (but won't be split up if it's missing, should it?) + -- FIXME: We probably shouldn't filter void constructs here, it's + -- FIXME: inconsistent with how we deal with port annotations elsewhere + | [(False, eHwty)] <- filter (not . fst) (concat fields0) + , length fields0 > 1 + , length ps0 == 2 + , conHwty <- FilteredHWType (BitVector (conSize hwty0)) [] + = ExpandedPortProduct hint1 hwty1 <$> + sequence [go h t p_ | (h, t, p_) <- zip3 hints [conHwty, eHwty] ps1] + + -- Port annotated as PortProduct, but wasn't one + | otherwise + = Left (PortProductError pp hwty1) + + where + hint1 = if null p then hint0 else Text.pack p + ps1 = extendPorts (map (prefixParent p) ps0) + hints = map (\i -> hint1 <> "_" <> showt i) [(0::Int)..] + (attrs, hwty1) = stripAttributes hwty0 + + goNoPort + :: Text + -> FilteredHWType + -> Either ExpandError (ExpandedPortName (Either Text Text)) + goNoPort hint fHwty@(FilteredHWType hwty0 fields0) + -- Attrs not allowed on product types + | isProduct fHwty + , (_:_) <- attrs + = Left (AttrError attrs) + + -- Product types (products, vec, rtree) of which all but one field are + -- zero-width. + | isProduct fHwty + , [fields1] <- fields0 + , ((_:_), [_]) <- partition fst fields1 + = case [goNoPort h t | (h, (False, t)) <- zip hints fields1] of + port:_ -> port + _ -> error "internal error: insuffient ports" + + -- Product types (products, vec, rtree) + | isProduct fHwty + , [fields1] <- fields0 + = ExpandedPortProduct hint hwty1 <$> + sequence [goNoPort h t | (h, (False, t)) <- zip hints fields1] + + -- All other types (sum of product, sum, "native") + | otherwise + = pure (ExpandedPortName hwty0 (Right hint)) + where + (attrs, hwty1) = stripAttributes hwty0 + hints = map (\i -> hint <> "_" <> showt i) [(0::Int)..] diff --git a/src/Clash/Normalize.hs b/src/Clash/Normalize.hs --- a/src/Clash/Normalize.hs +++ b/src/Clash/Normalize.hs @@ -32,11 +32,21 @@ import qualified Data.Set.Lens as Lens import Data.Text.Prettyprint.Doc (vcat) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Basic (InlineSpec (..)) +#else import BasicTypes (InlineSpec (..)) +#endif import Clash.Annotations.BitRepresentation.Internal (CustomReprs) -import Clash.Core.Evaluator.Types (PrimStep, PrimUnwind) + +#if EXPERIMENTAL_EVALUATOR +import Clash.Core.PartialEval (Evaluator) +#else +import Clash.Core.Evaluator.Types (Evaluator) +#endif + import Clash.Core.FreeVars (freeLocalIds, globalIds, globalIdOccursIn, localIdDoesNotOccurIn) import Clash.Core.Pretty (PrettyOptions(..), showPpr, showPpr', ppr) @@ -62,28 +72,24 @@ (splitNormalized) import Clash.Normalize.Strategy import Clash.Normalize.Transformations - (appPropFast, bindConstantVar, caseCon, flattenLet, reduceConst, topLet, - reduceNonRepPrim, removeUnusedExpr, deadCode) import Clash.Normalize.Types import Clash.Normalize.Util import Clash.Primitives.Types (CompiledPrimMap) import Clash.Rewrite.Combinators ((>->),(!->),repeatR,topdownR) import Clash.Rewrite.Types - (RewriteEnv (..), RewriteState (..), bindings, dbgLevel, extra, + (RewriteEnv (..), RewriteState (..), bindings, dbgLevel, dbgRewriteHistoryFile, extra, tcCache, topEntities) import Clash.Rewrite.Util (apply, isUntranslatableType, runRewriteSession) import Clash.Util import Clash.Util.Interpolate (i) -#ifdef HISTORY import Data.Binary (encode) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import System.IO.Unsafe (unsafePerformIO) import Clash.Rewrite.Types (RewriteStep(..)) -#endif -- | Run a NormalizeSession in a given environment @@ -102,8 +108,8 @@ -- ^ TyCon cache -> IntMap TyConName -- ^ Tuple TyCon cache - -> (PrimStep, PrimUnwind) - -- ^ Hardcoded evaluator (delta-reduction) + -> Evaluator + -- ^ Hardcoded evaluator for partial evaluation -> CompiledPrimMap -- ^ Primitive Definitions -> VarEnv Bool @@ -121,6 +127,7 @@ (opt_dbgTransformations opts) (opt_dbgTransformationsFrom opts) (opt_dbgTransformationsLimit opts) + (opt_dbgRewriteHistoryFile opts) (opt_aggressiveXOpt opts) typeTrans tcm @@ -128,6 +135,7 @@ eval (mkVarSet topEnts) reprs + (opt_evaluatorFuelLimit opts) rwState = RewriteState 0 @@ -135,7 +143,12 @@ supply (error $ $(curLoc) ++ "Report as bug: no curFun",noSrcSpan) 0 +#if EXPERIMENTAL_EVALUATOR + IntMap.empty + 0 +#else (IntMap.empty, 0) +#endif emptyVarEnv normState @@ -165,12 +178,12 @@ newNormalized <- normalize (concat new) return (unionVarEnv (mkVarEnv topNormalized) newNormalized) -normalize' :: Id -> NormalizeSession ([Id], (Id, Binding)) +normalize' :: Id -> NormalizeSession ([Id], (Id, Binding Term)) normalize' nm = do exprM <- lookupVarEnv nm <$> Lens.use bindings let nmS = showPpr (varName nm) case exprM of - Just (Binding nm' sp inl tm) -> do + Just (Binding nm' sp inl pr tm) -> do tcm <- Lens.view tcCache topEnts <- Lens.view topEntities let isTop = nm `elemVarSet` topEnts @@ -197,7 +210,7 @@ resTyRep <- not <$> isUntranslatableType False resTy if resTyRep then do - tmNorm <- normalizeTopLvlBndr isTopEnt nm (Binding nm' sp inl tm) + tmNorm <- normalizeTopLvlBndr isTopEnt nm (Binding nm' sp inl pr tm) let usedBndrs = Lens.toListOf globalIds (bindingTerm tmNorm) traceIf (nm `elem` usedBndrs) (concat [ $(curLoc),"Expr belonging to bndr: ",nmS ," (:: " @@ -230,7 +243,7 @@ , showPpr (varType nm') , ") has a non-representable return type." , " Not normalising:\n", showPpr tm] ) - (return ([],(nm,(Binding nm' sp inl tm)))) + (return ([],(nm,(Binding nm' sp inl pr tm)))) Nothing -> error $ $(curLoc) ++ "Expr belonging to bndr: " ++ nmS ++ " not found" @@ -248,7 +261,7 @@ | (a,b) <- eltsVarEnv rcs ]) where - go (Binding nm _ _ tm) = + go (Binding nm _ _ _ tm) = if nm `globalIdOccursIn` tm then Just (nm,tm) else Nothing @@ -272,8 +285,8 @@ -- additional bindings which are used. See "Clash.Driver.Types.Binding". -- data CallTree - = CLeaf (Id, Binding) - | CBranch (Id, Binding) [CallTree] + = CLeaf (Id, Binding Term) + | CBranch (Id, Binding Term) [CallTree] mkCallTree :: [Id] @@ -314,8 +327,8 @@ flattenNode :: CallTree -> NormalizeSession (Either CallTree ((Id,Term),[CallTree])) -flattenNode c@(CLeaf (_,(Binding _ _ NoInline _))) = return (Left c) -flattenNode c@(CLeaf (nm,(Binding _ _ _ e))) = do +flattenNode c@(CLeaf (_,(Binding _ _ NoInline _ _))) = return (Left c) +flattenNode c@(CLeaf (nm,(Binding _ _ _ _ e))) = do isTopEntity <- elemVarSet nm <$> Lens.view topEntities if isTopEntity then return (Left c) else do tcm <- Lens.view tcCache @@ -328,9 +341,9 @@ return (Right ((nm,mkApps (mkTicks fun ticks) (reverse remainder)),[])) _ -> return (Right ((nm,e),[])) _ -> return (Right ((nm,e),[])) -flattenNode b@(CBranch (_,(Binding _ _ NoInline _)) _) = +flattenNode b@(CBranch (_,(Binding _ _ NoInline _ _)) _) = return (Left b) -flattenNode b@(CBranch (nm,(Binding _ _ _ e)) us) = do +flattenNode b@(CBranch (nm,(Binding _ _ _ _ e)) us) = do isTopEntity <- elemVarSet nm <$> Lens.view topEntities if isTopEntity then return (Left b) else do tcm <- Lens.view tcCache @@ -352,7 +365,7 @@ :: CallTree -> NormalizeSession CallTree flattenCallTree c@(CLeaf _) = return c -flattenCallTree (CBranch (nm,(Binding nm' sp inl tm)) used) = do +flattenCallTree (CBranch (nm,(Binding nm' sp inl pr tm)) used) = do flattenedUsed <- mapM flattenCallTree used (newUsed,il_ct) <- partitionEithers <$> mapM flattenNode flattenedUsed let (toInline,il_used) = unzip il_ct @@ -361,10 +374,12 @@ [] -> return tm _ -> do let tm1 = substTm "flattenCallTree.flattenExpr" subst tm -#ifdef HISTORY - -- NB: When HISTORY is on, emit binary data holding the recorded rewrite steps - let !_ = unsafePerformIO - $ BS.appendFile "history.dat" + + -- NB: When -fclash-debug-history is on, emit binary data holding the recorded rewrite steps + rewriteHistFile <- Lens.view dbgRewriteHistoryFile + when (Maybe.isJust rewriteHistFile) $ + let !_ = unsafePerformIO + $ BS.appendFile (Maybe.fromJust rewriteHistFile) $ BL.toStrict $ encode RewriteStep { t_ctx = [] @@ -373,7 +388,7 @@ , t_before = tm , t_after = tm1 } -#endif + in pure () rewriteExpr ("flattenExpr",flatten) (showPpr nm, tm1) (nm', sp) let allUsed = newUsed ++ concat il_used -- inline all components when the resulting expression after flattening @@ -386,27 +401,31 @@ (Maybe.catMaybes toInline') let tm1 = substTm "flattenCallTree.flattenCheap" subst' newExpr newExpr' <- rewriteExpr ("flattenCheap",flatten) (showPpr nm, tm1) (nm', sp) - return (CBranch (nm,(Binding nm' sp inl newExpr')) (concat allUsed')) - else return (CBranch (nm,(Binding nm' sp inl newExpr)) allUsed) + return (CBranch (nm,(Binding nm' sp inl pr newExpr')) (concat allUsed')) + else return (CBranch (nm,(Binding nm' sp inl pr newExpr)) allUsed) where flatten = repeatR (topdownR (apply "appPropFast" appPropFast >-> apply "bindConstantVar" bindConstantVar >-> apply "caseCon" caseCon >-> +#if EXPERIMENTAL_EVALUATOR + apply "deadcode" deadCode >-> +#else (apply "reduceConst" reduceConst !-> apply "deadcode" deadCode) >-> +#endif apply "reduceNonRepPrim" reduceNonRepPrim >-> apply "removeUnusedExpr" removeUnusedExpr >-> apply "flattenLet" flattenLet)) !-> topdownSucR (apply "topLet" topLet) - goCheap c@(CLeaf (nm2,(Binding _ _ inl2 e))) + goCheap c@(CLeaf (nm2,(Binding _ _ inl2 _ e))) | inl2 == NoInline = (Nothing ,[c]) | otherwise = (Just (nm2,e),[]) - goCheap c@(CBranch (nm2,(Binding _ _ inl2 e)) us) + goCheap c@(CBranch (nm2,(Binding _ _ inl2 _ e)) us) | inl2 == NoInline = (Nothing, [c]) | otherwise = (Just (nm2,e),us) -callTreeToList :: [Id] -> CallTree -> ([Id], [(Id, Binding)]) +callTreeToList :: [Id] -> CallTree -> ([Id], [(Id, Binding Term)]) callTreeToList visited (CLeaf (nm,bndr)) | nm `elem` visited = (visited,[]) | otherwise = (nm:visited,[(nm,bndr)]) diff --git a/src/Clash/Normalize/DEC.hs b/src/Clash/Normalize/DEC.hs --- a/src/Clash/Normalize/DEC.hs +++ b/src/Clash/Normalize/DEC.hs @@ -26,6 +26,7 @@ > C -> h x -} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TemplateHaskell #-} @@ -54,9 +55,19 @@ import qualified Data.Maybe as Maybe import Data.Monoid (All (..)) +#if EXPERIMENTAL_EVALUATOR +import System.IO.Unsafe +#endif + -- internal import Clash.Core.DataCon (DataCon, dcTag) -import Clash.Core.Evaluator (whnf') + +#if EXPERIMENTAL_EVALUATOR +import Clash.Core.PartialEval +#else +import Clash.Core.Evaluator.Types (whnf') +#endif + import Clash.Core.FreeVars (termFreeVars', typeFreeVars', localVarsDoNotOccurIn) import Clash.Core.Literal (Literal (..)) @@ -72,9 +83,9 @@ (InScopeSet, elemInScopeSet, extendInScopeSetList, notElemInScopeSet, unionInScope) import Clash.Normalize.Types (NormalizeState) import Clash.Rewrite.Types - (RewriteMonad, bindings, evaluator, globalHeap, tcCache, tupleTcCache, uniqSupply) import Clash.Rewrite.Util (mkInternalVar, mkSelectorCase, - isUntranslatableType, isConstant) + isUntranslatableType) +import Clash.Rewrite.WorkFree (isConstant) import Clash.Unique (lookupUniqMap) import Clash.Util @@ -145,13 +156,22 @@ | not eIsconstant = do tcm <- Lens.view tcCache bndrs <- Lens.use bindings - (primEval, primUnwind) <- Lens.view evaluator - gh <- Lens.use globalHeap + evaluate <- Lens.view evaluator ids <- Lens.use uniqSupply let (ids1,ids2) = splitSupply ids uniqSupply Lens..= ids2 - let eval = (Lens.view Lens._3) . whnf' primEval primUnwind bndrs tcm gh ids1 is0 False - eTy = termType tcm e +#if EXPERIMENTAL_EVALUATOR + (i,_) <- Lens.use curFun + heap <- Lens.use ioHeap + addr <- Lens.use ioAddr + fuel <- Lens.view fuelLimit + let genv = mkGlobalEnv bndrs tcm is0 ids1 fuel heap addr + let eval = fst . unsafePerformIO . nf evaluate genv False i +#else + gh <- Lens.use globalHeap + let eval = (Lens.view Lens._3) . whnf' evaluate bndrs tcm gh ids1 is0 False +#endif + let eTy = termType tcm e untran <- isUntranslatableType False eTy case untran of -- Don't lift out non-representable values, because they cannot be let-bound @@ -521,11 +541,19 @@ ,("GHC.Base.modInt",lastNotPow2) ,("GHC.Classes.divInt#",lastNotPow2) ,("GHC.Classes.modInt#",lastNotPow2) +#if MIN_VERSION_base(4,15,0) + ,("GHC.Num.Integer.integerMul",allNonPow2) + ,("GHC.Num.Integer.integerDiv",lastNotPow2) + ,("GHC.Num.Integer.integerMod",lastNotPow2) + ,("GHC.Num.Integer.integerQuot",lastNotPow2) + ,("GHC.Num.Integer.integerRem",lastNotPow2) +#else ,("GHC.Integer.Type.timesInteger",allNonPow2) ,("GHC.Integer.Type.divInteger",lastNotPow2) ,("GHC.Integer.Type.modInteger",lastNotPow2) ,("GHC.Integer.Type.quotInteger",lastNotPow2) ,("GHC.Integer.Type.remInteger",lastNotPow2) +#endif ,("GHC.Prim.*#",allNonPow2) ,("GHC.Prim.quotInt#",lastNotPow2) ,("GHC.Prim.remInt#",lastNotPow2) diff --git a/src/Clash/Normalize/PrimitiveReductions.hs b/src/Clash/Normalize/PrimitiveReductions.hs --- a/src/Clash/Normalize/PrimitiveReductions.hs +++ b/src/Clash/Normalize/PrimitiveReductions.hs @@ -33,24 +33,39 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} module Clash.Normalize.PrimitiveReductions where import qualified Control.Lens as Lens +import Control.Lens ((.=)) import Data.List (mapAccumR) import Data.List.Extra (zipEqual) import qualified Data.Maybe as Maybe +import TextShow (showt) -import PrelNames (boolTyConKey) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names + (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, + typeNatSubTyFamNameKey) +import GHC.Types.Unique (getKey) +import GHC.Types.SrcLoc (wiredInSrcSpan) +#else +import PrelNames + (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, + typeNatSubTyFamNameKey) import Unique (getKey) +import SrcLoc (wiredInSrcSpan) +#endif import Clash.Core.DataCon (DataCon) import Clash.Core.Literal (Literal (..)) -import Clash.Core.Name (nameOcc) +import Clash.Core.Name + (nameOcc, Name(..), NameSort(User), mkUnsafeSystemName) import Clash.Core.Pretty (showPpr) import Clash.Core.Term - (CoreContext (..), PrimInfo (..), Term (..), WorkInfo (..), Pat (..), - collectTermIds, mkApps, idToVar) + (IsMultiPrim (..), CoreContext (..), PrimInfo (..), Term (..), WorkInfo (..), Pat (..), + collectTermIds, mkApps) import Clash.Core.TermInfo import Clash.Core.Type (LitTy (..), Type (..), TypeView (..), coreView1, @@ -58,12 +73,13 @@ splitFunForallTy, tyView) import Clash.Core.TyCon (TyConMap, TyConName, tyConDataCons, tyConName) -import Clash.Core.TysPrim (integerPrimTy, typeNatKind) +import Clash.Core.TysPrim + (integerPrimTy, typeNatKind, liftedTypeKind) import Clash.Core.Util (appendToVec, extractElems, extractTElems, mkRTree, mkUniqInternalId, mkUniqSystemTyVar, mkVec, dataConInstArgTys, primCo, undefinedTm) -import Clash.Core.Var (Var (..)) +import Clash.Core.Var (Var (..), mkTyVar, mkLocalId) import Clash.Core.VarEnv (InScopeSet, extendInScopeSetList) import {-# SOURCE #-} Clash.Normalize.Strategy @@ -72,7 +88,184 @@ import Clash.Rewrite.Util import Clash.Unique import Clash.Util +import qualified Clash.Util.Interpolate as I +typeNatAdd :: TyConName +typeNatAdd = + Name User "GHC.TypeNats.+" (getKey typeNatAddTyFamNameKey) wiredInSrcSpan + +typeNatMul :: TyConName +typeNatMul = + Name User "GHC.TypeNats.*" (getKey typeNatMulTyFamNameKey) wiredInSrcSpan + +typeNatSub :: TyConName +typeNatSub = + Name User "GHC.TypeNats.-" (getKey typeNatSubTyFamNameKey) wiredInSrcSpan + +vecHeadPrim + :: TyConName + -- ^ Vec TyCon name + -> Term +vecHeadPrim vecTcNm = + -- head :: Vec (n+1) a -> a + Prim (PrimInfo "Clash.Sized.Vector.head" (vecHeadTy vecTcNm) WorkNever SingleResult) + +vecLastPrim + :: TyConName + -- ^ Vec TyCon name + -> Term +vecLastPrim vecTcNm = + -- last :: Vec (n+1) a -> a + -- has the same type signature as head, hence we're reusing its type + -- definition here. + Prim (PrimInfo "Clash.Sized.Vector.last" (vecHeadTy vecTcNm) WorkNever SingleResult) + +vecHeadTy + :: TyConName + -- ^ Vec TyCon name + -> Type +vecHeadTy vecNm = + ForAllTy nTV $ + ForAllTy aTV $ + mkFunTy + (mkTyConApp vecNm [mkTyConApp typeNatAdd [VarTy nTV, LitTy (NumTy 1)], VarTy aTV]) + (VarTy aTV) + where + aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 0) + nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1) + +vecTailPrim + :: TyConName + -- ^ Vec TyCon name + -> Term +vecTailPrim vecTcNm = + -- tail :: Vec (n + 1) a -> Vec n a + Prim (PrimInfo "Clash.Sized.Vector.tail" (vecTailTy vecTcNm) WorkNever SingleResult) + +vecInitPrim + :: TyConName + -- ^ Vec TyCon name + -> Term +vecInitPrim vecTcNm = + -- init :: Vec (n + 1) a -> Vec n a + -- has the same type signature as tail, hence we're reusing its type + -- definition here. + Prim (PrimInfo "Clash.Sized.Vector.init" (vecTailTy vecTcNm) WorkNever SingleResult) + +vecTailTy + :: TyConName + -- ^ Vec TyCon name + -> Type +vecTailTy vecNm = + ForAllTy nTV $ + ForAllTy aTV $ + mkFunTy + (mkTyConApp vecNm [mkTyConApp typeNatAdd [VarTy nTV, LitTy (NumTy 1)], VarTy aTV]) + (mkTyConApp vecNm [VarTy nTV, VarTy aTV]) + where + nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0) + aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 1) + +-- | Makes two case statements: the first one extract the _head_ from the given +-- vector, the latter the tail. +extractHeadTail + :: DataCon + -- ^ The Cons (:>) constructor + -> Type + -- ^ Element type + -> Integer + -- ^ Length of the vector + -> Term + -- ^ Vector to extract head from + -> (Term, Term) + -- ^ (head of vector, tail of vector) +extractHeadTail consCon elTy n vec = + ( Case vec elTy [(pat, Var el)] + , Case vec restTy [(pat, Var rest)] ) + where + tys = [(LitTy (NumTy n)), elTy, (LitTy (NumTy (n-1)))] + Just [coTy, _elTy, restTy] = dataConInstArgTys consCon tys + + mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0) + co = mkLocalId coTy (mkUnsafeSystemName "_co_" 1) + el = mkLocalId elTy (mkUnsafeSystemName "el" 2) + rest = mkLocalId restTy (mkUnsafeSystemName "res" 3) + + pat = DataPat consCon [mTV] [co, el, rest] + +-- Make case statement that projects the _head_ from a given vector +extractHead + :: DataCon + -- ^ The Cons (:>) constructor + -> Type + -- ^ Element type + -> Integer + -- ^ Length of the vector + -> Term + -- ^ Vector to extract head from + -> Term + -- ^ Head of vector +extractHead consCon elTy vLength vec = + fst (extractHeadTail consCon elTy vLength vec) + +-- Make case statement that projects the _tail_ from a given vector +extractTail + :: DataCon + -- ^ The Cons (:>) constructor + -> Type + -- ^ Element type + -> Integer + -- ^ Length of the vector + -> Term + -- ^ Vector to extract head from + -> Term + -- ^ Tail of vector +extractTail consCon elTy vLength vec = + snd (extractHeadTail consCon elTy vLength vec) + +-- | Create a vector of supplied elements +mkVecCons + :: HasCallStack + => DataCon + -- ^ The Cons (:>) constructor + -> Type + -- ^ Element type + -> Integer + -- ^ Length of the vector + -> Term + -- ^ head of the vector + -> Term + -- ^ tail of the vector + -> Term +mkVecCons consCon resTy n h t + | n <= 0 = error "mkVecCons: n <= 0" + | otherwise = + mkApps (Data consCon) [ Right (LitTy (NumTy n)) + , Right resTy + , Right (LitTy (NumTy (n-1))) + , Left (primCo consCoTy) + , Left h + , Left t ] + + where + args = dataConInstArgTys consCon [LitTy (NumTy n), resTy, LitTy (NumTy (n-1))] + Just (consCoTy : _) = args + +-- | Create an empty vector +mkVecNil + :: DataCon + -- ^ The Nil constructor + -> Type + -- ^ The element type + -> Term +mkVecNil nilCon resTy = + mkApps (Data nilCon) [ Right (LitTy (NumTy 0)) + , Right resTy + , Left (primCo nilCoTy) ] + where + args = dataConInstArgTys nilCon [LitTy (NumTy 0), resTy] + Just (nilCoTy : _ ) = args + -- | Replace an application of the @Clash.Sized.Vector.reverse@ primitive on -- vectors of a known length @n@, by the fully unrolled recursive "definition" -- of @Clash.Sized.Vector.reverse@ @@ -110,74 +303,90 @@ -- of @Clash.Sized.Vector.zipWith@ reduceZipWith :: TransformContext + -> PrimInfo -- ^ zipWith primitive info -> Integer -- ^ Length of the vector(s) - -> Type -- ^ Type of the lhs of the function - -> Type -- ^ Type of the rhs of the function - -> Type -- ^ Type of the result of the function + -> Type -- ^ Element type of the lhs of the function + -> Type -- ^ Element type of the rhs of the function + -> Type -- ^ Element type of the result of the function -> Term -- ^ The zipWith'd functions -> Term -- ^ The 1st vector argument -> Term -- ^ The 2nd vector argument -> NormalizeSession Term -reduceZipWith (TransformContext is0 ctx) n lhsElTy rhsElTy resElTy fun lhsArg rhsArg = do - tcm <- Lens.view tcCache - let ty = termType tcm lhsArg - go tcm ty - where - go tcm (coreView1 tcm -> Just ty') = go tcm ty' - go tcm (tyView -> TyConApp vecTcNm _) - | (Just vecTc) <- lookupUniqMap vecTcNm tcm - , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" - , [nilCon,consCon] <- tyConDataCons vecTc - = do - uniqs0 <- Lens.use uniqSupply - fun1 <- constantPropagation (TransformContext is0 (AppArg Nothing:ctx)) fun - let is1 = extendInScopeSetList is0 (collectTermIds fun1) - (uniqs1,(varsL,elemsL)) = second (second concat . unzip) - $ extractElems uniqs0 is1 consCon lhsElTy 'L' n lhsArg - is2 = extendInScopeSetList is0 (map fst elemsL) - (uniqs2,(varsR,elemsR)) = second (second concat . unzip) - $ extractElems uniqs1 is2 consCon rhsElTy 'R' n rhsArg - funApps = zipWith (\l r -> mkApps fun1 [Left l,Left r]) varsL varsR - lbody = mkVec nilCon consCon resElTy n funApps - lb = Letrec (init elemsL ++ init elemsR) lbody - uniqSupply Lens..= uniqs2 - changed lb - go _ ty = error $ $(curLoc) ++ "reduceZipWith: argument does not have a vector type: " ++ showPpr ty +reduceZipWith _ctx zipWithPrimInfo n lhsElTy rhsElTy resElTy fun lhsArg rhsArg = do + tcm <- Lens.view tcCache + changed (go tcm (termType tcm lhsArg)) + where + go tcm (coreView1 tcm -> Just ty) = go tcm ty + go tcm (tyView -> TyConApp vecTcNm _) + | (Just vecTc) <- lookupUniqMap vecTcNm tcm + , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" + , [nilCon, consCon] <- tyConDataCons vecTc + = if n == 0 then + mkVecNil nilCon resElTy + else + let + (a, as) = extractHeadTail consCon lhsElTy n lhsArg + (b, bs) = extractHeadTail consCon rhsElTy n rhsArg + c = mkApps fun [Left a, Left b] + cs = mkApps (Prim zipWithPrimInfo) [ Right lhsElTy + , Right rhsElTy + , Right resElTy + , Right (LitTy (NumTy (n - 1))) + , Left fun + , Left as + , Left bs ] + in + mkVecCons consCon resElTy n c cs + go _ ty = + error $ $(curLoc) ++ [I.i| + reduceZipWith: argument does not have a vector type: + #{showPpr ty} + |] + -- | Replace an application of the @Clash.Sized.Vector.map@ primitive on vectors -- of a known length @n@, by the fully unrolled recursive "definition" of -- @Clash.Sized.Vector.map@ reduceMap :: TransformContext + -> PrimInfo -- ^ map primitive info -> Integer -- ^ Length of the vector -> Type -- ^ Argument type of the function -> Type -- ^ Result type of the function -> Term -- ^ The map'd function -> Term -- ^ The map'd over vector -> NormalizeSession Term -reduceMap (TransformContext is0 ctx) n argElTy resElTy fun arg = do +reduceMap _ctx mapPrimInfo n argElTy resElTy fun arg = do tcm <- Lens.view tcCache let ty = termType tcm arg - go tcm ty + changed (go tcm ty) where go tcm (coreView1 tcm -> Just ty') = go tcm ty' go tcm (tyView -> TyConApp vecTcNm _) | (Just vecTc) <- lookupUniqMap vecTcNm tcm , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" , [nilCon,consCon] <- tyConDataCons vecTc - = do - uniqs0 <- Lens.use uniqSupply - fun1 <- constantPropagation (TransformContext is0 (AppArg Nothing:ctx)) fun - let is1 = extendInScopeSetList is0 (collectTermIds fun1) - (uniqs1,(vars,elems)) = second (second concat . unzip) - $ extractElems uniqs0 is1 consCon argElTy 'A' n arg - funApps = map (fun1 `App`) vars - lbody = mkVec nilCon consCon resElTy n funApps - lb = Letrec (init elems) lbody - uniqSupply Lens..= uniqs1 - changed lb - go _ ty = error $ $(curLoc) ++ "reduceMap: argument does not have a vector type: " ++ showPpr ty + = if n == 0 then + mkVecNil nilCon argElTy + else + let + nPredTy = Right (LitTy (NumTy (n - 1))) + (a, as) = extractHeadTail consCon argElTy n arg + b = mkApps fun [Left a] + bs = mkApps (Prim mapPrimInfo) [ Right argElTy + , Right resElTy + , nPredTy + , Left fun + , Left as ] + in + mkVecCons consCon resElTy n b bs + go _ ty = + error $ $(curLoc) ++ [I.i| + reduceMap: argument does not have a vector type: + #{showPpr ty} + |] + -- | Replace an application of the @Clash.Sized.Vector.imap@ primitive on vectors -- of a known length @n@, by the fully unrolled recursive "definition" of -- @Clash.Sized.Vector.imap@ @@ -214,7 +423,7 @@ (mkTyConApp idxTcNm [VarTy nTv]) [integerPrimTy,integerPrimTy]) - idxFromInteger = Prim (PrimInfo "Clash.Sized.Internal.Index.fromInteger#" idxFromIntegerTy WorkNever) + idxFromInteger = Prim (PrimInfo "Clash.Sized.Internal.Index.fromInteger#" idxFromIntegerTy WorkNever SingleResult) idxs = map (App (App (TyApp idxFromInteger (LitTy (NumTy n))) (Literal (IntegerLiteral (toInteger n)))) . Literal . IntegerLiteral . toInteger) [0..(n-1)] @@ -225,6 +434,56 @@ changed lb go _ ty = error $ $(curLoc) ++ "reduceImap: argument does not have a vector type: " ++ showPpr ty +-- | Replace an application of the @Clash.Sized.Vector.iterateI@ primitive on +-- vectors of a known length @n@, by the fully unrolled recursive "definition" +-- of @Clash.Sized.Vector.iterateI@ +reduceIterateI + :: TransformContext + -> Integer + -- ^ Length of vector + -> Type + -- ^ Vector's element type + -> Type + -- ^ Vector's type + -> Term + -- ^ iterateI's HO-function argument + -> Term + -- ^ iterateI's start value + -> RewriteMonad NormalizeState Term + -- ^ Fully unrolled definition +reduceIterateI (TransformContext is0 ctx) n aTy vTy f0 a = do + tcm <- Lens.view tcCache + f1 <- constantPropagation (TransformContext is0 (AppArg Nothing:ctx)) f0 + + -- Generate uniq ids for element assignments. + uniqs0 <- Lens.use uniqSupply + let + is1 = extendInScopeSetList is0 (collectTermIds f1) + ((uniqs1, _is2), elementIds) = + mapAccumR + mkUniqInternalId + (uniqs0, is1) + (zip (map (("el" <>) . showt) [1..n-1]) (repeat aTy)) + uniqSupply .= uniqs1 + + let + TyConApp vecTcNm _ = tyView vTy + Just vecTc = lookupUniqMap vecTcNm tcm + [nilCon, consCon] = tyConDataCons vecTc + elems = map (App f1) (a:map Var elementIds) + vec = mkVec nilCon consCon aTy n (take (fromInteger n) (a:map Var elementIds)) + + -- Result: + -- let + -- el1 = f a + -- el2 = f el1 + -- el3 = f el2 + -- .. + -- in + -- (a :> el1 :> el2 :> el3 :> ..) + -- + pure (Letrec (zip elementIds elems) vec) + -- | Replace an application of the @Clash.Sized.Vector.traverse#@ primitive on -- vectors of a known length @n@, by the fully unrolled recursive "definition" -- of @Clash.Sized.Vector.traverse#@ @@ -361,6 +620,8 @@ -- of @Clash.Sized.Vector.foldr@ reduceFoldr :: TransformContext + -> PrimInfo + -- ^ Primitive info for foldr blackbox -> Integer -- ^ Length of the vector -> Type @@ -372,29 +633,35 @@ -> Term -- ^ The argument vector -> NormalizeSession Term -reduceFoldr _ 0 _ _ start _ = changed start -reduceFoldr (TransformContext is0 ctx) n aTy fun start arg = do +reduceFoldr _ _ 0 _ _ start _ = changed start +reduceFoldr _ctx foldrPrimInfo n aTy fun start arg = do tcm <- Lens.view tcCache let ty = termType tcm arg - go tcm ty + changed (go tcm ty) where go tcm (coreView1 tcm -> Just ty') = go tcm ty' go tcm (tyView -> TyConApp vecTcNm _) - | (Just vecTc) <- lookupUniqMap vecTcNm tcm - , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" - , [_,consCon] <- tyConDataCons vecTc - = do - uniqs0 <- Lens.use uniqSupply - fun1 <- constantPropagation (TransformContext is0 (AppArg Nothing:ctx)) fun - let is1 = extendInScopeSetList is0 (collectTermIds fun1) - (uniqs1,(vars,elems)) = second (second concat . unzip) - $ extractElems uniqs0 is1 consCon aTy 'G' n arg - lbody = foldr (\l r -> mkApps fun1 [Left l,Left r]) start vars - lb = Letrec (init elems) lbody - uniqSupply Lens..= uniqs1 - changed lb - go _ ty = error $ $(curLoc) ++ "reduceFoldr: argument does not have a vector type: " ++ showPpr ty + | nameOcc vecTcNm == "Clash.Sized.Vector.Vec" + , Just vecTc <- lookupUniqMap vecTcNm tcm + , [_nilCon, consCon] <- tyConDataCons vecTc + = let + (a, as) = extractHeadTail consCon aTy n arg + b = mkApps (Prim foldrPrimInfo) [ Right aTy + , Right (termType tcm start) + , Right (LitTy (NumTy (n - 1))) + , Left fun + , Left start + , Left as ] + in + mkApps fun [Left a, Left b] + go _ ty = + error $ $(curLoc) ++ [I.i| + reduceFoldr: argument does not have a vector type: + + #{showPpr ty} + |] + -- | Replace an application of the @Clash.Sized.Vector.fold@ primitive on -- vectors of a known length @n@, by the fully unrolled recursive "definition" -- of @Clash.Sized.Vector.fold@ @@ -581,35 +848,38 @@ -- vector. reduceInit :: InScopeSet + -> PrimInfo -- ^ Primitive info for 'init' -> Integer -- ^ Length of the vector -> Type -- ^ Element type of the vector -> Term -- ^ The argument vector -> NormalizeSession Term -reduceInit inScope n aTy vArg = do - tcm <- Lens.view tcCache - let ty = termType tcm vArg - go tcm ty - where - go tcm (coreView1 tcm -> Just ty') = go tcm ty' - go tcm (tyView -> TyConApp vecTcNm _) - | (Just vecTc) <- lookupUniqMap vecTcNm tcm - , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" - , [nilCon,consCon] <- tyConDataCons vecTc - = do - uniqs0 <- Lens.use uniqSupply - let (uniqs1,(_,elems)) = second unzip - $ extractElems uniqs0 inScope consCon aTy 'L' n vArg - uniqSupply Lens..= uniqs1 - case n of - 0 -> changed (undefinedTm aTy) - 1 -> changed (mkVec nilCon consCon aTy 0 []) - _ -> let el = init elems - iv = mkVec nilCon consCon aTy (n-1) (map (idToVar . fst . head) el) - lb = init (concat el) - in changed (Letrec lb iv) +reduceInit _inScope initPrimInfo n aTy vArg = do + tcm <- Lens.view tcCache + let ty = termType tcm vArg + changed (go tcm ty) + where + go tcm (coreView1 tcm -> Just ty') = go tcm ty' + go tcm (tyView -> TyConApp vecTcNm _) + | (Just vecTc) <- lookupUniqMap vecTcNm tcm + , nameOcc vecTcNm == "Clash.Sized.Vector.Vec" + , [nilCon, consCon] <- tyConDataCons vecTc + = if n == 0 then + mkVecNil nilCon aTy + else + let + nPredTy = Right (LitTy (NumTy (n - 1))) + (a, as0) = extractHeadTail consCon aTy (n+1) vArg + as1 = mkApps (Prim initPrimInfo) [nPredTy, Right aTy, Left as0] + in + mkVecCons consCon aTy n a as1 - go _ ty = error $ $(curLoc) ++ "reduceInit: argument does not have a vector type: " ++ showPpr ty + go _ ty = + error $ $(curLoc) ++ [I.i| + reduceInit: argument does not have a vector type: + #{showPpr ty} + |] + -- | Replace an application of the @Clash.Sized.Vector.(++)@ primitive on -- vectors of a known length @n@, by the fully unrolled recursive "definition" -- of @Clash.Sized.Vector.(++)@ @@ -779,7 +1049,11 @@ -> Type -> Term eqIntPrim intTy boolTy = - Prim (PrimInfo "Clash.Transformations.eqInt" (mkFunTy intTy (mkFunTy intTy boolTy)) WorkVariable) + Prim (PrimInfo + "Clash.Transformations.eqInt" + (mkFunTy intTy (mkFunTy intTy boolTy)) + WorkVariable + SingleResult ) go tcm (coreView1 tcm -> Just ty') = go tcm ty' go tcm (tyView -> TyConApp vecTcNm _) @@ -879,7 +1153,11 @@ -> Type -> Term eqIntPrim intTy boolTy = - Prim (PrimInfo "Clash.Transformations.eqInt" (mkFunTy intTy (mkFunTy intTy boolTy)) WorkVariable) + Prim ( PrimInfo + "Clash.Transformations.eqInt" + (mkFunTy intTy (mkFunTy intTy boolTy)) + WorkVariable + SingleResult ) go tcm (coreView1 tcm -> Just ty') = go tcm ty' go tcm (tyView -> TyConApp vecTcNm _) diff --git a/src/Clash/Normalize/Strategy.hs b/src/Clash/Normalize/Strategy.hs --- a/src/Clash/Normalize/Strategy.hs +++ b/src/Clash/Normalize/Strategy.hs @@ -6,6 +6,8 @@ Transformation process for normalization -} +{-# LANGUAGE CPP #-} + module Clash.Normalize.Strategy where import Clash.Normalize.Transformations @@ -28,11 +30,17 @@ -- | Normalisation transformation normalization :: NormRewrite -normalization = rmDeadcode >-> constantPropagation >-> rmUnusedExpr >-!-> anf >-!-> rmDeadcode >-> - bindConst >-> letTL >-> evalConst >-!-> cse >-!-> cleanup >-> - xOptim >-> rmDeadcode >-> - cleanup >-> recLetRec >-> splitArgs +normalization = + rmDeadcode >-> multPrim >-> constantPropagation >-> rmUnusedExpr >-!-> anf >-!-> rmDeadcode >-> + bindConst >-> letTL +#if !EXPERIMENTAL_EVALUATOR + >-> evalConst +#endif + >-!-> cse >-!-> cleanup >-> + xOptim >-> rmDeadcode >-> + cleanup >-> bindSimIO >-> recLetRec >-> splitArgs where + multPrim = topdownR (apply "setupMultiResultPrim" setupMultiResultPrim) anf = topdownR (apply "nonRepANF" nonRepANF) >-> apply "ANF" makeANF >-> topdownR (apply "caseCon" caseCon) letTL = topdownSucR (apply "topLet" topLet) recLetRec = apply "recToLetRec" recToLetRec @@ -40,7 +48,9 @@ rmDeadcode = bottomupR (apply "deadcode" deadCode) bindConst = topdownR (apply "bindConstantVar" bindConstantVar) -- See [Note] bottomup traversal evalConst: +#if !EXPERIMENTAL_EVALUATOR evalConst = bottomupR (apply "evalConst" reduceConst) +#endif cse = topdownR (apply "CSE" simpleCSE) xOptim = bottomupR (apply "xOptimize" xOptimize) cleanup = topdownR (apply "etaExpandSyn" etaExpandSyn) >-> @@ -51,12 +61,18 @@ >-> rmDeadcode >-> letTL splitArgs = topdownR (apply "separateArguments" separateArguments) !-> topdownR (apply "caseCon" caseCon) + bindSimIO = topdownR (apply "bindSimIO" inlineSimIO) constantPropagation :: NormRewrite -constantPropagation = inlineAndPropagate >-> - caseFlattening >-> etaTL >-> dec >-> spec >-> dec >-> - conSpec +constantPropagation = + inlineAndPropagate >-> + caseFlattening >-> + etaTL >-> + dec >-> + spec >-> + dec >-> + conSpec where etaTL = apply "etaTL" etaExpansionTL !-> topdownR (apply "applicationPropagation" appPropFast) inlineAndPropagate = repeatR (topdownR (applyMany transPropagateAndInline) >-> inlineNR) @@ -72,7 +88,9 @@ [ ("applicationPropagation", appPropFast ) , ("bindConstantVar" , bindConstantVar ) , ("caseLet" , caseLet ) +#if !EXPERIMENTAL_EVALUATOR , ("caseCase" , caseCase ) +#endif , ("caseCon" , caseCon ) , ("elemExistentials" , elemExistentials ) , ("caseElemNonReachable" , caseElemNonReachable ) @@ -98,8 +116,22 @@ -- binder might be recursive. The idea is, is that if the recursive -- non-representable binder is inlined once, we can get rid of the recursive -- aspect using the case-of-known-constructor + -- + -- Note that we first do a dead code removal pass, which makes sure that + -- unused let-bindings get cleaned up. Only if no dead code is removed + -- 'inlineNonRep' is executed. We do this for two reasons: + -- + -- 1. 'deadCode' is an expensive operation and is therefore left out of + -- the hot loop 'transPropagateAndInline'. + -- + -- 2. In various situations 'transPropagateAndInline' can do more work + -- after 'deadCode' was successful. This work in turn might remove a + -- a construct 'inlineNonRep' would fire on - saving the compiler work. + -- inlineNR :: NormRewrite - inlineNR = bottomupR (apply "inlineNonRep" inlineNonRep) + inlineNR = + bottomupR (apply "deadCode" deadCode) + >-! apply "inlineNonRep" inlineNonRep specTransformations :: [(String,NormRewrite)] specTransformations = diff --git a/src/Clash/Normalize/Transformations.hs b/src/Clash/Normalize/Transformations.hs --- a/src/Clash/Normalize/Transformations.hs +++ b/src/Clash/Normalize/Transformations.hs @@ -59,6 +59,8 @@ , separateArguments , separateLambda , xOptimize + , setupMultiResultPrim + , inlineSimIO ) where @@ -72,6 +74,7 @@ import Control.Monad.Writer (lift, listen) import Control.Monad.Trans.Except (runExcept) import Data.Coerce (coerce) +import Data.Default import qualified Data.Either as Either import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashMap.Strict as HashMapS @@ -82,22 +85,30 @@ import qualified Data.Monoid as Monoid import qualified Data.Primitive.ByteArray as BA import qualified Data.Text as Text -import qualified Data.Vector.Primitive as PV +#if MIN_VERSION_base(4,15,0) +import GHC.Num.Integer (Integer (..)) +#else import GHC.Integer.GMP.Internals (Integer (..), BigNat (..)) +#endif +import TextShow (TextShow(showt)) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Basic (InlineSpec (..)) +#else import BasicTypes (InlineSpec (..)) +#endif import Clash.Annotations.Primitive (extractPrim) import Clash.Core.DataCon (DataCon (..)) import Clash.Core.EqSolver import Clash.Core.Name - (Name (..), NameSort (..), mkUnsafeSystemName, nameOcc) + (mkUnsafeInternalName, Name (..), NameSort (..), mkUnsafeSystemName, nameOcc) import Clash.Core.FreeVars (localIdOccursIn, localIdsDoNotOccurIn, freeLocalIds, termFreeTyVars, typeFreeVars, localVarsDoNotOccurIn, localIdDoesNotOccurIn, countFreeOccurances) import Clash.Core.Literal (Literal (..)) -import Clash.Core.Pretty (showPpr) +import Clash.Core.Pretty (PrettyOptions(..), showPpr, showPpr') import Clash.Core.Subst import Clash.Core.Term import Clash.Core.TermInfo @@ -414,9 +425,46 @@ {-# SCC caseCase #-} -- | Inline function with a non-representable result if it's the subject --- of a Case-decomposition +-- of a Case-decomposition. It's a custom topdown traversal that -for efficiency +-- reasons- does not explore alternative of cases whose subject triggered an +-- 'inlineNonRepWorker'. inlineNonRep :: HasCallStack => NormRewrite -inlineNonRep _ e@(Case scrut altsTy alts) +inlineNonRep ctx0 e0@(Case {}) = do + r <- listen (inlineNonRepWorker e0) + case r of + (e1, Monoid.getAny -> True) -> + return e1 + (~(Case subj0 typ alts), _) -> do + -- If a term _in_ the subject triggers 'inlineNonRepWorker', inline and + -- propagate might eliminate this case. We therefore don't explore the + -- alternatives. Note that this makes it substantially different from a + -- 'topdownSucR' transformation. + let + TransformContext inScope ctx1 = ctx0 + ctx2 = TransformContext inScope (CaseScrut:ctx1) + + listen (inlineNonRep ctx2 subj0) >>= \case + (subj1, Monoid.getAny -> True) -> + return (Case subj1 typ alts) + (subj1, _) -> do + let (pats, rhss0) = unzip alts + rhss1 <- mapM (inlineNonRep ctx2) rhss0 + pure (Case subj1 typ (zip pats rhss1)) + +inlineNonRep ctx e = + -- All non-case statements are simply traversed. TODO: are there other special + -- cases like 'Case' that would warrant an optimization like ^ ? + allR inlineNonRep ctx e +{-# SCC inlineNonRep #-} + +-- | Inline function with a non-representable result if it's the subject +-- of a Case-decomposition. This worker function only tries the given term +-- (i.e., it does not traverse it). +-- +-- It sets the changed flag in the NormalizeSession if it successfully inlines +-- a binder. +inlineNonRepWorker :: HasCallStack => Term -> NormalizeSession Term +inlineNonRepWorker e@(Case scrut altsTy alts) | (Var f, args,ticks) <- collectArgsTicks scrut , isGlobalId f = do @@ -424,45 +472,50 @@ isInlined <- zoomExtra (alreadyInlined f cf) limit <- Lens.use (extra.inlineLimit) tcm <- Lens.view tcCache - let scrutTy = termType tcm scrut - noException = not (exception tcm scrutTy) - if noException && (Maybe.fromMaybe 0 isInlined) > limit - then - trace (concat [ $(curLoc) ++ "InlineNonRep: " ++ showPpr (varName f) - ," already inlined " ++ show limit ++ " times in:" - , showPpr (varName cf) - , "\nType of the subject is: " ++ showPpr scrutTy - , "\nFunction " ++ showPpr (varName cf) - , " will not reach a normal form, and compilation" - , " might fail." - , "\nRun with '-fclash-inline-limit=N' to increase" - , " the inlining limit to N." - ]) - (return e) - else do - bodyMaybe <- lookupVarEnv f <$> Lens.use bindings - nonRepScrut <- not <$> (representableType <$> Lens.view typeTranslator - <*> Lens.view customReprs - <*> pure False - <*> Lens.view tcCache - <*> pure scrutTy) - case (nonRepScrut, bodyMaybe) of - (True,Just b) -> do - Monad.when noException (zoomExtra (addNewInline f cf)) + let + scrutTy = termType tcm scrut - let scrutBody0 = mkTicks (bindingTerm b) (mkInlineTick f : ticks) - let scrutBody1 = mkApps scrutBody0 args + -- Constraint dictionary inlining always terminates, so we ignore the + -- usual inline safeguards. + notClassTy = not (isClassTy tcm scrutTy) + overLimit = notClassTy && (Maybe.fromMaybe 0 isInlined) > limit - changed $ Case scrutBody1 altsTy alts - _ -> return e - where - exception = isClassTy + bodyMaybe <- lookupVarEnv f <$> Lens.use bindings + nonRepScrut <- not <$> (representableType <$> Lens.view typeTranslator + <*> Lens.view customReprs + <*> pure False + <*> Lens.view tcCache + <*> pure scrutTy) + case (nonRepScrut, bodyMaybe) of + (True, Just b) -> do + if overLimit then + trace ($(curLoc) ++ [I.i| + InlineNonRep: #{showPpr (varName f)} already inlined + #{limit} times in: #{showPpr (varName cf)}. The type of the subject + is: -inlineNonRep _ e = return e -{-# SCC inlineNonRep #-} + #{showPpr' def{displayTypes=True\} scrutTy} + Function #{showPpr (varName cf)} will not reach a normal form and + compilation might fail. + Run with '-fclash-inline-limit=N' to increase the inline limit to N. + |]) (return e) + else do + Monad.when notClassTy (zoomExtra (addNewInline f cf)) + + let scrutBody0 = mkTicks (bindingTerm b) (mkInlineTick f : ticks) + let scrutBody1 = mkApps scrutBody0 args + + changed $ Case scrutBody1 altsTy alts + _ -> + return e + +inlineNonRepWorker e = pure e +{-# SCC inlineNonRepWorker #-} + + caseCon :: HasCallStack => NormRewrite caseCon = apply "caseOneAlt" (const caseOneAlt) >-! caseCon' @@ -556,7 +609,8 @@ -- based on the fact on whether the argument has the potential to make -- the circuit larger than needed if we were to duplicate that argument. newBinder (isN0, substN) (x, arg) = do - isWorkFree arg >>= \case + bndrs <- Lens.use bindings + isWorkFree workFreeBinders bndrs arg >>= \case True -> pure ((isN0, (x, arg):substN), Nothing) False -> let @@ -704,24 +758,30 @@ in changed e' | dcTag dc == 2 , l >= 2^(63::Int) +#if MIN_VERSION_base(4,15,0) + = let !(IP ba) = l +#else = let !(Jp# !(BN# ba)) = l +#endif ba' = BA.ByteArray ba - bv = PV.Vector 0 (BA.sizeofByteArray ba') ba' fvs = Lens.foldMapOf freeLocalIds unitVarSet e (binds,_) = List.partition ((`elemVarSet` fvs) . fst) - $ List.zipEqual xs [Literal (ByteArrayLiteral bv)] + $ List.zipEqual xs [Literal (ByteArrayLiteral ba')] e' = case binds of [] -> e _ -> Letrec binds e in changed e' | dcTag dc == 3 , l < ((-2)^(63::Int)) +#if MIN_VERSION_base(4,15,0) + = let !(IN ba) = l +#else = let !(Jn# !(BN# ba)) = l +#endif ba' = BA.ByteArray ba - bv = PV.Vector 0 (BA.sizeofByteArray ba') ba' fvs = Lens.foldMapOf freeLocalIds unitVarSet e (binds,_) = List.partition ((`elemVarSet` fvs) . fst) - $ List.zipEqual xs [Literal (ByteArrayLiteral bv)] + $ List.zipEqual xs [Literal (ByteArrayLiteral ba')] e' = case binds of [] -> e _ -> Letrec binds e @@ -750,12 +810,15 @@ in changed e' | dcTag dc == 2 , l >= 2^(64::Int) +#if MIN_VERSION_base(4,15,0) + = let !(IP ba) = l +#else = let !(Jp# !(BN# ba)) = l +#endif ba' = BA.ByteArray ba - bv = PV.Vector 0 (BA.sizeofByteArray ba') ba' fvs = Lens.foldMapOf freeLocalIds unitVarSet e (binds,_) = List.partition ((`elemVarSet` fvs) . fst) - $ List.zipEqual xs [Literal (ByteArrayLiteral bv)] + $ List.zipEqual xs [Literal (ByteArrayLiteral ba')] e' = case binds of [] -> e _ -> Letrec binds e @@ -867,13 +930,13 @@ case usedArguments of UsedArguments used -> Just used IgnoredArguments ignored -> Just ([0..length args - 1] \\ ignored) - Just (BlackBox pNm _ _ _ _ _ _ _ _ inc r ri templ) -> Just $ + Just (BlackBox pNm _ _ _ _ _ _ _ _ _ inc r ri templ) -> Just $ if | isFromInt pNm -> [0,1,2] | primName pInfo `elem` [ "Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL" , "Clash.Sized.Vector.splitAt" ] -> [0,1] - | otherwise -> concat [ maybe [] getUsedArguments r - , maybe [] getUsedArguments ri + | otherwise -> concat [ concatMap getUsedArguments r + , concatMap getUsedArguments ri , getUsedArguments templ , concatMap (getUsedArguments . snd) inc ] _ -> @@ -944,11 +1007,13 @@ test _ (i,stripTicks -> e) = case isLocalVar e of -- Don't inline `let x = x in x`, it throws us in an infinite loop True -> return (i `localIdDoesNotOccurIn` e) - _ -> isWorkFreeIsh e >>= \case - True -> Lens.use (extra.inlineConstantLimit) >>= \case - 0 -> return True - n -> return (termSize e <= n) - _ -> return False + _ -> do + tcm <- Lens.view tcCache + case isWorkFreeIsh tcm e of + True -> Lens.use (extra.inlineConstantLimit) >>= \case + 0 -> return True + n -> return (termSize e <= n) + _ -> return False {-# SCC bindConstantVar #-} -- | Push a cast over a case into it's alternatives. @@ -986,8 +1051,16 @@ -- and expression where two casts are "back-to-back" after which we can -- eliminate them in 'eliminateCastCast'. argCastSpec :: HasCallStack => NormRewrite -argCastSpec ctx e@(App _ (stripTicks -> Cast e' _ _)) = - isWorkFree e' >>= \case +argCastSpec ctx e@(App f (stripTicks -> Cast e' _ _)) + -- Don't specialise when the arguments are casts-of-casts, these casts-of-casts + -- will be eliminated by 'eliminateCastCast' during the normalization of the + -- "current" function. We thus prevent the unnecessary introduction of a + -- specialized version of 'f'. + | not (isCast e) + -- Don't specialise prims, because we can't push casts into them + , not . isPrim . fst . collectArgs $ f = do + bndrs <- Lens.use bindings + isWorkFree workFreeBinders bndrs e' >>= \case True -> go False -> warn go where @@ -1079,9 +1152,11 @@ (const (pure False))) args untranslatable <- isUntranslatableType True eTy + topEnts <- Lens.view topEntities let isSignal = isSignalType tcm eTy let lv = isLocalId f - if untranslatable || isSignal || argsHaveWork || lv + let isTopEnt = elemVarSet f topEnts + if untranslatable || isSignal || argsHaveWork || lv || isTopEnt then return e else do bndrs <- Lens.use bindings @@ -1294,7 +1369,8 @@ go is0 (Lam v e) (Left arg:args) ticks = do setChanged - orM [pure (isVar arg), isWorkFree arg] >>= \case + bndrs <- Lens.use bindings + orM [pure (isVar arg), isWorkFree workFreeBinders bndrs arg] >>= \case True -> let subst = extendIdSubst (mkSubst is0) v arg in (`mkTicks` ticks) <$> go is0 (substTm "appPropFast.AppLam" subst e) args [] @@ -1347,9 +1423,10 @@ goCaseArg isA0 ty0 ls0 (Left arg:args0) = do tcm <- Lens.view tcCache + bndrs <- Lens.use bindings let argTy = termType tcm arg ty1 = applyFunTy tcm ty0 argTy - orM [pure (isVar arg), isWorkFree arg] >>= \case + orM [pure (isVar arg), isWorkFree workFreeBinders bndrs arg] >>= \case True -> do (ty2,ls1,args1) <- goCaseArg isA0 ty1 ls0 args0 return (ty2,ls1,Left arg:args1) @@ -1591,13 +1668,13 @@ | (conVarPrim, _) <- collectArgs e , isCon conVarPrim || isPrim conVarPrim || isVar conVarPrim = do + tcm <- Lens.view tcCache untranslatable <- lift (isUntranslatable False arg) let localVar = isLocalVar arg - constantNoCR <- lift (isConstantNotClockReset arg) + constantNoCR = isConstantNotClockReset tcm arg -- See Note [ANF no let-bind] case (untranslatable,localVar || constantNoCR, isSimBind conVarPrim,arg) of (False,False,False,_) -> do - tcm <- Lens.view tcCache -- See Note [ANF InScopeSet] is1 <- Lens.use _2 argId <- lift (mkTmBinderFor is1 tcm (mkDerivedName ctx "app_arg") arg) @@ -1866,8 +1943,8 @@ eqArg _ v1 v2@(stripTicks -> Var {}) = v1 == v2 eqArg tcm v1 v2@(collectArgs . stripTicks -> (Data _, args')) - | let t1 = termType tcm v1 - , let t2 = termType tcm v2 + | let t1 = normalizeType tcm (termType tcm v1) + , let t2 = normalizeType tcm (termType tcm v2) , t1 == t2 = if isClassConstraint t1 then -- Class constraints are equal if their types are equal, so we can @@ -2089,7 +2166,7 @@ if shouldReduce1 then let [fun,lhsArg,rhsArg] = Either.lefts args in (`mkTicks` ticks) <$> - reduceZipWith c n lhsElTy rhsElty resElTy fun lhsArg rhsArg + reduceZipWith c p n lhsElTy rhsElty resElTy fun lhsArg rhsArg else return e _ -> return e "Clash.Sized.Vector.map" | argLen == 5 -> do @@ -2102,7 +2179,7 @@ [argElTy,resElTy] ] if shouldReduce1 then let [fun,arg] = Either.lefts args - in (`mkTicks` ticks) <$> reduceMap c n argElTy resElTy fun arg + in (`mkTicks` ticks) <$> reduceMap c p n argElTy resElTy fun arg else return e _ -> return e "Clash.Sized.Vector.traverse#" | argLen == 7 -> @@ -2113,7 +2190,7 @@ in (`mkTicks` ticks) <$> reduceTraverse c n aTy fTy bTy dict fun arg _ -> return e "Clash.Sized.Vector.fold" | argLen == 4 -> do - let [aTy,nTy] = Either.rights args + let [nTy,aTy] = Either.rights args case runExcept (tyNatSize tcm nTy) of Right n -> do shouldReduce1 <- List.orM [ pure (ultra || n == 0) @@ -2133,7 +2210,7 @@ , List.anyM isUntranslatableType_not_poly [aTy,bTy] ] if shouldReduce1 then let [fun,start,arg] = Either.lefts args - in (`mkTicks` ticks) <$> reduceFoldr c n aTy fun start arg + in (`mkTicks` ticks) <$> reduceFoldr c p n aTy fun start arg else return e _ -> return e "Clash.Sized.Vector.dfold" | argLen == 8 -> @@ -2197,7 +2274,7 @@ shouldReduce1 <- List.orM [ shouldReduce ctx , isUntranslatableType_not_poly aTy ] if shouldReduce1 - then (`mkTicks` ticks) <$> reduceInit is0 (n+1) aTy vArg + then (`mkTicks` ticks) <$> reduceInit is0 p n aTy vArg else return e _ -> return e "Clash.Sized.Vector.unconcat" | argLen == 6 -> do @@ -2259,6 +2336,20 @@ in (`mkTicks` ticks) <$> reduceImap c n argElTy resElTy fun arg else return e _ -> return e + "Clash.Sized.Vector.iterateI" | argLen == 5 -> + let ([_kn,f,a],[nTy,aTy]) = Either.partitionEithers args in + case runExcept (tyNatSize tcm nTy) of + Right n -> do + shouldReduce1 <- List.orM + [ pure (ultra || n < 2) + , shouldReduce ctx + , isUntranslatableType_not_poly aTy ] + + if shouldReduce1 then + (`mkTicks` ticks) <$> reduceIterateI c n aTy eTy f a + else + return e + _ -> return e "Clash.Sized.Vector.dtfold" | argLen == 8 -> let ([_kn,_motive,lrFun,brFun,arg],[_mTy,nTy,aTy]) = Either.partitionEithers args in case runExcept (tyNatSize tcm nTy) of @@ -2720,9 +2811,10 @@ emptyVarEnv (`unitVarEnv` (1 :: Int)) body (is2,binds1) <- second concat <$> List.mapAccumLM go is1 binds + bndrs <- Lens.use bindings e1WorkFree <- case binds1 of - [(_,e1)] -> isWorkFree e1 + [(_,e1)] -> isWorkFree workFreeBinders bndrs e1 _ -> pure (error "flattenLet: unreachable") case binds1 of -- inline binders into the body when there's only a single binder, and only @@ -2757,9 +2849,10 @@ emptyVarEnv (`unitVarEnv` (1 :: Int)) body2 (srcTicks,nmTicks) = partitionTicks ticks + bndrs <- Lens.use bindings e2WorkFree <- case binds2 of - [(_,e2)] -> isWorkFree e2 + [(_,e2)] -> isWorkFree workFreeBinders bndrs e2 _ -> pure (error "flattenLet: unreachable") -- Distribute the name ticks of the let-expression over all the bindings (isN1,) . map (second (`mkTicks` nmTicks)) <$> case binds2 of @@ -2902,7 +2995,7 @@ case defPart of ([], _) -> return e - (_, []) -> changed (Prim (PrimInfo "Clash.XException.errorX" ty WorkConstant)) + (_, []) -> changed (Prim (PrimInfo "Clash.XException.errorX" ty WorkConstant SingleResult)) (_, [alt]) -> xOptimizeSingle is0 subj alt (_, defs) -> xOptimizeMany is0 subj ty defs else @@ -2981,3 +3074,98 @@ isErr _ = False isPrimError _ = return False + +-- A multi result primitive assigns its results to multiple result variables +-- instead of one. Besides producing nicer HDL it works around issues with +-- synthesis tooling described in: +-- +-- https://github.com/clash-lang/clash-compiler/issues/1555 +-- +-- This transformation rewrites primitives indicating they can assign their +-- results to multiple signals, such that netlist can easily render it. +-- +-- Example: +-- +-- @ +-- prim :: forall a. a -> (a, a) +-- @ +-- +-- will be rewritten to: +-- +-- @ +-- \a0 -> let +-- r = prim @t0 a0 r0 r1 -- With 'Clash.Core.Term.MultiPrim' +-- r0 = multiPrimSelect r0 r +-- r1 = multiPrimSelect r1 r +-- in +-- (x, y) +-- @ +-- +-- Netlist will not render any @multiPrimSelect@ primitives. Similar to +-- primitives having a /void/ return type, /r/ is not rendered either. +-- +-- This transformation is currently hardcoded to recognize tuples as return +-- types, not any product type. It will error if it sees a multi result primitive +-- with a non-tuple return type. +-- +setupMultiResultPrim :: HasCallStack => NormRewrite +setupMultiResultPrim _ctx e@(Prim pInfo@PrimInfo{primMultiResult=SingleResult}) = do + tcm <- Lens.view tcCache + prim <- Lens.use (extra . primitives . Lens.at (primName pInfo)) + + case prim >>= extractPrim of + Just (BlackBoxHaskell{multiResult=True}) -> + changed (setupMultiResultPrim' tcm pInfo) + Just (BlackBox{multiResult=True}) -> + changed (setupMultiResultPrim' tcm pInfo) + _ -> + return e + +setupMultiResultPrim _ e = return e + +setupMultiResultPrim' :: HasCallStack => TyConMap -> PrimInfo -> Term +setupMultiResultPrim' tcm primInfo@PrimInfo{primType} = + mkAbstraction letTerm (map Right typeVars <> map Left argIds) + where + typeVars = Either.lefts pArgs + + internalNm prefix n = mkUnsafeInternalName (prefix <> showt n) n + internalId prefix typ n = mkLocalId typ (internalNm prefix n) + + nTermArgs = length (Either.rights pArgs) + argIds = zipWith (internalId "a") (Either.rights pArgs) [1..nTermArgs] + resIds = zipWith (internalId "r") resTypes [nTermArgs+1..nTermArgs+length resTypes] + resId = mkLocalId pResTy (mkUnsafeInternalName "r" (nTermArgs+length resTypes+1)) + + (pArgs, pResTy) = splitFunForallTy primType + MultiPrimInfo{mpi_resultDc=tupTc, mpi_resultTypes=resTypes} = + multiPrimInfo' tcm primInfo + + multiPrimSelect r t = (r, mkTmApps (Prim (multiPrimSelectInfo t)) [Var r, Var resId]) + multiPrimSelectBinds = zipWith multiPrimSelect resIds resTypes + multiPrimTermArgs = map (Left . Var) (argIds <> resIds) + multiPrimTypeArgs = map (Right . VarTy) typeVars + multiPrimBind = + mkApps + (Prim primInfo{primMultiResult=MultiResult}) + (multiPrimTypeArgs <> multiPrimTermArgs) + + multiPrimSelectInfo t = PrimInfo + { primName = "c$multiPrimSelect" + , primType = mkPolyFunTy pResTy [Right pResTy, Right t] + , primWorkInfo = WorkAlways + , primMultiResult = SingleResult } + + letTerm = + Letrec + ((resId,multiPrimBind):multiPrimSelectBinds) + (mkTmApps (mkTyApps (Data tupTc) resTypes) (map Var resIds)) + +-- | Inline anything of type `SimIO`: IO actions cannot be shared +inlineSimIO :: HasCallStack => NormRewrite +inlineSimIO = inlineBinders test + where + test _ (i,_) = case tyView (varType i) of + TyConApp tc _ -> return $! nameOcc tc == "Clash.Explicit.SimIO.SimIO" + _ -> return False +{-# SCC inlineSimIO #-} diff --git a/src/Clash/Normalize/Util.hs b/src/Clash/Normalize/Util.hs --- a/src/Clash/Normalize/Util.hs +++ b/src/Clash/Normalize/Util.hs @@ -6,6 +6,7 @@ Utility functions used by the normalisation transformations -} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -46,8 +47,13 @@ import Data.Text (Text) import qualified Data.Text as Text +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names (eqTyConKey) +import GHC.Types.Unique (getKey) +#else import PrelNames (eqTyConKey) import Unique (getKey) +#endif import Clash.Annotations.Primitive (extractPrim) import Clash.Core.FreeVars @@ -137,11 +143,12 @@ Nothing -> return Nothing Just inlined' -> return (lookupVarEnv f inlined') +-- | Record a new inlining in the `inlineHistory` addNewInline :: Id - -- ^ Function we want to inline + -- ^ Function we're inlining -> Id - -- ^ Function in which we want to perform the inlining + -- ^ Function in which we're inlining it -> NormalizeMonad () addNewInline f cf = inlineHistory %= extendVarEnvWith @@ -226,7 +233,7 @@ -> [TickInfo] -- ^ Ticks to wrap around proposed new term -> Term - -- ^ "Old" term + -- ^ \"Old\" term -> ([Either Term Type] -> Term) -- ^ Proposed new term in case any constants were found -> [Either Term Type] @@ -408,9 +415,9 @@ normalizeTopLvlBndr :: Bool -> Id - -> Binding - -> NormalizeSession Binding -normalizeTopLvlBndr isTop nm (Binding nm' sp inl tm) = makeCachedU nm (extra.normalized) $ do + -> Binding Term + -> NormalizeSession (Binding Term) +normalizeTopLvlBndr isTop nm (Binding nm' sp inl pr tm) = makeCachedU nm (extra.normalized) $ do tcm <- Lens.view tcCache let nmS = showPpr (varName nm) -- We deshadow the term because sometimes GHC gives us @@ -424,7 +431,7 @@ tm3 <- rewriteExpr ("normalization",normalization) (nmS,tm2) (nm',sp) curFun .= old let ty' = termType tcm tm3 - return (Binding nm'{varType = ty'} sp inl tm3) + return (Binding nm'{varType = ty'} sp inl pr tm3) -- | Turn type equality constraints into substitutions and apply them. -- @@ -517,7 +524,8 @@ :: Type -> Term removedTm = - TyApp (Prim (PrimInfo "Clash.Transformations.removedArg" undefinedTy WorkNever)) + let removedNm = "Clash.Transformations.removedArg" in + TyApp (Prim (PrimInfo removedNm undefinedTy WorkNever SingleResult)) -- | A tick to prefix an inlined expression with it's original name. -- For example, given diff --git a/src/Clash/Primitives/DSL.hs b/src/Clash/Primitives/DSL.hs --- a/src/Clash/Primitives/DSL.hs +++ b/src/Clash/Primitives/DSL.hs @@ -13,6 +13,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} @@ -20,13 +21,16 @@ module Clash.Primitives.DSL ( -- * Annotations - blackBoxHaskell + BlackBoxHaskellOpts(..) + , blackBoxHaskell -- * declarations , BlockState (..) , TExpr , declaration + , declarationReturn , instDecl + , instHO , viaAnnotatedSignal -- ** Literals @@ -34,16 +38,18 @@ , LitHDL (..) , pattern High , pattern Low + , constructProduct , tuple , vec -- ** Extraction , tInputs - , tResult + , tResults , getStr , getBool , exprToInteger , tExprToInteger + , deconstructProduct , untuple , unvec @@ -72,6 +78,9 @@ import Clash.Util (HasCallStack, clogBase) import Control.Lens hiding (Indexed, assign) import Control.Monad.State +import Data.Default (Default(def)) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap import Data.List (intersperse) import Data.List.Extra (zipEqual) import Data.Maybe (fromMaybe) @@ -87,57 +96,116 @@ import Clash.Backend hiding (fromBV, toBV) import Clash.Backend.VHDL (VHDLState) import Clash.Core.Var (Attr') -import Clash.Netlist.BlackBox.Util (exprToString) -import Clash.Netlist.Id -import Clash.Netlist.Types hiding (toBit) -import Clash.Netlist.Util hiding (mkUniqueIdentifier) +import Clash.Netlist.BlackBox.Util (exprToString, renderElem) +import Clash.Netlist.BlackBox.Types + (BlackBoxTemplate, Element(Component, Text), Decl(..)) +import qualified Clash.Netlist.Id as Id +import Clash.Netlist.Types hiding (Component, toBit) +import Clash.Netlist.Util import qualified Data.String.Interpolate as I import Data.String.Interpolate.Util (unindent) import Language.Haskell.TH (Name) import Prelude +-- | Options for 'blackBoxHaskell' function. Use 'def' from package +-- 'data-default' for a set of default options. +data BlackBoxHaskellOpts = BlackBoxHaskellOpts + { -- | Arguments to ignore (i.e., remove during normalization) + -- + -- Default: [] + bo_ignoredArguments :: [Int] + + -- | HDLs to use the blackbox for + -- + -- Default: all + , bo_supportedHdls :: [HDL] + + -- | Does this blackbox assign its results to multiple binders? + -- + -- Default: False. + , bo_multiResult :: Bool + } + +instance Default BlackBoxHaskellOpts where + def = BlackBoxHaskellOpts + { bo_ignoredArguments = [] + , bo_supportedHdls = [minBound..maxBound] + , bo_multiResult = False + } + -- | Create a blackBoxHaskell primitive. To be used as part of an annotation: -- -- @ --- {-# ANN myFunction (blackBoxHaskell [1,2,3] VHDL 'myFunction 'myBBF) #-} +-- {-# ANN myFunction (blackBoxHaskell 'myFunction 'myBBF def{_ignoredArguments=[2,3]}) #-} -- @ +-- +-- [2,3] would mean this blackbox __ignores__ its second and third argument. blackBoxHaskell - :: [Int] - -- ^ Ignored arguments - -> HDL - -- ^ hdl the blackbox is for - -> Name + :: Name -- ^ blackbox name -> Name -- ^ template function name + -> BlackBoxHaskellOpts + -- ^ Options, see data structure for more information -> Primitive -blackBoxHaskell (show -> ign) hdl bb tf = - InlinePrimitive [hdl] $ unindent [I.i| +blackBoxHaskell bb tf BlackBoxHaskellOpts{..} = + InlinePrimitive bo_supportedHdls $ unindent [I.i| [ { "BlackBoxHaskell" : - { "name" : "#{bb}" - , "templateFunction" : "#{tf}" - , "ignoredArguments" : #{ign} - } + { "name" : "#{bb}" + , "templateFunction" : "#{tf}" + , "ignoredArguments" : #{show bo_ignoredArguments} + , "multiResult" : #{toJsonBool bo_multiResult} + } } - ] -|] + ] |] + where + toJsonBool :: Bool -> String + toJsonBool True = "true" + toJsonBool False = "false" -- | The state of a block. Contains a list of declarations and a the -- backend state. data BlockState backend = BlockState { _bsDeclarations :: [Declaration] - , _bsBackend :: backend + -- ^ Declarations store + , _bsHigherOrderCalls :: IntMap Int + -- ^ Tracks how many times a higher order function has been instantiated. + -- Needed to fill in the second field of 'Clash.Netlist.BlackBox.Types.Decl' + , _bsBackend :: backend + -- ^ Backend state } +makeLenses ''BlockState +instance Backend backend => HasIdentifierSet (BlockState backend) where + identifierSet :: Lens' (BlockState backend) IdentifierSet + identifierSet = bsBackend . identifierSet + -- | A typed expression. data TExpr = TExpr { ety :: HWType , eex :: Expr } deriving Show - -makeLenses ''BlockState makeLenses ''TExpr +-- | Run a block declaration. Assign the result of the block builder to the +-- result variable in the given blackbox context. +declarationReturn + :: Backend backend + => BlackBoxContext + -> Text.Text + -- ^ block name + -> State (BlockState backend) [TExpr] + -- ^ block builder yielding an expression that should be assigned to the + -- result variable in the blackbox context + -> State backend Doc + -- ^ pretty printed block +declarationReturn bbCtx blockName blockBuilder = + declaration blockName $ do + res <- blockBuilder + forM_ (zip (bbResults bbCtx) res) $ \(rNm, r) -> do + let (Identifier resultNm Nothing, _) = rNm + addDeclaration (Assignment resultNm (eex r)) + -- | Run a block declaration. declaration :: Backend backend @@ -149,25 +217,45 @@ -- ^ pretty printed block declaration blockName s = do backend0 <- get - let initState = BlockState [] backend0 - BlockState decs backend1 = execState s initState + let initState = BlockState [] IntMap.empty backend0 + BlockState decs _hoCalls backend1 = execState s initState put backend1 - blockNameUnique <- mkUniqueIdentifier Basic blockName + blockNameUnique <- Id.makeBasic blockName getMon $ blockDecl blockNameUnique (reverse decs) -- | Add a declaration to the state. addDeclaration :: Declaration -> State (BlockState backend) () addDeclaration dec = bsDeclarations %= cons dec --- | Create a new basic unique name using the given Text as a template. -newName :: Backend backend => Text -> State (BlockState backend) Identifier -newName nm = zoom bsBackend $ mkUniqueIdentifier Basic nm +-- | Declare a new signal with the given name and type. +declare' + :: Backend backend + => Text + -- ^ Name hint + -> WireOrReg + -- ^ Should signal be declared as a wire or a reg + -> HWType + -- ^ Type of new signal + -> State (BlockState backend) Identifier + -- ^ Expression pointing the the new signal +declare' decName wireOrReg ty = do + uniqueName <- Id.makeBasic decName + addDeclaration (NetDecl' Nothing wireOrReg uniqueName (Right ty) Nothing) + pure uniqueName -- | Declare a new signal with the given name and type. -declare :: Backend backend => Identifier -> HWType -> State (BlockState backend) TExpr -declare decName ty = do - uniqueName <- newName decName - addDeclaration (NetDecl Nothing uniqueName ty) +declare + :: Backend backend + => Text + -- ^ Name hint + -> WireOrReg + -- ^ Should signal be declared as a wire or a reg + -> HWType + -- ^ Type of new signal + -> State (BlockState backend) TExpr + -- ^ Expression pointing the the new signal +declare decName wireOrReg ty = do + uniqueName <- declare' decName wireOrReg ty pure (TExpr ty (Identifier uniqueName Nothing)) -- | Assign an expression to an identifier, returns the new typed @@ -181,7 +269,7 @@ -> State (BlockState backend) TExpr -- ^ the identifier of the expression that actually got assigned assign aName (TExpr ty aExpr) = do - texp@(~(TExpr _ (Identifier uniqueName Nothing))) <- declare aName ty + texp@(~(TExpr _ (Identifier uniqueName Nothing))) <- declare aName Wire ty addDeclaration (Assignment uniqueName aExpr) pure texp @@ -190,7 +278,7 @@ -- will be used to assign the given expression to which is subsequently indexed. unvec :: Backend backend - => Identifier + => Text -- ^ Name hint for intermediate signal -> TExpr -- ^ Vector expression @@ -202,21 +290,34 @@ pure (map (TExpr eType . vIndex) [0..vSize-1]) unvec _ e = error $ "unvec: cannot be called on non-vector: " <> show (ety e) +-- | Extract the fields of a product type and return expressions +-- to them. These new expressions are given unique names and get +-- declared in the block scope. +deconstructProduct + :: (HasCallStack, Backend backend) + => TExpr + -- ^ Product expression + -> [Text] + -- ^ Name hints for element assignments + -> State (BlockState backend) [TExpr] +deconstructProduct (TExpr ty@(Product _ _ tys) (Identifier resName _)) vals = do + newNames <- zipWithM (flip declare Wire) vals tys + addDeclaration $ Assignment resName $ DataCon ty (DC (ty, 0)) (fmap eex newNames) + pure newNames +deconstructProduct e i = + error $ "deconstructProduct: " <> show e <> " " <> show i + -- | Extract the elements of a tuple expression and return expressions -- to them. These new expressions are given unique names and get --- declared the block scope. +-- declared in the block scope. untuple :: (HasCallStack, Backend backend) => TExpr -- ^ Tuple expression - -> [Identifier] + -> [Text] -- ^ Name hints for element assignments -> State (BlockState backend) [TExpr] -untuple (TExpr ty@(Product _ _ tys) (Identifier resName _)) vals = do - newNames <- zipWithM declare vals tys - addDeclaration $ Assignment resName $ DataCon ty (DC (ty, 0)) (fmap eex newNames) - pure newNames -untuple e i = error $ "untuple: " <> show e <> " " <> show i +untuple = deconstructProduct -- | The high literal bit. pattern High :: TExpr @@ -253,7 +354,7 @@ -- | Convert a bool to a bit. boolToBit :: (HasCallStack, Backend backend) - => Identifier + => Text -- ^ Name hint for intermediate signal -> TExpr -> State (BlockState backend) TExpr @@ -261,7 +362,7 @@ T -> pure High F -> pure Low TExpr Bool boolExpr -> do - texp@(~(TExpr _ (Identifier uniqueBitName Nothing))) <- declare bitName Bit + texp@(~(TExpr _ (Identifier uniqueBitName Nothing))) <- declare bitName Wire Bit addDeclaration $ CondAssignment uniqueBitName Bit boolExpr Bool [ (Just (BoolLit True), Literal Nothing (BitLit H)) @@ -275,22 +376,22 @@ -- Returns a reference to a declared `Bit` that should get assigned -- by something (usually the output port of an entity). boolFromBit - :: Backend backend - => Identifier + :: Text -- ^ Name hint for intermediate signal -> TExpr - -> State (BlockState backend) TExpr + -> State (BlockState VHDLState) TExpr boolFromBit = outputCoerce Bit Bool (<> " = '1'") -- | Used to create an output `Bool` from a `BitVector` of given size. -- Works in a similar way to `boolFromBit` above. +-- +-- TODO: Implement for (System)Verilog boolFromBitVector - :: Backend backend - => Size - -> Identifier + :: Size + -> Text -- ^ Name hint for intermediate signal -> TExpr - -> State (BlockState backend) TExpr + -> State (BlockState VHDLState) TExpr boolFromBitVector n = outputCoerce (BitVector n) Bool (\i -> "unsigned(" <> i <> ") > 0") @@ -300,7 +401,7 @@ -- TODO: Implement for (System)Verilog unsignedFromBitVector :: Size - -> Identifier + -> Text -- ^ Name hint for intermediate signal -> TExpr -> State (BlockState VHDLState) TExpr @@ -315,7 +416,7 @@ -- -- TODO: Implement for (System)Verilog boolFromBits - :: [Identifier] + :: [Text] -> TExpr -> State (BlockState VHDLState) [TExpr] boolFromBits inNames = outputFn (map (const Bit) inNames) Bool @@ -330,18 +431,19 @@ :: (HasCallStack, Backend backend) => HWType -> HWType - -> (Identifier -> Identifier) - -> Identifier + -> (Text -> Text) + -> Text -> TExpr -> State (BlockState backend) TExpr -outputCoerce fromType toType exprStringFn inName expr_ +outputCoerce fromType toType exprStringFn inName0 expr_ | TExpr outType (Identifier outName Nothing) <- expr_ , outType == toType = do - inName' <- newName inName - let exprIdent = Identifier (exprStringFn inName') Nothing - addDeclaration (NetDecl Nothing inName' fromType) + inName1 <- Id.makeBasic inName0 + let inName2 = Id.unsafeMake (exprStringFn (Id.toText inName1)) + exprIdent = Identifier inName2 Nothing + addDeclaration (NetDecl Nothing inName1 fromType) addDeclaration (Assignment outName exprIdent) - pure (TExpr fromType (Identifier inName' Nothing)) + pure (TExpr fromType (Identifier inName1 Nothing)) outputCoerce _ toType _ _ texpr = error $ "outputCoerce: the expression " <> show texpr <> " must be an Identifier with type " <> show toType @@ -355,19 +457,20 @@ :: (HasCallStack, Backend backend) => [HWType] -> HWType - -> ([Identifier] -> Identifier) - -> [Identifier] + -> ([Text] -> Text) + -> [Text] -> TExpr -> State (BlockState backend) [TExpr] -outputFn fromTypes toType exprFn inNames (TExpr outType (Identifier outName Nothing)) +outputFn fromTypes toType exprFn inNames0 (TExpr outType (Identifier outName Nothing)) | outType == toType = do - inNames' <- mapM newName inNames - let exprIdent = Identifier (exprFn inNames') Nothing + inNames1 <- mapM Id.makeBasic inNames0 + let idExpr = Id.unsafeMake (exprFn (map Id.toText inNames1)) + exprIdent = Identifier idExpr Nothing sequenceOf_ each [ addDeclaration (NetDecl Nothing nm t) - | (nm,t) <- zipEqual inNames' fromTypes ] + | (nm, t) <- zip inNames1 fromTypes ] addDeclaration (Assignment outName exprIdent) pure [ TExpr t (Identifier nm Nothing) - | (nm,t) <- zipEqual inNames' fromTypes ] + | (nm,t) <- zipEqual inNames1 fromTypes ] outputFn _ outType _ _ texpr = error $ "outputFn: the expression " <> show texpr <> " must be an Identifier with type " <> show outType @@ -388,14 +491,18 @@ theVec = mkVectorChain (length els) (ety el) (map eex els) vec [] = error "vec: can't be used on empty lists" +-- | Construct a product type given its type and fields +constructProduct :: HWType -> [TExpr] -> TExpr +constructProduct ty els = + TExpr ty (DataCon ty (DC (ty,0)) (map eex els)) + -- | Create an n-tuple of 'TExpr' tuple :: [TExpr] -> TExpr tuple [] = error $ "nTuple: Cannot create empty tuple" tuple [_] = -- If we don't put this in: tuple . untuple /= id error $ "nTuple: Cannot create 1-tuple" -tuple els = - TExpr tupTy (DataCon tupTy (DC (tupTy,0)) (map eex els)) +tuple els = constructProduct tupTy els where commas = Text.replicate (length els - 1) "," tupTy = Product ("GHC.Tuple.(" <> commas <> ")") Nothing (map ety els) @@ -422,8 +529,8 @@ -- bitvector if the expression is not already a bitvector. toBV :: Backend backend - => Identifier - -- ^ BitVector name + => Text + -- ^ BitVector name hint -> TExpr -- ^ expression -> State (BlockState backend) TExpr @@ -431,28 +538,28 @@ toBV bvName a = case a of TExpr BitVector{} _ -> pure a TExpr aTy aExpr -> assign bvName $ - TExpr (BitVector (typeSize aTy)) (ConvBV Nothing aTy True aExpr) + TExpr (BitVector (typeSize aTy)) (ToBv Nothing aTy aExpr) -- | Assign an output bitvector to an expression. Declares a new -- bitvector if the expression is not already a bitvector. fromBV :: (HasCallStack, Backend backend) - => Identifier - -- ^ BitVector name + => Text + -- ^ BitVector name hint -> TExpr -- ^ expression -> State (BlockState backend) TExpr -- ^ bv expression fromBV _ a@(TExpr BitVector{} _) = pure a fromBV bvName (TExpr aTy (Identifier aName Nothing)) = do - bvName' <- newName bvName - let bvExpr = ConvBV Nothing aTy False (Identifier bvName' Nothing) + bvName' <- Id.makeBasic bvName + let bvExpr = FromBv Nothing aTy (Identifier bvName' Nothing) bvTy = BitVector (typeSize aTy) addDeclaration (NetDecl Nothing bvName' bvTy) addDeclaration (Assignment aName bvExpr) pure (TExpr bvTy (Identifier bvName' Nothing)) fromBV _ texpr = error $ - "fromBV: the expression " <> show texpr <> "must be an Indentifier" + "fromBV: the expression " <> show texpr <> "must be an Identifier" clog2 :: Num i => Integer -> i clog2 = fromIntegral . fromMaybe 0 . clogBase 2 @@ -479,9 +586,75 @@ instance IsString LitHDL where fromString = S +-- | Instantiate/call a higher-order function. +instHO + :: Backend backend + => BlackBoxContext + -- ^ BlackBoxContext, used for rendering higher-order function and error + -- reporting + -> Int + -- ^ Position of HO-argument. For example: + -- + -- fold :: forall n a . (a -> a -> a) -> Vec (n + 1) a -> a + -- + -- would have its HO-argument at position 0, while + -- + -- iterateI :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a + -- + -- would have it at position 1. + -> (HWType, BlackBoxTemplate) + -- ^ Result type of HO function + -> [(TExpr, BlackBoxTemplate)] + -- ^ Arguments and their types + -> State (BlockState backend) TExpr + -- ^ Result of the function +instHO bbCtx fPos (resTy, bbResTy) argsWithTypes = do + let (args0, argTypes) = unzip argsWithTypes + fSubPos <- fromMaybe 0 . IntMap.lookup fPos <$> use bsHigherOrderCalls + bsHigherOrderCalls %= IntMap.insert fPos (succ fSubPos) + + -- Create argument identifiers, example: fold_ho3_0_arg0 + let + ctxName = last (Text.split (=='.') (bbName bbCtx)) + baseArgName = ctxName <> "_" <> "ho" <> showt fPos <> "_" <> showt fSubPos + argName n = baseArgName <> "_arg" <> showt n + args1 <- zipWithM (\argN -> toIdentifier' (argName argN)) [(0::Int)..] args0 + + let + args2 = map (pure . Text . Id.toLazyText) args1 + + -- Create result identifier + -- See https://github.com/clash-lang/clash-compiler/issues/919 for info on + -- logic of 'resWireOrReg' + resWireOrReg = + case IntMap.lookup fPos (bbFunctions bbCtx) of + Just ((_,rw,_,_,_,_):_) -> rw + _ -> error "internal error" + resName <- declare' (ctxName <> "_" <> "ho" <> showt fPos <> "_" + <> showt fSubPos <> "_res") resWireOrReg resTy + let res = ([Text (Id.toLazyText resName)], bbResTy) + + -- Render HO argument to plain text + let component = Component (Decl fPos fSubPos (res:zip args2 argTypes)) + rendered0 <- + zoom bsBackend (string =<< (renderElem bbCtx component <*> pure 0)) + + let + layout = LayoutOptions (AvailablePerLine 120 0.4) + rendered1 = renderLazy (layoutPretty layout rendered0) + + addDeclaration $ + BlackBoxD + ("__INST_" <> bbName bbCtx <> "_BB_INTERNAL__") [] [] [] + (BBTemplate [Text rendered1]) + (emptyBBContext ("__INST_" <> bbName bbCtx <> "_BB_INTERNAL__")) + + pure (TExpr resTy (Identifier resName Nothing)) + -- | Instantiate a component/entity in a block state. instDecl - :: Backend backend + :: forall backend + . Backend backend => EntityOrComponent -- ^ Type of instantiation -> Identifier @@ -500,15 +673,23 @@ inPorts' <- mapM (mkPort In) inPorts outPorts' <- mapM (mkPort Out) outPorts - addDeclaration $ InstDecl entOrComp Nothing compName instLbl (mkAttrs attrs) (inPorts' ++ outPorts') + addDeclaration $ + InstDecl + entOrComp Nothing [] compName instLbl (mkAttrs attrs) + (NamedPortMap (inPorts' ++ outPorts')) where - mkPort inOrOut (nm, pExpr) = do - TExpr ty pExpr' <- toIdentifier (nm <> "_port") pExpr - pure (Identifier nm Nothing, inOrOut, ty, pExpr') + mkPort + :: PortDirection + -> (Text, TExpr) + -> StateT (BlockState backend) Identity (Expr, PortDirection, HWType, Expr) + mkPort inOrOut (nmText, pExpr) = do + TExpr ty pExpr' <- toIdentifier (nmText <> "_port") pExpr + pure (Identifier (Id.unsafeMake nmText) Nothing, inOrOut, ty, pExpr') -- Convert a list of name attributes to the form clash wants mkAttrs :: [(Text.Text, LitHDL)] -> [(Expr, HWType, Expr)] - mkAttrs = map (\(s, ty) -> (Identifier s Nothing, hdlTy ty, litExpr ty)) + mkAttrs = map (\(s, ty) -> ( Identifier (Id.unsafeMake s) Nothing + , hdlTy ty, litExpr ty) ) litExpr :: LitHDL -> Expr litExpr (B b) = Literal Nothing (BoolLit b) @@ -526,7 +707,7 @@ -- annotated type, using the given attributes. viaAnnotatedSignal :: (HasCallStack, Backend backend) - => Text + => Identifier -- ^ Name given to signal -> TExpr -- ^ expression the signal is assigned to @@ -552,14 +733,14 @@ tInputs = map (\(x, t, _) -> (TExpr t x, t)) . bbInputs -- | The TExp result of a blackbox context. -tResult :: BlackBoxContext -> TExpr -tResult = (\(x,t) -> TExpr t x) . bbResult +tResults :: BlackBoxContext -> [TExpr] +tResults = map (\(x,t) -> TExpr t x) . bbResults -- | Get an identifier to an expression, creating a new assignment if -- necessary. toIdentifier' :: Backend backend - => Identifier + => Text -- ^ desired new identifier name, will be made unique -> TExpr -- ^ expression to get identifier of @@ -574,7 +755,7 @@ -- necessary. toIdentifier :: Backend backend - => Identifier + => Text -- ^ desired new identifier name, will be made unique -> TExpr -- ^ expression to get identifier of @@ -587,7 +768,7 @@ -- | And together @(&&)@ two expressions, assigning it to a new identifier. andExpr :: Backend backend - => Identifier + => Text -- ^ name hint -> TExpr -- ^ a @@ -600,8 +781,8 @@ andExpr _ aExpr T = pure aExpr andExpr _ _ F = pure F andExpr nm a b = do - aIdent <- toIdentifier' (nm <> "_a") a - bIdent <- toIdentifier' (nm <> "_b") b + aIdent <- Id.toText <$> toIdentifier' (nm <> "_a") a + bIdent <- Id.toText <$> toIdentifier' (nm <> "_b") b -- This is somewhat hacky and relies on the fact that clash doesn't -- postprocess the text in Identifier. The alternative is to run -- this as a fully fledged @BlackBoxE@ but that involves a lot of @@ -612,12 +793,12 @@ VHDL -> aIdent <> " and " <> bIdent Verilog -> aIdent <> " && " <> bIdent SystemVerilog -> aIdent <> " && " <> bIdent - assign nm $ TExpr Bool (Identifier andTxt Nothing) + assign nm $ TExpr Bool (Identifier (Id.unsafeMake andTxt) Nothing) -- | Negate @(not)@ an expression, assigning it to a new identifier. notExpr :: Backend backend - => Identifier + => Text -- ^ name hint -> TExpr -- ^ a @@ -626,13 +807,13 @@ notExpr _ T = pure F notExpr _ F = pure T notExpr nm aExpr = do - aIdent <- toIdentifier' (nm <> "_a") aExpr + aIdent <- Id.toText <$> toIdentifier' (nm <> "_a") aExpr -- See disclaimer in `andExpr` above. notTxt <- uses bsBackend hdlKind <&> \case VHDL -> "not " <> aIdent Verilog -> "! " <> aIdent SystemVerilog -> "! " <> aIdent - assign nm $ TExpr Bit (Identifier notTxt Nothing) + assign nm $ TExpr Bit (Identifier (Id.unsafeMake notTxt) Nothing) -- | Creates a BV that produces the following vhdl: -- @@ -642,7 +823,7 @@ -- -- TODO: Implement for (System)Verilog pureToBV - :: Identifier + :: Text -- ^ name hint -> Int -- ^ Size (n) @@ -651,10 +832,10 @@ -> State (BlockState VHDLState) TExpr -- ^ (0 to n => ARG) pureToBV nm n arg = do - arg' <- toIdentifier' nm arg + arg' <- Id.toText <$> toIdentifier' nm arg -- This is very hard coded and hacky let text = "(0 to " <> showt n <> " => " <> arg' <> ")" - assign nm $ TExpr (BitVector (n+1)) (Identifier text Nothing) + assign nm $ TExpr (BitVector (n+1)) (Identifier (Id.unsafeMake text) Nothing) -- | Creates a BV that produces the following vhdl: -- @@ -664,7 +845,7 @@ -- -- TODO: Implement for (System)Verilog pureToBVResized - :: Identifier + :: Text -- ^ name hint -> Int -- ^ Size (n) @@ -673,14 +854,14 @@ -> State (BlockState VHDLState) TExpr -- ^ std_logic_vector(resize(ARG, Size)) pureToBVResized nm n arg = do - arg' <- toIdentifier' nm arg + arg' <- Id.toText <$> toIdentifier' nm arg -- This is very hard coded and hacky let text = "std_logic_vector(resize(" <> arg' <> ", " <> showt n <> "))" - assign nm $ TExpr (BitVector n) (Identifier text Nothing) + assign nm $ TExpr (BitVector n) (Identifier (Id.unsafeMake text) Nothing) -- | Allows assignment of a port to be "open" open :: Backend backend => HWType -> State (BlockState backend) TExpr -open hwType = pure $ TExpr hwType (Identifier "open" Nothing) +open hwType = pure $ TExpr hwType (Identifier (Id.unsafeMake "open") Nothing) diff --git a/src/Clash/Primitives/GHC/Int.hs b/src/Clash/Primitives/GHC/Int.hs --- a/src/Clash/Primitives/GHC/Int.hs +++ b/src/Clash/Primitives/GHC/Int.hs @@ -51,10 +51,10 @@ intTF' True [Left (Literal (getIntLit -> Just n))] intSize = -- Literal as declaration: ( emptyBlackBoxMeta - , BBTemplate (assign (Result False) [signedLiteral intSize n])) + , BBTemplate (assign Result [signedLiteral intSize n])) intTF' _isDecl _args _intSize = -- Not a literal. We need an assignment as Verilog does not support truncating -- arbitrary expression. ( emptyBlackBoxMeta {bbKind = TDecl } - , BBTemplate (assign (Result False) (signed (Arg False 0)))) + , BBTemplate (assign Result (signed (Arg 0)))) diff --git a/src/Clash/Primitives/GHC/Word.hs b/src/Clash/Primitives/GHC/Word.hs --- a/src/Clash/Primitives/GHC/Word.hs +++ b/src/Clash/Primitives/GHC/Word.hs @@ -40,10 +40,10 @@ wordTF' True [Left (Literal (WordLiteral n))] wordSize = -- Literal as declaration: ( emptyBlackBoxMeta - , BBTemplate (assign (Result False) [unsignedLiteral wordSize n])) + , BBTemplate (assign Result [unsignedLiteral wordSize n])) wordTF' _isDecl _args _wordSize = -- Not a literal. We need an assignment as Verilog does not support truncating -- arbitrary expression. ( emptyBlackBoxMeta {bbKind = TDecl } - , BBTemplate (assign (Result False) (unsigned (Arg False 0)))) + , BBTemplate (assign Result (unsigned (Arg 0)))) diff --git a/src/Clash/Primitives/Intel/ClockGen.hs b/src/Clash/Primitives/Intel/ClockGen.hs --- a/src/Clash/Primitives/Intel/ClockGen.hs +++ b/src/Clash/Primitives/Intel/ClockGen.hs @@ -14,15 +14,16 @@ import Clash.Backend import Clash.Netlist.BlackBox.Util -import Clash.Netlist.Id +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types -import Clash.Netlist.Util hiding (mkUniqueIdentifier) +import Clash.Netlist.Util import Control.Monad.State import Data.Semigroup.Monad import qualified Data.String.Interpolate.IsString as I import Data.Text.Prettyprint.Doc.Extra +import TextShow (showt) import qualified Data.Text as TextS @@ -33,7 +34,7 @@ valid bbCtx | [_,_,(nm,_,_),_,_] <- bbInputs bbCtx , Just _ <- exprToString nm - , (Identifier _ Nothing,Product {}) <- bbResult bbCtx + , [(Identifier _ Nothing,Product {})] <- bbResults bbCtx = True valid _ = False @@ -44,7 +45,7 @@ valid bbCtx | [_,_,(nm,_,_),_,_] <- bbInputs bbCtx , Just _ <- exprToString nm - , (Identifier _ Nothing,Product {}) <- bbResult bbCtx + , [(Identifier _ Nothing,Product {})] <- bbResults bbCtx = True valid _ = False @@ -69,28 +70,33 @@ valid _ = False alteraPllTemplate - :: Backend s + :: forall s + . Backend s => BlackBoxContext -> State s Doc alteraPllTemplate bbCtx = do - let mkId = mkUniqueIdentifier Basic - locked <- mkId "locked" - pllLock <- mkId "pllLock" - alteraPll <- mkId "altera_pll_block" - alteraPll_inst <- mkId instname0 + locked <- Id.makeBasic "locked" + pllLock <- Id.makeBasic "pllLock" + alteraPll <- Id.makeBasic "altera_pll_block" + alteraPll_inst <- Id.makeBasic instname0 - clocks <- traverse (mkUniqueIdentifier Extended) - [TextS.pack ("pllOut" ++ show n) | n <- [0..length tys - 1]] + clocks <- Id.nextN (length tys - 1) =<< Id.make "pllOut" + + -- TODO: unsafeMake is dubious here: I don't think we take names in + -- TODO: bbQsysIncName into account when generating fresh ids + let compName = Id.unsafeMake (head (bbQsysIncName bbCtx)) + + let outclkPorts = map (\n -> instPort ("outclk_" <> showt n)) [(0 :: Int)..length clocks-1] + getMon $ blockDecl alteraPll $ concat [[ NetDecl Nothing locked rstTy , NetDecl' Nothing Reg pllLock (Right Bool) Nothing] ,[ NetDecl Nothing clkNm ty | (clkNm,ty) <- zip clocks tys] - ,[ InstDecl Comp Nothing compName alteraPll_inst [] $ concat - [[(Identifier "refclk" Nothing,In,clkTy,clk) - ,(Identifier "rst" Nothing,In,rstTy,rst)] - ,[(Identifier (TextS.pack ("outclk_" ++ show n)) Nothing,Out,ty,Identifier k Nothing) - |(k,ty,n) <- zip3 clocks tys [(0 :: Int)..] ] - ,[(Identifier "locked" Nothing,Out,rstTy,Identifier locked Nothing)]] + ,[ InstDecl Comp Nothing [] compName alteraPll_inst [] $ NamedPortMap $ concat + [ [ (instPort "refclk", In, clkTy, clk) + , (instPort "rst", In, rstTy, rst)] + , [ (p, Out, ty, Identifier k Nothing) | (k, ty, p) <- zip3 clocks tys outclkPorts ] + , [(instPort "locked", Out, rstTy, Identifier locked Nothing)]] , CondAssignment pllLock Bool (Identifier locked Nothing) rstTy [(Just (BitLit H),Literal Nothing (BoolLit True)) ,(Nothing ,Literal Nothing (BoolLit False))] @@ -101,32 +107,35 @@ ] ] where - (Identifier result Nothing,resTy@(Product _ _ (init -> tys))) = bbResult bbCtx + [(Identifier result Nothing,resTy@(Product _ _ (init -> tys)))] = bbResults bbCtx [(nm,_,_),(clk,clkTy,_),(rst,rstTy,_)] = drop 3 (bbInputs bbCtx) Just nm' = exprToString nm instname0 = TextS.pack nm' - compName = head (bbQsysIncName bbCtx) altpllTemplate :: Backend s => BlackBoxContext -> State s Doc altpllTemplate bbCtx = do - let mkId = mkUniqueIdentifier Basic - pllOut <- mkId "pllOut" - locked <- mkId "locked" - pllLock <- mkId "pllLock" - alteraPll <- mkId "altpll_block" - alteraPll_inst <- mkId instname0 + pllOut <- Id.make "pllOut" + locked <- Id.make "locked" + pllLock <- Id.make "pllLock" + alteraPll <- Id.make "altpll_block" + alteraPll_inst <- Id.make instname0 + + -- TODO: unsafeMake is dubious here: I don't think we take names in + -- TODO: bbQsysIncName into account when generating fresh ids + let compName = Id.unsafeMake (head (bbQsysIncName bbCtx)) + getMon $ blockDecl alteraPll [ NetDecl Nothing locked Bit , NetDecl' Nothing Reg pllLock (Right Bool) Nothing , NetDecl Nothing pllOut clkOutTy - , InstDecl Comp Nothing compName alteraPll_inst [] - [(Identifier "clk" Nothing,In,clkTy,clk) - ,(Identifier "areset" Nothing,In,rstTy,rst) - ,(Identifier "c0" Nothing,Out,clkOutTy,Identifier pllOut Nothing) - ,(Identifier "locked" Nothing,Out,Bit,Identifier locked Nothing)] + , InstDecl Comp Nothing [] compName alteraPll_inst [] $ NamedPortMap $ + [ (instPort "clk", In, clkTy, clk) + , (instPort "areset", In, rstTy, rst) + , (instPort "c0", Out, clkOutTy, Identifier pllOut Nothing) + , (instPort "locked", Out, Bit, Identifier locked Nothing)] , CondAssignment pllLock Bool (Identifier locked Nothing) rstTy [(Just (BitLit H),Literal Nothing (BoolLit True)) ,(Nothing ,Literal Nothing (BoolLit False))] @@ -137,11 +146,9 @@ ] where [_,_,(nm,_,_),(clk,clkTy,_),(rst,rstTy,_)] = bbInputs bbCtx - (Identifier result Nothing,resTy@(Product _ _ [clkOutTy,_])) = bbResult bbCtx + [(Identifier result Nothing,resTy@(Product _ _ [clkOutTy,_]))] = bbResults bbCtx Just nm' = exprToString nm instname0 = TextS.pack nm' - compName = head (bbQsysIncName bbCtx) - altpllQsysTemplate :: Backend s diff --git a/src/Clash/Primitives/Sized/ToInteger.hs b/src/Clash/Primitives/Sized/ToInteger.hs --- a/src/Clash/Primitives/Sized/ToInteger.hs +++ b/src/Clash/Primitives/Sized/ToInteger.hs @@ -1,3 +1,12 @@ +{-| + Copyright : (C) 2020 QBayLogic + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Blackbox implementations for "Clash.Sized.Internal.*.toInteger#". +-} + +{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} module Clash.Primitives.Sized.ToInteger ( bvToIntegerVerilog @@ -18,12 +27,21 @@ import System.IO (hPutStrLn, stderr) import Text.Trifecta.Result (Result(Success)) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Session (unsafeGlobalDynFlags) +import GHC.Utils.Error (mkPlainWarnMsg, pprLocErrMsg) +import GHC.Utils.Outputable + (blankLine, empty, int, integer, showSDocUnsafe, text, ($$), ($+$), (<+>)) +import qualified GHC.Utils.Outputable as Outputable +import GHC.Types.SrcLoc (isGoodSrcSpan) +#else import DynFlags (unsafeGlobalDynFlags) import ErrUtils (mkPlainWarnMsg, pprLocErrMsg) import Outputable (blankLine, empty, int, integer, showSDocUnsafe, text, ($$), ($+$), (<+>)) import qualified Outputable import SrcLoc (isGoodSrcSpan) +#endif import Clash.Annotations.Primitive (HDL (Verilog,VHDL)) import Clash.Core.Type (Type (LitTy), LitTy (NumTy)) diff --git a/src/Clash/Primitives/Sized/Vector.hs b/src/Clash/Primitives/Sized/Vector.hs --- a/src/Clash/Primitives/Sized/Vector.hs +++ b/src/Clash/Primitives/Sized/Vector.hs @@ -12,13 +12,14 @@ module Clash.Primitives.Sized.Vector where +import Control.Monad (replicateM) import Control.Monad.State (State, zipWithM) import qualified Control.Lens as Lens import Data.Either (rights) import qualified Data.IntMap as IntMap +import Data.List.Extra (iterateNM) +import Data.Maybe (fromMaybe) import Data.Semigroup.Monad (getMon) -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LText import Data.Text.Lazy (pack) import Data.Text.Prettyprint.Doc.Extra (Doc, string, renderLazy, layoutPretty, LayoutOptions(..), @@ -26,9 +27,10 @@ import Text.Trifecta.Result (Result(Success)) import qualified Data.String.Interpolate as I import qualified Data.String.Interpolate.Util as I +import TextShow (showt) import Clash.Backend - (Backend, hdlTypeErrValue, expr, mkUniqueIdentifier, blockDecl) + (Backend, hdlTypeErrValue, expr, blockDecl) import Clash.Core.Type (Type(LitTy), LitTy(NumTy), coreView) import Clash.Netlist.BlackBox (isLiteral) @@ -41,13 +43,56 @@ (Identifier, TemplateFunction, BlackBoxContext, HWType(Vector), Declaration(..), Expr(BlackBoxE, Literal, Identifier), Literal(NumLit), BlackBox(BBTemplate, BBFunction), TemplateFunction(..), WireOrReg(Wire), - Modifier(Indexed, Nested), bbInputs, bbResult, emptyBBContext, tcCache, + Modifier(Indexed, Nested), bbInputs, bbResults, emptyBBContext, tcCache, bbFunctions) -import Clash.Netlist.Id (IdType(Basic)) +import qualified Clash.Netlist.Id as Id import Clash.Netlist.Util (typeSize) +import qualified Clash.Primitives.DSL as Prim +import Clash.Primitives.DSL + (declarationReturn, instHO, tInputs, tExprToInteger) import Clash.Util (HasCallStack, curLoc) +-- | Blackbox function for 'Clash.Sized.Vector.iterateI' +iterateBBF :: HasCallStack => BlackBoxFunction +iterateBBF _isD _primName args _resTy = do + tcm <- Lens.use tcCache + pure (Right (meta tcm, bb)) + where + bb = BBFunction "Clash.Primitives.Sized.Vector.iterateBBF" 0 iterateTF + vecLength tcm = + case coreView tcm (head (rights args)) of + (LitTy (NumTy 0)) -> error "Unexpected empty vector in 'iterateBBF'" + (LitTy (NumTy n)) -> fromInteger (n - 1) + vl -> error $ "Unexpected vector length: " ++ show vl + meta tcm = emptyBlackBoxMeta { + bbKind=TDecl + , bbFunctionPlurality=[(1, vecLength tcm)] + } + +-- | Type signature of function we're generating netlist for: +-- +-- iterateI :: KnownNat n => (a -> a) -> a -> Vec n a +-- +iterateTF :: TemplateFunction +iterateTF = TemplateFunction [] (const True) iterateTF' + +iterateTF' + :: forall s + . (HasCallStack, Backend s) + => BlackBoxContext + -> State s Doc +iterateTF' bbCtx + | [ (fromMaybe (error "n") . tExprToInteger -> n, _) + , _hoFunction + , (a, aType) + ] <- tInputs bbCtx + , let aTemplateType = [TypElem (Typ (Just 2))] + , let inst arg = instHO bbCtx 1 (aType, aTemplateType) [(arg, aTemplateType)] + = declarationReturn bbCtx "iterateI" (fmap pure . Prim.vec =<< iterateNM (fromInteger n) inst a) + | otherwise + = error $ "Unexpected number of arguments: " ++ show (length (bbInputs bbCtx)) + data FCall = FCall Identifier -- left @@ -65,13 +110,14 @@ let (d, r) = n `divMod` 2 in 1 + foldFunctionPlurality d + foldFunctionPlurality (d+r) +-- | Blackbox function for 'Clash.Sized.Vector.fold' foldBBF :: HasCallStack => BlackBoxFunction foldBBF _isD _primName args _resTy = do tcm <- Lens.use tcCache pure (Right (meta tcm, bb)) where bb = BBFunction "Clash.Primitives.Sized.Vector.foldTF" 0 foldTF - [_, vecLengthMinusOne] = rights args + [vecLengthMinusOne, _] = rights args vecLength tcm = case coreView tcm vecLengthMinusOne of (LitTy (NumTy n)) -> n + 1 @@ -90,15 +136,16 @@ foldTF' :: forall s . (HasCallStack, Backend s) => BlackBoxContext -> State s Doc foldTF' bbCtx@(bbInputs -> [_f, (vec, vecType@(Vector n aTy), _isLiteral)]) = do -- Create an id for every element in the vector - vecIds <- mapM (\i -> mkId ("acc_0_" <> show i)) [0..n-1] + baseId <- Id.make "acc_0" + vecIds <- replicateM n (Id.next baseId) - vecId <- mkId "vec" + vecId <- Id.make "vec" let vecDecl = sigDecl vecType Wire vecId vecAssign = Assignment vecId vec elemAssigns = zipWith Assignment vecIds (map (iIndex vecId) [0..]) resultId = - case bbResult bbCtx of - (Identifier t _, _) -> t + case bbResults bbCtx of + [(Identifier t _, _)] -> t _ -> error "Unexpected result identifier" -- Create a list of function calls to be made (creates identifiers for @@ -114,7 +161,7 @@ resultAssign = Assignment resultId (Identifier result Nothing) callDecls <- zipWithM callDecl [0..] fCalls - foldNm <- mkId "fold" + foldNm <- Id.make "fold" getMon $ blockDecl foldNm $ resultAssign : @@ -125,9 +172,6 @@ callDecls where - mkId :: String -> State s Identifier - mkId = mkUniqueIdentifier Basic . Text.pack - callDecl :: Int -> FCall -> State s Declaration callDecl fSubPos (FCall a b r) = do rendered0 <- string =<< (renderElem bbCtx call <*> pure 0) @@ -143,9 +187,9 @@ where call = Component (Decl fPos fSubPos (resEl:aEl:[bEl])) elTyp = [TypElem (Typ (Just vecPos))] - resEl = ([Text (LText.fromStrict r)], elTyp) - aEl = ([Text (LText.fromStrict a)], elTyp) - bEl = ([Text (LText.fromStrict b)], elTyp) + resEl = ([Text (Id.toLazyText r)], elTyp) + aEl = ([Text (Id.toLazyText a)], elTyp) + bEl = ([Text (Id.toLazyText b)], elTyp) -- Argument no. of function fPos = 0 @@ -176,7 +220,7 @@ -> [Identifier] -> State s ([FCall], [Identifier]) mkLevel (!lvl, !offset) (a:b:rest) = do - c <- mkId ("acc_" <> show lvl <> "_" <> show offset) + c <- Id.makeBasic ("acc_" <> showt lvl <> "_" <> showt offset) (calls, results) <- mkLevel (lvl, offset+1) rest pure (FCall a b c:calls, c:results) mkLevel _lvl rest = @@ -249,7 +293,7 @@ , (ix, _, _) ] = bbInputs bbCtx - (_,rTy) = bbResult bbCtx + [(_,rTy)] = bbResults bbCtx ixI :: Expr -> Int ixI ix0 = case ix0 of diff --git a/src/Clash/Primitives/Types.hs b/src/Clash/Primitives/Types.hs --- a/src/Clash/Primitives/Types.hs +++ b/src/Clash/Primitives/Types.hs @@ -86,8 +86,9 @@ map S.unpack $ S.splitOn sep str -- | Parses a string into a list of modules and a function name. I.e., it parses --- the string "Clash.Primitives.Types.parseBBFN" to ["Clash", "Primitives", --- "Types"] and "parseBBFN". The result is stored as a BlackBoxFunctionName. +-- the string 'Clash.Primitives.Types.parseBBFN' to +-- @["Clash", "Primitives",Types"]@ and @"parseBBFN"@. +-- The result is stored as a BlackBoxFunctionName. parseBBFN :: HasCallStack => String @@ -149,6 +150,9 @@ , renderVoid :: RenderVoid -- ^ Whether this primitive should be rendered when its result type is -- void. Defaults to 'NoRenderVoid'. + , multiResult :: Bool + -- ^ Wether this blackbox assigns its results to multiple variables. See + -- 'Clash.Normalize.Transformations.setupMultiResultPrim' , kind :: TemplateKind -- ^ Whether this results in an expression or a declaration , warning :: c @@ -157,7 +161,7 @@ -- synthesizable, but may also be used for other purposes. , outputReg :: Bool -- ^ Verilog only: whether the result should be a /reg/(@True@) or /wire/ - -- (@False@); when not specified in the /.json/ file, the value will default + -- (@False@); when not specified in the /.primitives/ file, the value will default -- to @False@ (i.e. /wire/). , libraries :: [a] -- ^ VHDL only: add /library/ declarations for the given names @@ -183,10 +187,10 @@ , includes :: [((S.Text,S.Text),b)] -- ^ Create files to be included with the generated primitive. The fields -- are ((name, extension), content), where content is a template of the file - -- Defaults to @[]@ when not specified in the /.json/ file - , resultName :: Maybe b + -- Defaults to @[]@ when not specified in the /.primitives/ file + , resultNames :: [b] -- ^ (Maybe) Control the generated name of the result - , resultInit :: Maybe b + , resultInits :: [b] -- ^ (Maybe) Control the initial/power-up value of the result , template :: b -- ^ Used to indiciate type of template (declaration or expression). Will be @@ -200,6 +204,9 @@ -- ^ Whether the primitive does any work, i.e. takes chip area , usedArguments :: UsedArguments -- ^ Arguments used by blackbox. Used to remove arguments during normalization. + , multiResult :: Bool + -- ^ Wether this blackbox assigns its results to multiple variables. See + -- 'Clash.Normalize.Transformations.setupMultiResultPrim' , functionName :: BlackBoxFunctionName , function :: d -- ^ Holds blackbox function and its hash, (Int, BlackBoxFunction), in a @@ -237,15 +244,17 @@ name' <- conVal .: "name" wf <- ((conVal .:? "workInfo" >>= maybe (pure Nothing) parseWorkInfo) .!= WorkVariable) fName <- conVal .: "templateFunction" + multiResult <- conVal .:? "multiResult" .!= False templ <- (Just . TInline <$> conVal .: "template") <|> (Just . TFile <$> conVal .: "file") <|> (pure Nothing) fName' <- either fail return (parseBBFN fName) - return (BlackBoxHaskell name' wf args fName' templ) + return (BlackBoxHaskell name' wf args multiResult fName' templ) "BlackBox" -> BlackBox <$> conVal .: "name" <*> (conVal .:? "workInfo" >>= maybe (pure Nothing) parseWorkInfo) .!= WorkVariable <*> conVal .:? "renderVoid" .!= NoRenderVoid + <*> conVal .:? "multiResult" .!= False <*> (conVal .: "kind" >>= parseTemplateKind) <*> conVal .:? "warning" <*> conVal .:? "outputReg" .!= False @@ -253,8 +262,8 @@ <*> conVal .:? "imports" .!= [] <*> pure [] -- functionPlurality not supported in json <*> (conVal .:? "includes" .!= [] >>= traverse parseInclude) - <*> (conVal .:? "resultName" >>= maybe (pure Nothing) parseResult) .!= Nothing - <*> (conVal .:? "resultInit" >>= maybe (pure Nothing) parseResult) .!= Nothing + <*> (conVal .:? "resultName" >>= maybe (pure Nothing) parseResult) .!= [] + <*> (conVal .:? "resultInit" >>= maybe (pure Nothing) parseResult) .!= [] <*> parseTemplate conVal "Primitive" -> Primitive <$> conVal .: "name" @@ -294,7 +303,7 @@ defTemplateFunction = BlackBoxFunctionName ["Template"] "template" parseResult (Object c) = - Just . Just <$> parseTemplate c + Just . pure <$> parseTemplate c parseResult e = fail $ "[7] unexpected result: " ++ show e parseJSON unexpected = diff --git a/src/Clash/Primitives/Util.hs b/src/Clash/Primitives/Util.hs --- a/src/Clash/Primitives/Util.hs +++ b/src/Clash/Primitives/Util.hs @@ -21,7 +21,6 @@ ) where import Control.DeepSeq (force) -import Control.Monad (join) import Data.Aeson.Extra (decodeOrErr) import qualified Data.ByteString.Lazy as LZ import qualified Data.HashMap.Lazy as HashMap @@ -39,8 +38,9 @@ import System.IO.Error (tryIOError) import Clash.Annotations.Primitive - ( PrimitiveGuard(HasBlackBox, WarnNonSynthesizable, WarnAlways, DontTranslate) - , extractPrim) + ( PrimitiveGuard(HasBlackBox, DontTranslate) + , PrimitiveWarning(WarnNonSynthesizable) + , extractPrim, extractWarnings) import Clash.Core.Term (Term) import Clash.Core.Type (Type) import Clash.Primitives.Types @@ -92,19 +92,19 @@ -> UnresolvedPrimitive -> IO (TS.Text, GuardedResolvedPrimitive) resolvePrimitive' _metaPath (Primitive name wf primType) = - return (name, HasBlackBox (Primitive name wf primType)) -resolvePrimitive' metaPath BlackBox{template=t, includes=i, resultName=r, resultInit=ri, ..} = do + return (name, HasBlackBox [] (Primitive name wf primType)) +resolvePrimitive' metaPath BlackBox{template=t, includes=i, resultNames=r, resultInits=ri, ..} = do let resolveSourceM = traverse (traverse (resolveTemplateSource metaPath)) - bb <- BlackBox name workInfo renderVoid kind () outputReg libraries imports functionPlurality + bb <- BlackBox name workInfo renderVoid multiResult kind () outputReg libraries imports functionPlurality <$> mapM (traverse resolveSourceM) i <*> traverse resolveSourceM r <*> traverse resolveSourceM ri <*> resolveSourceM t case warning of - Just w -> pure (name, WarnNonSynthesizable (TS.unpack w) bb) - Nothing -> pure (name, HasBlackBox bb) -resolvePrimitive' metaPath (BlackBoxHaskell bbName wf usedArgs funcName t) = - (bbName,) . HasBlackBox . BlackBoxHaskell bbName wf usedArgs funcName <$> + Just w -> pure (name, HasBlackBox [WarnNonSynthesizable (TS.unpack w)] bb) + Nothing -> pure (name, HasBlackBox [] bb) +resolvePrimitive' metaPath (BlackBoxHaskell bbName wf usedArgs multiRes funcName t) = + (bbName,) . HasBlackBox [] . BlackBoxHaskell bbName wf usedArgs multiRes funcName <$> (mapM (resolveTemplateSource metaPath) t) -- | Interprets contents of json file as list of @Primitive@s. Throws @@ -123,29 +123,29 @@ -> ResolvedPrimMap addGuards = foldl go where - lookupPrim :: TS.Text -> ResolvedPrimMap -> Maybe ResolvedPrimitive - lookupPrim nm primMap = join (extractPrim <$> HashMapStrict.lookup nm primMap) + lookupPrim + :: TS.Text + -> ResolvedPrimMap + -> Maybe ([PrimitiveWarning], ResolvedPrimitive) + lookupPrim nm primMap = do + guardedPrim <- HashMapStrict.lookup nm primMap + prim <- extractPrim guardedPrim + return (extractWarnings guardedPrim, prim) go primMap (nm, guard) = HashMapStrict.insert nm (case (lookupPrim nm primMap, guard) of - (Nothing, HasBlackBox _) -> + (Nothing, DontTranslate) -> DontTranslate + (Nothing, HasBlackBox _ ()) -> error $ "No BlackBox definition for '" ++ TS.unpack nm ++ "' even" ++ " though this value was annotated with 'HasBlackBox'." - (Nothing, WarnNonSynthesizable _ _) -> - error $ "No BlackBox definition for '" ++ TS.unpack nm ++ "' even" - ++ " though this value was annotated with 'WarnNonSynthesizable'" - ++ ", implying it has a BlackBox." - (Nothing, WarnAlways _ _) -> - error $ "No BlackBox definition for '" ++ TS.unpack nm ++ "' even" - ++ " though this value was annotated with 'WarnAlways'" - ++ ", implying it has a BlackBox." (Just _, DontTranslate) -> error (TS.unpack nm ++ " was annotated with DontTranslate, but a " - ++ "BlackBox definition was found anyway.") - (Nothing, DontTranslate) -> DontTranslate - (Just p, g) -> fmap (const p) g) + ++ "BlackBox definition was found anyway.") + (Just (ws1, p), HasBlackBox ws2 ()) -> + HasBlackBox (ws1 ++ ws2) p + ) primMap -- | Generate a set of primitives that are found in the primitive definition @@ -166,7 +166,7 @@ if fpExists then fmap ( map (FilePath.combine filePath) - . filter (isSuffixOf ".json") + . filter (isSuffixOf ".primitives") ) (Directory.getDirectoryContents filePath) else return [] @@ -181,9 +181,9 @@ -- | Determine what argument should be constant / literal constantArgs :: TS.Text -> CompiledPrimitive -> Set.Set Int -constantArgs nm BlackBox {template = templ@(BBTemplate _), resultInit = tRIM} = +constantArgs nm BlackBox {template = templ@(BBTemplate _), resultInits = tRIM} = Set.fromList (concat [ fromIntForce - , maybe [] walkTemplate tRIM + , concatMap walkTemplate tRIM , walkTemplate templ ]) where @@ -194,10 +194,10 @@ getConstant (Const i) = Just i getConstant _ = Nothing - -- Ensure that if the "Integer" arguments are constants, that they are reduced + -- Ensure that if the 'Integer' arguments are constants, that they are reduced -- to literals, so that the buildin rules can properly fire. -- - -- Only in the the case that "Integer" arguments are truly variables should + -- Only in the the case that 'Integer' arguments are truly variables should -- the blackbox rules fire. fromIntForce | nm == "Clash.Sized.Internal.BitVector.fromInteger#" = [2] @@ -234,16 +234,16 @@ => CompiledPrimitive -> [Either Term Type] -- ^ Arguments passed to blackbox - -> Type - -- ^ Result type + -> [Type] + -- ^ Result types -> Int -- ^ Argument number holding the function of interest -> NetlistMonad Int -- ^ Plurality of function. Defaults to 1. Does not err if argument isn't -- a function in the first place. State of monad will not be modified. -getFunctionPlurality (Primitive {}) _args _resTy _n = pure 1 -getFunctionPlurality (BlackBoxHaskell {name, function, functionName}) args resTy n = do - errOrMeta <- preserveState ((snd function) False name args resTy) +getFunctionPlurality (Primitive {}) _args _resTys _n = pure 1 +getFunctionPlurality (BlackBoxHaskell {name, function, functionName}) args resTys n = do + errOrMeta <- preserveState ((snd function) False name args resTys) case errOrMeta of Left err -> error $ concat [ "Tried to determine function plurality for " diff --git a/src/Clash/Primitives/Verification.hs b/src/Clash/Primitives/Verification.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Primitives/Verification.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Clash.Primitives.Verification (checkBBF) where + +import Data.Either + + +import qualified Control.Lens as Lens +import Control.Monad.State (State) +import Data.Text.Prettyprint.Doc.Extra (Doc) +import qualified Data.Text as Text +import Data.Semigroup.Monad (getMon) +import GHC.Stack (HasCallStack) + +import Clash.Annotations.Primitive (HDL(..)) +import Clash.Backend + (Backend, blockDecl, hdlKind) +import Clash.Core.Term (Term(Var)) +import Clash.Core.TermInfo (termType) +import Clash.Core.TermLiteral (termToDataError) +import Clash.Util (indexNote) +import Clash.Netlist (mkExpr) +import Clash.Netlist.Util (stripVoid) +import Clash.Netlist.Util (id2identifier) +import qualified Clash.Netlist.Id as Id +import Clash.Netlist.Types + (BlackBox(BBFunction), TemplateFunction(..), BlackBoxContext, Identifier, + NetlistMonad, Declaration(Assignment, NetDecl', TickDecl), + HWType(Bool, KnownDomain), WireOrReg(Wire), NetlistId(..), + DeclarationType(Concurrent), tcCache, bbInputs) +import Clash.Netlist.BlackBox.Types + (BlackBoxFunction, BlackBoxMeta(..), TemplateKind(TDecl), RenderVoid(..), + emptyBlackBoxMeta) + +import Clash.Verification.Internal +import Clash.Verification.PrettyPrinters + +checkBBF :: BlackBoxFunction +checkBBF _isD _primName args _ty = + case litArgs of + Left err -> pure (Left err) + Right (propName, renderAs, cvProperty0) -> do + cvProperty1 <- mapM (uncurry bindMaybe) cvProperty0 + let decls = concatMap snd cvProperty1 + cvProperty2 = fmap fst cvProperty1 + pure (Right (meta, bb (checkTF decls clkId propName renderAs cvProperty2))) + where + -- TODO: Improve error handling; currently errors don't indicate what + -- TODO: blackbox generated them. + (Var (id2identifier -> clkId)) = indexNote "clk" (lefts args) 1 + (Var (id2identifier -> _clkId)) = indexNote "rst" (lefts args) 2 + + litArgs = do + propName <- termToDataError (indexNote "propName" (lefts args) 3) + renderAs <- termToDataError (indexNote "renderAs" (lefts args) 4) + cvProperty <- termToDataError (indexNote "propArg" (lefts args) 5) + Right (propName, renderAs, cvProperty) + + bb = BBFunction "Clash.Primitives.Verification.checkTF" 0 + meta = emptyBlackBoxMeta {bbKind=TDecl, bbRenderVoid=RenderVoid} + + bindMaybe + :: Maybe String + -- ^ Hint for new identifier + -> Term + -- ^ Term to bind. Does not bind if it's already a reference to a signal + -> NetlistMonad (Identifier, [Declaration]) + -- ^ ([new] reference to signal, [declarations need to get it in scope]) + bindMaybe _ (Var vId) = pure (id2identifier vId, []) + bindMaybe Nothing t = bindMaybe (Just "s") t + bindMaybe (Just nm) t = do + tcm <- Lens.use tcCache + newId <- Id.make (Text.pack nm) + (expr0, decls) <- mkExpr False Concurrent (NetlistId newId (termType tcm t)) t + pure + ( newId + , decls ++ [sigDecl Bool newId, Assignment newId expr0] ) + + -- Simple wire without comment + sigDecl :: HWType -> Identifier -> Declaration + sigDecl typ nm = NetDecl' Nothing Wire nm (Right typ) Nothing + +checkTF + :: [Declaration] + -> Identifier + -> Text.Text + -> RenderAs + -> Property' Identifier + -> TemplateFunction +checkTF decls clkId propName renderAs prop = + TemplateFunction [] (const True) (checkTF' decls clkId propName renderAs prop) + +checkTF' + :: forall s + . (HasCallStack, Backend s) + => [Declaration] + -- ^ Extra decls needed + -> Identifier + -- ^ Clock + -> Text.Text + -- ^ Prop name + -> RenderAs + -> Property' Identifier + -> BlackBoxContext + -> State s Doc +checkTF' decls clkId propName renderAs prop bbCtx = do + blockName <- Id.makeBasic (propName <> "_block") + getMon (blockDecl blockName (TickDecl renderedPslProperty : decls)) + + where + hdl = hdlKind (undefined :: s) + + edge = + case head (bbInputs bbCtx) of + (_, stripVoid -> KnownDomain _nm _period e _rst _init _polarity, _) -> e + _ -> error $ "Unexpected first argument: " ++ show (head (bbInputs bbCtx)) + + renderedPslProperty + | renderAs == SVA || hdl == SystemVerilog = sva + | otherwise = psl + where + sva = pprSvaProperty propName (Id.toText clkId) edge (fmap Id.toText prop) + psl = pprPslProperty hdl propName (Id.toText clkId) edge (fmap Id.toText prop) diff --git a/src/Clash/Rewrite/Types.hs b/src/Clash/Rewrite/Types.hs --- a/src/Clash/Rewrite/Types.hs +++ b/src/Clash/Rewrite/Types.hs @@ -13,13 +13,14 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} module Clash.Rewrite.Types where import Control.Concurrent.Supply (Supply, freshId) import Control.DeepSeq (NFData) -import Control.Lens (use, (.=)) +import Control.Lens (Lens', use, (.=)) #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail(fail)) #endif @@ -35,7 +36,13 @@ import qualified Data.Set as Set import GHC.Generics -import Clash.Core.Evaluator.Types (PrimHeap, PrimStep, PrimUnwind) +#if EXPERIMENTAL_EVALUATOR +import Clash.Core.PartialEval (Evaluator) +import Clash.Core.PartialEval.NormalForm (Value) +#else +import Clash.Core.Evaluator.Types (Evaluator, PrimHeap) +#endif + import Clash.Core.Term (Term, Context) import Clash.Core.Type (Type) import Clash.Core.TyCon (TyConName, TyConMap) @@ -43,6 +50,7 @@ import Clash.Core.VarEnv (InScopeSet, VarSet, VarEnv) import Clash.Driver.Types (BindingMap, DebugLevel) import Clash.Netlist.Types (FilteredHWType, HWMap) +import Clash.Rewrite.WorkFree (isWorkFree) import Clash.Util import Clash.Annotations.BitRepresentation.Internal (CustomReprs) @@ -75,8 +83,15 @@ -- ^ Function which is currently normalized , _nameCounter :: {-# UNPACK #-} !Int -- ^ Used for 'Fresh' +#if EXPERIMENTAL_EVALUATOR + , _ioHeap :: IntMap Value + -- ^ Used as a heap for compile-time evaluation of primitives that live in I/O + , _ioAddr :: Int + -- ^ Next address to use for heap insertion. +#else , _globalHeap :: PrimHeap -- ^ Used as a heap for compile-time evaluation of primitives that live in I/O +#endif , _workFreeBinders :: VarEnv Bool -- ^ Map telling whether a binder's definition is work-free , _extra :: !extra @@ -96,6 +111,8 @@ -- ^ See ClashOpts.opt_dbgTransformationsFrom , _dbgTransformationsLimit :: Int -- ^ See ClashOpts.opt_dbgTransformationsLimit + , _dbgRewriteHistoryFile :: Maybe FilePath + -- ^ See ClashOpts.opt_dbgRewriteHistory , _aggressiveXOpt :: Bool -- ^ Transformations to print debugging info for , _typeTranslator :: CustomReprs @@ -107,12 +124,14 @@ -- ^ TyCon cache , _tupleTcCache :: IntMap TyConName -- ^ Tuple TyCon cache - , _evaluator :: (PrimStep, PrimUnwind) - -- ^ Hardcoded evaluator (delta-reduction)} + , _evaluator :: Evaluator + -- ^ Hardcoded evaluator for partial evaluation , _topEntities :: VarSet -- ^ Functions that are considered TopEntities , _customReprs :: CustomReprs -- ^ Custom bit representations + , _fuelLimit :: Word + -- ^ Maximum amount of fuel for the evaluator } makeLenses ''RewriteEnv @@ -210,3 +229,11 @@ -- | A 'Transform' action in the context of the 'RewriteMonad' type Rewrite extra = Transform (RewriteMonad extra) + +-- Moved into Clash.Rewrite.WorkFree +{-# SPECIALIZE isWorkFree + :: Lens' (RewriteState extra) (VarEnv Bool) + -> BindingMap + -> Term + -> RewriteMonad extra Bool + #-} diff --git a/src/Clash/Rewrite/Util.hs b/src/Clash/Rewrite/Util.hs --- a/src/Clash/Rewrite/Util.hs +++ b/src/Clash/Rewrite/Util.hs @@ -18,9 +18,11 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Clash.Rewrite.Util where +module Clash.Rewrite.Util + ( module Clash.Rewrite.Util + , module Clash.Rewrite.WorkFree + ) where -import Control.Monad.Extra (andM, eitherM) import Control.Concurrent.Supply (splitSupply) import Control.DeepSeq import Control.Exception (throw) @@ -40,10 +42,9 @@ import Data.List (group, partition, sort) import qualified Data.List as List import qualified Data.List.Extra as List -import Data.List.Extra (allM, partitionM) +import Data.List.Extra (partitionM) import qualified Data.Map as Map import Data.Maybe - (catMaybes, isJust, mapMaybe, fromMaybe) import qualified Data.Monoid as Monoid import qualified Data.Set as Set import qualified Data.Set.Lens as Lens @@ -52,21 +53,30 @@ import Data.Text (Text) import qualified Data.Text as Text -#ifdef HISTORY +import System.IO.Unsafe (unsafePerformIO) + import Data.Binary (encode) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL -import System.IO.Unsafe (unsafePerformIO) -#endif +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Basic (InlineSpec (..)) +#else import BasicTypes (InlineSpec (..)) +#endif import Clash.Core.DataCon (dcExtTyVars) -import Clash.Core.Evaluator (whnf') -import Clash.Core.Evaluator.Types (PureHeap) + +#if EXPERIMENTAL_EVALUATOR +import Clash.Core.PartialEval +import Clash.Core.PartialEval.NormalForm +#else +import Clash.Core.Evaluator.Types (PureHeap, whnf') +#endif + import Clash.Core.FreeVars - (freeLocalVars, hasLocalFreeVars, localIdDoesNotOccurIn, localIdOccursIn, - typeFreeVars, termFreeVars', freeLocalIds, globalIdOccursIn) + (freeLocalVars, localIdDoesNotOccurIn, localIdOccursIn, + typeFreeVars, termFreeVars', freeLocalIds) import Clash.Core.Name import Clash.Core.Pretty (showPpr) import Clash.Core.Subst @@ -78,21 +88,22 @@ import Clash.Core.Type (KindOrType, Type (..), TypeView (..), coreView1, normalizeType, - typeKind, tyView, isPolyFunTy) + typeKind, tyView) import Clash.Core.Util - (dataConInstArgTysE, isClockOrReset, isEnable) + (dataConInstArgTysE) import Clash.Core.Var - (Id, IdScope (..), TyVar, Var (..), isLocalId, mkGlobalId, mkLocalId, mkTyVar) + (Id, IdScope (..), TyVar, Var (..), mkGlobalId, mkLocalId, mkTyVar) import Clash.Core.VarEnv (InScopeSet, VarEnv, elemVarSet, extendInScopeSetList, mkInScopeSet, uniqAway, uniqAway', mapVarEnv, eltsVarEnv, unitVarSet, emptyVarEnv, mkVarEnv, eltsVarSet, elemVarEnv, lookupVarEnv, extendVarEnv) import Clash.Debug import Clash.Driver.Types - (DebugLevel (..), BindingMap, Binding(..)) + (DebugLevel (..), BindingMap, Binding(..), IsPrim(..)) import Clash.Netlist.Util (representableType) import Clash.Pretty (clashPretty, showDoc) import Clash.Rewrite.Types +import Clash.Rewrite.WorkFree import Clash.Unique import Clash.Util import qualified Clash.Util.Interpolate as I @@ -160,12 +171,13 @@ let hasChanged = Monoid.getAny anyChanged !expr2 = if hasChanged then expr1 else expr0 Monad.when hasChanged (transformCounter += 1) -#ifdef HISTORY - -- NB: When HISTORY is on, emit binary data holding the recorded rewrite steps - Monad.when hasChanged $ do + + -- NB: When -fclash-debug-history is on, emit binary data holding the recorded rewrite steps + rewriteHistFile <- Lens.view dbgRewriteHistoryFile + Monad.when (isJust rewriteHistFile && hasChanged) $ do (curBndr, _) <- Lens.use curFun let !_ = unsafePerformIO - $ BS.appendFile "history.dat" + $ BS.appendFile (fromJust rewriteHistFile) $ BL.toStrict $ encode RewriteStep { t_ctx = tfContext ctx @@ -175,7 +187,6 @@ , t_after = expr1 } return () -#endif dbgFrom <- Lens.view dbgTransformationsFrom dbgLimit <- Lens.view dbgTransformationsLimit @@ -256,7 +267,7 @@ , "substitution." ]) - traceIf (lvl >= DebugApplied && (not (beforeTy `aeqType` afterTy))) + traceIf (lvl >= DebugApplied && (not (normalizeType tcm beforeTy `aeqType` normalizeType tcm afterTy))) ( concat [ $(curLoc) , "Error when applying rewrite ", name , " to:\n" , before @@ -298,7 +309,7 @@ -> RewriteMonad extra a -> a runRewriteSession r s m = - traceIf (_dbgLevel r > DebugNone) + traceIf (_dbgLevel r > DebugSilent) ("Clash: Applied " ++ show (s' ^. transformCounter) ++ " transformations") a where @@ -522,52 +533,6 @@ else go subst2 inl --- | Determines whether a global binder is work free. Errors if binder does --- not exist. -isWorkFreeBinder :: HasCallStack => Id -> RewriteMonad extra Bool -isWorkFreeBinder bndr = - makeCachedU bndr workFreeBinders $ do - bExprM <- lookupVarEnv bndr <$> Lens.use bindings - case bExprM of - Nothing -> error ("isWorkFreeBinder: couldn't find binder: " ++ showPpr bndr) - Just (bindingTerm -> t) -> - if bndr `globalIdOccursIn` t - then pure False - else isWorkFree t - --- | Determine whether a term does any work, i.e. adds to the size of the circuit -isWorkFree - :: Term - -> RewriteMonad extra Bool -isWorkFree (collectArgs -> (fun,args)) = case fun of - Var i -> - if | isPolyFunTy (varType i) -> pure False - | isLocalId i -> pure True - | otherwise -> andM [isWorkFreeBinder i, allM isWorkFreeArg args] - Data {} -> allM isWorkFreeArg args - Literal {} -> pure True - Prim pInfo -> case primWorkInfo pInfo of - -- We can ignore the arguments, because this primitive outputs a constant - -- regardless of its arguments - WorkConstant -> pure True - WorkNever -> allM isWorkFreeArg args - WorkVariable -> pure (all isConstantArg args) - -- Things like clock or reset generator always perform work - WorkAlways -> pure False - Lam _ e -> andM [isWorkFree e, allM isWorkFreeArg args] - TyLam _ e -> andM [isWorkFree e, allM isWorkFreeArg args] - Letrec bs e -> - andM [isWorkFree e, allM (isWorkFree . snd) bs, allM isWorkFreeArg args] - Case s _ [(_,a)] -> - andM [isWorkFree s, isWorkFree a, allM isWorkFreeArg args] - Cast e _ _ -> - andM [isWorkFree e, allM isWorkFreeArg args] - _ -> - pure False - where - isWorkFreeArg e = eitherM isWorkFree (pure . const True) (pure e) - isConstantArg = either isConstant (const True) - isFromInt :: Text -> Bool isFromInt nm = nm == "Clash.Sized.Internal.BitVector.fromInteger##" || nm == "Clash.Sized.Internal.BitVector.fromInteger#" || @@ -575,78 +540,6 @@ nm == "Clash.Sized.Internal.Signed.fromInteger#" || nm == "Clash.Sized.Internal.Unsigned.fromInteger#" --- | Determine if a term represents a constant -isConstant :: Term -> Bool -isConstant e = case collectArgs e of - (Data _, args) -> all (either isConstant (const True)) args - (Prim _, args) -> all (either isConstant (const True)) args - (Lam _ _, _) -> not (hasLocalFreeVars e) - (Literal _,_) -> True - _ -> False - -isConstantNotClockReset - :: Term - -> RewriteMonad extra Bool -isConstantNotClockReset e = do - tcm <- Lens.view tcCache - let eTy = termType tcm e - if isClockOrReset tcm eTy - then case collectArgs e of - (Prim p,_) -> return (primName p == "Clash.Transformations.removedArg") - _ -> return False - else pure (isConstant e) - --- TODO: Remove function after using WorkInfo in 'isWorkFreeIsh' -isWorkFreeClockOrResetOrEnable - :: TyConMap - -> Term - -> Maybe Bool -isWorkFreeClockOrResetOrEnable tcm e = - let eTy = termType tcm e in - if isClockOrReset tcm eTy || isEnable tcm eTy then - case collectArgs e of - (Prim p,_) -> Just (primName p == "Clash.Transformations.removedArg") - (Var _, []) -> Just True - (Data _, []) -> Just True -- For Enable True/False - (Literal _,_) -> Just True - _ -> Just False - else - Nothing - --- | A conservative version of 'isWorkFree'. Is used to determine in 'bindConstantVar' --- to determine whether an expression can be "bound" (locally inlined). While --- binding workfree expressions won't result in extra work for the circuit, it --- might very well cause extra work for Clash. In fact, using 'isWorkFree' in --- 'bindConstantVar' makes Clash two orders of magnitude slower for some of our --- test cases. --- --- In effect, this function is a version of 'isConstant' that also considers --- references to clocks and resets constant. This allows us to bind --- HiddenClock(ResetEnable) constructs, allowing Clash to constant spec --- subconstants - most notably KnownDomain. Doing that enables Clash to --- eliminate any case-constructs on it. -isWorkFreeIsh - :: Term - -> RewriteMonad extra Bool -isWorkFreeIsh e = do - tcm <- Lens.view tcCache - case isWorkFreeClockOrResetOrEnable tcm e of - Just b -> pure b - Nothing -> - case collectArgs e of - (Data _, args) -> allM isWorkFreeIshArg args - (Prim pInfo, args) -> case primWorkInfo pInfo of - WorkAlways -> pure False -- Things like clock or reset generator always - -- perform work - WorkVariable -> pure (all isConstantArg args) - _ -> allM isWorkFreeIshArg args - (Lam _ _, _) -> pure (not (hasLocalFreeVars e)) - (Literal _,_) -> pure True - _ -> pure False - where - isWorkFreeIshArg = either isWorkFreeIsh (pure . const True) - isConstantArg = either isConstant (const True) - inlineOrLiftBinders :: (LetBinding -> RewriteMonad extra Bool) -- ^ Property test @@ -746,6 +639,7 @@ #else EmptyInlineSpec #endif + IsFun newBody) -- Return the new binder return (var, newExpr) @@ -795,7 +689,7 @@ -> RewriteMonad extra () addGlobalBind vNm ty sp inl body = do let vId = mkGlobalId ty vNm - (ty,body) `deepseq` bindings %= extendUniqMap vNm (Binding vId sp inl body) + (ty,body) `deepseq` bindings %= extendUniqMap vNm (Binding vId sp inl IsFun body) -- | Create a new name out of the given name, but with another unique. Resulting -- unique is guaranteed to not be in the given InScopeSet. @@ -953,7 +847,7 @@ -- Determine if we can specialize f bodyMaybe <- fmap (lookupUniqMap (varName f)) $ Lens.use bindings case bodyMaybe of - Just (Binding _ sp inl bodyTm) -> do + Just (Binding _ sp inl _ bodyTm) -> do -- Determine if we see a sequence of specialisations on a growing argument specHistM <- lookupUniqMap f <$> Lens.use (extra.specHistLbl) specLim <- Lens.use (extra . specLimitLbl) @@ -1022,6 +916,7 @@ bs' -> init bs' ++ bs go bs _ = bs +-- Specialising non Var's is used by nonRepANF specialise' _ _ _ _ctx _ (appE,args,ticks) (Left specArg) = do -- Create binders and variable references for free variables in 'specArg' let (specBndrs,specVars) = specArgBndrsAndVars (Left specArg) @@ -1121,17 +1016,36 @@ whnfRW isSubj ctx@(TransformContext is0 _) e rw = do tcm <- Lens.view tcCache bndrs <- Lens.use bindings - (primEval, primUnwind) <- Lens.view evaluator + eval <- Lens.view evaluator ids <- Lens.use uniqSupply let (ids1,ids2) = splitSupply ids uniqSupply Lens..= ids2 + +#if EXPERIMENTAL_EVALUATOR + (i, _) <- Lens.use curFun + heap <- Lens.use ioHeap + addr <- Lens.use ioAddr + fuel <- Lens.view fuelLimit + let genv = mkGlobalEnv bndrs tcm is0 ids1 fuel heap addr + + case unsafePerformIO (nf eval genv isSubj i e) of + (!e', !genv') -> do + ioHeap Lens..= genvHeap genv' + ioAddr Lens..= genvAddr genv' + + -- TODO I remain unsure about this. Do I want to use bindPureHeap? + rw (ctx { tfInScope = genvInScope genv' }) e' +#else gh <- Lens.use globalHeap - case whnf' primEval primUnwind bndrs tcm gh ids1 is0 isSubj e of + + case whnf' eval bndrs tcm gh ids1 is0 isSubj e of (!gh1,ph,v) -> do globalHeap Lens..= gh1 bindPureHeap tcm ph rw ctx v +#endif {-# SCC whnfRW #-} +#if !EXPERIMENTAL_EVALUATOR -- | Binds variables on the PureHeap over the result of the rewrite -- -- To prevent unnecessary rewrites only do this when rewrite changed something. @@ -1167,7 +1081,8 @@ -- -- † https://github.com/clash-lang/clash-compiler/pull/1354#issuecomment-635430374 -- ‡ https://www.microsoft.com/en-us/research/wp-content/uploads/2016/07/supercomp-by-eval.pdf - inlineBinders inlineTest ctx0 (Letrec bndrs e1) >>= \case + bs <- Lens.use bindings + inlineBinders (inlineTest bs) ctx0 (Letrec bndrs e1) >>= \case e2@(Letrec bnders1 e3) -> pure (fromMaybe e2 (removeUnusedBinders bnders1 e3)) e2 -> @@ -1175,23 +1090,20 @@ else return e1 where - bndrs = map toLetBinding $ toListUniqMap heap heapIds = map fst bndrs is1 = extendInScopeSetList is0 heapIds ctx = TransformContext is1 (LetBody heapIds : hist) + bndrs = map toLetBinding $ toListUniqMap heap + toLetBinding :: (Unique,Term) -> LetBinding toLetBinding (uniq,term) = (nm, term) where ty = termType tcm term nm = mkLocalId ty (mkUnsafeSystemName "x" uniq) -- See [Note: Name re-creation] - inlineTest _ (i, stripTicks -> e_) = - if isLocalVar e_ then - -- Don't inline `let x = x in x`, it throws us in an infinite loop - pure (i `localIdDoesNotOccurIn` e_) - else - isWorkFree e_ + inlineTest bs _ (_, stripTicks -> e_) = isWorkFree workFreeBinders bs e_ +#endif -- | Remove unused binders in given let-binding. Returns /Nothing/ if no unused -- binders were found. diff --git a/src/Clash/Rewrite/WorkFree.hs b/src/Clash/Rewrite/WorkFree.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Rewrite/WorkFree.hs @@ -0,0 +1,192 @@ +{-| +Copyright : (C) 2020, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +Check whether a term is work free or not. This is used by transformations / +evaluation to check whether it is possible to perform changes without +duplicating work in the result, e.g. inlining. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Clash.Rewrite.WorkFree + ( isWorkFree + , isWorkFreeClockOrResetOrEnable + , isWorkFreeIsh + , isConstant + , isConstantNotClockReset + ) where + +import Control.Lens (Lens') +import Control.Monad.Extra (allM, andM, eitherM) +import Control.Monad.State.Class (MonadState) +import GHC.Stack (HasCallStack) + +import Clash.Core.FreeVars +import Clash.Core.Pretty (showPpr) +import Clash.Core.Term +import Clash.Core.TermInfo +import Clash.Core.TyCon (TyConMap) +import Clash.Core.Type (isPolyFunTy) +import Clash.Core.Util +import Clash.Core.Var (Id, Var(..), isLocalId) +import Clash.Core.VarEnv (VarEnv, lookupVarEnv) +import Clash.Driver.Types (BindingMap, Binding(..)) +import Clash.Util (makeCachedU) + +-- | Determines whether a global binder is work free. Errors if binder does +-- not exist. +isWorkFreeBinder + :: (HasCallStack, MonadState s m) + => Lens' s (VarEnv Bool) + -> BindingMap + -> Id + -> m Bool +isWorkFreeBinder cache bndrs bndr = + makeCachedU bndr cache $ + case lookupVarEnv bndr bndrs of + Nothing -> error ("isWorkFreeBinder: couldn't find binder: " ++ showPpr bndr) + Just (bindingTerm -> t) -> + if bndr `globalIdOccursIn` t + then pure False + else isWorkFree cache bndrs t + +{-# INLINABLE isWorkFree #-} +-- | Determine whether a term does any work, i.e. adds to the size of the +-- circuit. This function requires a cache (specified as a lens) to store the +-- result for querying work info of global binders. +-- +isWorkFree + :: forall s m + . (HasCallStack, MonadState s m) + => Lens' s (VarEnv Bool) + -> BindingMap + -> Term + -> m Bool +isWorkFree cache bndrs = go True + where + -- If we are in the outermost level of a term (i.e. not checking a subterm) + -- then a term is work free if it simply refers to a local variable. This + -- does not apply to subterms, as we do not want to count expressions like + -- + -- f[LocalId] x[LocalId] + -- + -- as being work free, as the term bound to f may introduce work. + -- + go :: HasCallStack => Bool -> Term -> m Bool + go isOutermost (collectArgs -> (fun, args)) = + case fun of + Var i + -- We only allow polymorphic / function typed variables to be inlined + -- if they are locally scoped, and the term is only a variable. + -- + -- TODO This could be improved later by passing an InScopeSet to + -- isWorkFree with all the local FVs of the term being checked. PE + -- would need to be changed to know the FVs of global binders first. + -- + | isPolyFunTy (varType i) -> + pure (isLocalId i && isOutermost && null args) + | isLocalId i -> + pure True + | otherwise -> + andM [isWorkFreeBinder cache bndrs i, allM goArg args] + + Data _ -> allM goArg args + Literal _ -> pure True + Prim pr -> + case primWorkInfo pr of + -- We can ignore arguments because the primitive outputs a constant + -- regardless of their values. + WorkConstant -> pure True + WorkNever -> allM goArg args + WorkVariable -> pure (all isConstantArg args) + WorkAlways -> pure False + + Lam _ e -> andM [go False e, allM goArg args] + TyLam _ e -> andM [go False e, allM goArg args] + Letrec bs e -> andM [go False e, allM (go False . snd) bs, allM goArg args] + Case s _ [(_, a)] -> andM [go False s, go False a, allM goArg args] + Case e _ _ -> andM [go False e, allM goArg args] + Cast e _ _ -> andM [go False e, allM goArg args] + + -- (Ty)App's and Ticks are removed by collectArgs + Tick _ _ -> error "isWorkFree: unexpected Tick" + App {} -> error "isWorkFree: unexpected App" + TyApp {} -> error "isWorkFree: unexpected TyApp" + + goArg e = eitherM (go False) (pure . const True) (pure e) + isConstantArg = either isConstant (const True) + +-- | Determine if a term represents a constant +isConstant :: Term -> Bool +isConstant e = case collectArgs e of + (Data _, args) -> all (either isConstant (const True)) args + (Prim _, args) -> all (either isConstant (const True)) args + (Lam _ _, _) -> not (hasLocalFreeVars e) + (Literal _,_) -> True + _ -> False + +isConstantNotClockReset :: TyConMap -> Term -> Bool +isConstantNotClockReset tcm e + | isClockOrReset tcm eTy = + case fst (collectArgs e) of + Prim pr -> primName pr == "Clash.Transformations.removedArg" + _ -> False + + | otherwise = isConstant e + where + eTy = termType tcm e + +-- TODO: Remove function after using WorkInfo in 'isWorkFreeIsh' +isWorkFreeClockOrResetOrEnable + :: TyConMap + -> Term + -> Maybe Bool +isWorkFreeClockOrResetOrEnable tcm e = + let eTy = termType tcm e in + if isClockOrReset tcm eTy || isEnable tcm eTy then + case collectArgs e of + (Prim p,_) -> Just (primName p == "Clash.Transformations.removedArg") + (Var _, []) -> Just True + (Data _, []) -> Just True -- For Enable True/False + (Literal _,_) -> Just True + _ -> Just False + else + Nothing + +-- | A conservative version of 'isWorkFree'. Is used to determine in 'bindConstantVar' +-- to determine whether an expression can be "bound" (locally inlined). While +-- binding workfree expressions won't result in extra work for the circuit, it +-- might very well cause extra work for Clash. In fact, using 'isWorkFree' in +-- 'bindConstantVar' makes Clash two orders of magnitude slower for some of our +-- test cases. +-- +-- In effect, this function is a version of 'isConstant' that also considers +-- references to clocks and resets constant. This allows us to bind +-- HiddenClock(ResetEnable) constructs, allowing Clash to constant spec +-- subconstants - most notably KnownDomain. Doing that enables Clash to +-- eliminate any case-constructs on it. +isWorkFreeIsh + :: TyConMap + -> Term + -> Bool +isWorkFreeIsh tcm e = + case isWorkFreeClockOrResetOrEnable tcm e of + Just b -> b + Nothing -> + case collectArgs e of + (Data _, args) -> all isWorkFreeIshArg args + (Prim pInfo, args) -> case primWorkInfo pInfo of + WorkAlways -> False -- Things like clock or reset generator always + -- perform work + WorkVariable -> all isConstantArg args + _ -> all isWorkFreeIshArg args + + (Lam _ _, _) -> not (hasLocalFreeVars e) + (Literal _,_) -> True + _ -> False + where + isWorkFreeIshArg = either (isWorkFreeIsh tcm) (const True) + isConstantArg = either isConstant (const True) diff --git a/src/Clash/Unique.hs b/src/Clash/Unique.hs --- a/src/Clash/Unique.hs +++ b/src/Clash/Unique.hs @@ -315,7 +315,7 @@ -- -- Invariant: they keys in the map are the uniques of the values newtype UniqSet a = UniqSet (IntMap a) - deriving (Foldable, Semigroup, Monoid, Binary) + deriving (Foldable, Semigroup, Monoid, NFData, Binary) instance ClashPretty a => ClashPretty (UniqSet a) where clashPretty (UniqSet env) = diff --git a/src/Clash/Util.hs b/src/Clash/Util.hs --- a/src/Clash/Util.hs +++ b/src/Clash/Util.hs @@ -36,6 +36,8 @@ import qualified Data.HashMap.Lazy as HashMapL import qualified Data.List.Extra as List import Data.Maybe (fromMaybe, listToMaybe, catMaybes) +import Data.Map.Ordered (OMap) +import qualified Data.Map.Ordered as OMap import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.String import Data.Time.Clock (UTCTime) @@ -50,7 +52,11 @@ import Type.Reflection (tyConPackage, typeRepTyCon, typeOf) import qualified Language.Haskell.TH as TH +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (SrcSpan, noSrcSpan) +#else import SrcLoc (SrcSpan, noSrcSpan) +#endif import Clash.Debug import Clash.Unique @@ -180,6 +186,25 @@ l %= extendUniqMap key value return value +-- | Cache the result of a monadic action using a 'OMap' +makeCachedO + :: (MonadState s m, Uniquable k) + => k + -- ^ Key the action is associated with + -> Lens' s (OMap Unique v) + -- ^ Lens to the cache + -> m v + -- ^ Action to cache + -> m v +makeCachedO key l create = do + cache <- use l + case OMap.lookup (getUnique key) cache of + Just value -> return value + Nothing -> do + value <- create + l %= (flip (OMap.|>)) (getUnique key, value) + return value + combineM :: (Applicative f) => (a -> f b) -> (c -> f d) @@ -301,11 +326,9 @@ unwantedLanguageExtensions :: [LangExt.Extension] unwantedLanguageExtensions = [ LangExt.ImplicitPrelude - , LangExt.MonomorphismRestriction #if MIN_VERSION_ghc(8,6,0) , LangExt.StarIsType #endif , LangExt.Strict , LangExt.StrictData ] - diff --git a/src/Clash/Util/Graph.hs b/src/Clash/Util/Graph.hs --- a/src/Clash/Util/Graph.hs +++ b/src/Clash/Util/Graph.hs @@ -6,13 +6,23 @@ Collection of utilities -} -module Clash.Util.Graph (topSort, reverseTopSort) where +module Clash.Util.Graph + ( topSort + , reverseTopSort + , callGraphBindings + ) where import Data.Tuple (swap) import Data.Foldable (foldlM) import qualified Data.IntMap.Strict as IntMap import qualified Data.IntSet as IntSet +import Clash.Core.Var (Id) +import Clash.Core.Term (Term) +import Clash.Driver.Types (BindingMap, Binding (bindingTerm)) +import Clash.Unique (lookupUniqMap', keysUniqMap) +import Clash.Normalize.Util (callGraph) + data Marker = Temporary | Permanent @@ -126,3 +136,15 @@ -- ^ Reversely, topologically sorted nodes reverseTopSort nodes edges = topSort nodes (map swap edges) + +-- | Get all the terms corresponding to a call graph +callGraphBindings + :: BindingMap + -- ^ All bindings + -> Id + -- ^ Root of the call graph + -> [Term] +callGraphBindings bindingsMap tm = + map (bindingTerm . (bindingsMap `lookupUniqMap'`)) (keysUniqMap cg) + where + cg = callGraph bindingsMap tm diff --git a/src/Clash/Util/Interpolate.hs b/src/Clash/Util/Interpolate.hs --- a/src/Clash/Util/Interpolate.hs +++ b/src/Clash/Util/Interpolate.hs @@ -42,7 +42,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} -module Clash.Util.Interpolate(i) where +-- TODO: only export the @i@ quasiquotor when `ghcide` stop type-checking +-- exanded quasiquote splices +module Clash.Util.Interpolate (i, format, toString) where import Language.Haskell.Meta.Parse (parseExp) import Language.Haskell.TH.Lib (appE, varE) diff --git a/src/Control/Applicative/Extra.hs b/src/Control/Applicative/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Control/Applicative/Extra.hs @@ -0,0 +1,18 @@ +{-| + Copyright : (C) 2020, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. +-} + +module Control.Applicative.Extra + ( orEmpty + , emptyIf + ) where + +import Control.Applicative (Alternative, empty) + +orEmpty :: Alternative f => Bool -> a -> f a +orEmpty b a = if b then pure a else empty + +emptyIf :: Alternative f => a -> Bool -> f a +emptyIf a b = if b then empty else pure a diff --git a/src/Data/Aeson/Extra.hs b/src/Data/Aeson/Extra.hs --- a/src/Data/Aeson/Extra.hs +++ b/src/Data/Aeson/Extra.hs @@ -4,6 +4,7 @@ Maintainer : Christiaan Baaij -} +{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} @@ -30,8 +31,13 @@ import qualified Clash.Util.Interpolate as I import Clash.Util (ClashException(..)) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (mkGeneralSrcSpan) +import GHC.Data.FastString (mkFastString) +#else import SrcLoc (mkGeneralSrcSpan) import FastString (mkFastString) +#endif import GHC.Stack (HasCallStack) -- | See 'toSpecNewlines'. A line map maps "virtual" lines to a range of diff --git a/src/Data/List/Extra.hs b/src/Data/List/Extra.hs --- a/src/Data/List/Extra.hs +++ b/src/Data/List/Extra.hs @@ -4,6 +4,7 @@ module Data.List.Extra ( partitionM , mapAccumLM + , iterateNM , (<:>) , indexMaybe , splitAtList @@ -41,6 +42,26 @@ (acc',y) <- f acc x (acc'',ys) <- mapAccumLM f acc' xs return (acc'',y:ys) + +-- | Monadic version of 'iterate'. A carbon copy ('iterateM') would not +-- terminate, hence the first argument. +iterateNM + :: Monad m + => Word + -- ^ Only iterate /n/ times. Note that /n/ is the length of the resulting + -- list, _not_ the number of times the iteration function has been invoked + -> (a -> m a) + -- ^ Iteration function + -> a + -- ^ Start value + -> m [a] +iterateNM 0 _f _a = pure [] +iterateNM limit f a = fmap (a:) (go (limit - 1) a) + where + go 0 _a0 = pure [] + go n a0 = do + a1 <- f a0 + fmap (a1:) (go (n - 1) a1) infixr 5 <:> -- | Applicative version of 'GHC.Types.(:)' diff --git a/src/Data/Map/Ordered/Extra.hs b/src/Data/Map/Ordered/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Data/Map/Ordered/Extra.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Map.Ordered.Extra where + +import Control.DeepSeq (NFData(rnf)) +import Data.Map.Ordered (OMap) +import qualified Data.Map.Ordered as OMap + +instance (NFData k, NFData v) => NFData (OMap k v) where + rnf = rnf . OMap.assocs diff --git a/src/Data/Primitive/ByteArray/Extra.hs b/src/Data/Primitive/ByteArray/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Data/Primitive/ByteArray/Extra.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Primitive.ByteArray.Extra where + +#if !MIN_VERSION_primitive(0,7,1) +import Control.DeepSeq (NFData(..)) +#endif +import Data.Binary (Binary(..)) +import Data.Hashable (Hashable(..)) +import Data.Primitive.ByteArray (ByteArray) +import GHC.Exts (IsList(..)) + +#if !MIN_VERSION_primitive(0,7,1) +instance NFData ByteArray where + rnf x = x `seq` () +#endif + +instance Binary ByteArray where + get = fmap fromList get + put = put . toList + +instance Hashable ByteArray where + hashWithSalt salt = hashWithSalt salt . toList + diff --git a/src/Data/Text/Prettyprint/Doc/Extra.hs b/src/Data/Text/Prettyprint/Doc/Extra.hs --- a/src/Data/Text/Prettyprint/Doc/Extra.hs +++ b/src/Data/Text/Prettyprint/Doc/Extra.hs @@ -46,7 +46,7 @@ renderOneLine :: PP.Doc ann -> LT.Text -renderOneLine = renderLazy . layoutOneLine +renderOneLine = renderLazy . layoutPretty defaultLayoutOptions int :: Applicative f => Int -> f Doc int = pure . PP.pretty @@ -123,6 +123,9 @@ encloseSep :: Applicative f => f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc encloseSep l r s is = PP.encloseSep <$> l <*> r <*> s <*> is + +enclose :: Applicative f => f Doc -> f Doc -> f Doc -> f Doc +enclose = liftA3 PP.enclose line :: Applicative f => f Doc line = pure PP.line diff --git a/src/Data/Vector/Primitive/Extra.hs b/src/Data/Vector/Primitive/Extra.hs deleted file mode 100644 --- a/src/Data/Vector/Primitive/Extra.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} - -module Data.Vector.Primitive.Extra - (module Data.Vector.Primitive - ) -where - -import Data.Hashable -import Data.Vector.Primitive -import Data.Primitive.ByteArray - -instance Hashable (Vector a) where - hashWithSalt salt (Vector off len (ByteArray ba)) = - hashByteArrayWithSalt ba off len salt diff --git a/src/GHC/BasicTypes/Extra.hs b/src/GHC/BasicTypes/Extra.hs --- a/src/GHC/BasicTypes/Extra.hs +++ b/src/GHC/BasicTypes/Extra.hs @@ -4,11 +4,16 @@ Maintainer : Christiaan Baaij -} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module GHC.BasicTypes.Extra where +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Basic +#else import BasicTypes +#endif import Control.DeepSeq import Data.Binary import GHC.Generics diff --git a/src/GHC/SrcLoc/Extra.hs b/src/GHC/SrcLoc/Extra.hs --- a/src/GHC/SrcLoc/Extra.hs +++ b/src/GHC/SrcLoc/Extra.hs @@ -4,6 +4,7 @@ Maintainer : Christiaan Baaij -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-} @@ -14,6 +15,15 @@ import Data.Binary import Data.Hashable (Hashable (..)) import GHC.Generics +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc + (SrcSpan (..), RealSrcLoc, RealSrcSpan, BufSpan (..), BufPos (..), UnhelpfulSpanReason (..), + mkRealSrcLoc, mkRealSrcSpan, + realSrcSpanStart, realSrcSpanEnd, + srcLocFile, srcLocLine, srcLocCol, + srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol) +import GHC.Data.FastString (FastString (..), bytesFS, mkFastStringByteList) +#else import SrcLoc (SrcSpan (..), RealSrcLoc, RealSrcSpan, mkRealSrcLoc, mkRealSrcSpan, @@ -21,6 +31,7 @@ srcLocFile, srcLocLine, srcLocCol, srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol) import FastString (FastString (..), bytesFS, mkFastStringByteList) +#endif deriving instance Generic SrcSpan instance Hashable SrcSpan @@ -45,3 +56,17 @@ instance Binary FastString where put str = put $ bytesFS str get = mkFastStringByteList <$> get + +#if MIN_VERSION_ghc(9,0,0) +deriving instance Generic BufPos +instance Binary BufPos +instance Hashable BufPos + +deriving instance Generic UnhelpfulSpanReason +instance Binary UnhelpfulSpanReason +instance Hashable UnhelpfulSpanReason + +deriving instance Generic BufSpan +instance Binary BufSpan +instance Hashable BufSpan +#endif diff --git a/tests/Clash/Tests/Core/FreeVars.hs b/tests/Clash/Tests/Core/FreeVars.hs --- a/tests/Clash/Tests/Core/FreeVars.hs +++ b/tests/Clash/Tests/Core/FreeVars.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Clash.Tests.Core.FreeVars (tests) where +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (noSrcSpan) +#else import SrcLoc (noSrcSpan) +#endif import qualified Control.Lens as Lens import Test.Tasty diff --git a/tests/Clash/Tests/Core/Subst.hs b/tests/Clash/Tests/Core/Subst.hs --- a/tests/Clash/Tests/Core/Subst.hs +++ b/tests/Clash/Tests/Core/Subst.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Clash.Tests.Core.Subst (tests) where +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.SrcLoc (noSrcSpan) +#else import SrcLoc (noSrcSpan) +#endif import Test.Tasty import Test.Tasty.HUnit diff --git a/tests/Clash/Tests/Driver/Manifest.hs b/tests/Clash/Tests/Driver/Manifest.hs new file mode 100644 --- /dev/null +++ b/tests/Clash/Tests/Driver/Manifest.hs @@ -0,0 +1,92 @@ +module Clash.Tests.Driver.Manifest where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Lazy as LazyByteString +import Data.Coerce (coerce) +import Data.Text (Text) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +import Test.Tasty + +import qualified Test.Tasty.QuickCheck as Q +import qualified Test.QuickCheck.Utf8 as Q + +import Clash.Driver.Manifest +import Clash.Explicit.Signal + +import Debug.Trace + +newtype ArbitraryText = ArbitraryText Text deriving (Show) +newtype ArbitraryManifest = ArbitraryManifest Manifest deriving (Show) + +instance Q.Arbitrary ArbitraryText where + arbitrary = coerce Q.genValidUtf8 + shrink = coerce Q.shrinkValidUtf8 + +genDigest :: Q.Gen ByteString +genDigest = Base16.encode . Text.encodeUtf8 . coerce @ArbitraryText <$> Q.arbitrary + +genString :: Q.Gen FilePath +genString = Text.unpack . coerce @ArbitraryText <$> Q.arbitrary + +genDomain :: Q.Gen (Text, VDomainConfiguration) +genDomain = do + nm <- coerce @(Q.Gen ArbitraryText) Q.arbitrary + dom <- + VDomainConfiguration + <$> pure (Text.unpack nm) + <*> (fromIntegral @Int . abs <$> Q.arbitraryBoundedIntegral) + <*> Q.elements [Rising, Falling] + <*> Q.elements [Synchronous, Asynchronous] + <*> Q.elements [Defined, Unknown] + <*> Q.elements [ActiveHigh, ActiveLow] + + pure (nm, dom) + +genPort :: Q.Gen ManifestPort +genPort = + ManifestPort + <$> coerce @(Q.Gen ArbitraryText) Q.arbitrary + <*> coerce @(Q.Gen ArbitraryText) Q.arbitrary + <*> (fromIntegral @Int . abs <$> Q.arbitraryBoundedIntegral) + <*> Q.elements [False, True] + <*> coerce @(Q.Gen (Maybe ArbitraryText)) Q.arbitrary + +genManifest :: Q.Gen Manifest +genManifest = + Manifest + <$> Q.arbitrary -- hash + <*> Q.arbitrary -- flags + <*> Q.listOf genPort -- in ports + <*> Q.listOf genPort -- out ports + <*> coerce @(Q.Gen [ArbitraryText]) @(Q.Gen [Text]) Q.arbitrary -- comp names + <*> coerce @(Q.Gen ArbitraryText) @(Q.Gen Text) Q.arbitrary -- top name + <*> Q.listOf ((,) <$> genString <*> genDigest) -- files + <*> (HashMap.fromList <$> Q.listOf genDomain) -- domains + <*> coerce @(Q.Gen [ArbitraryText]) @(Q.Gen [Text]) Q.arbitrary -- dependencies + +tests :: TestTree +tests = + adjustOption (\_ -> Q.QuickCheckTests 100) $ + testGroup + "Clash.Tests.Driver.Manifest" + [ Q.testProperty "decode . encode ~ id" $ do + manifest <- genManifest + let + encoded = Aeson.encodePretty manifest + decoded = Aeson.eitherDecode encoded + + if decoded == Right manifest then + pure True + else do + !_ <- traceM "-------------------------" + !_ <- traceM (show manifest) + !_ <- traceM (Text.unpack (Text.decodeUtf8 (LazyByteString.toStrict encoded))) + !_ <- traceM (show decoded) + pure False + ] diff --git a/tests/Clash/Tests/Netlist/Id.hs b/tests/Clash/Tests/Netlist/Id.hs new file mode 100644 --- /dev/null +++ b/tests/Clash/Tests/Netlist/Id.hs @@ -0,0 +1,224 @@ +{-| +Copyright : (C) 2019, QBayLogic B.V. +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. +-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MagicHash #-} + +module Clash.Tests.Netlist.Id ( + module Clash.Tests.Netlist.Id + ) where + +import qualified Clash.Netlist.Types as Id +import qualified Clash.Netlist.Id as Id + +import Clash.Annotations.Primitive +import Control.Monad.Trans.State.Lazy +import qualified Data.ByteString as BS +import Data.Coerce +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified Data.Text as Text +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8) +import Test.QuickCheck.Utf8 +import Text.Show.Pretty (ppShow) +import Debug.Trace + +newtype NonEmptyText = NonEmptyText Text deriving (Show) +newtype ArbitraryText = ArbitraryText Text deriving (Show) +newtype ArbitraryAsciiText = ArbitraryAsciiText Text deriving (Show) + +instance Arbitrary ArbitraryAsciiText where + arbitrary = coerce (decodeUtf8 . BS.concat <$> listOf oneByte) + shrink = coerce shrinkValidUtf8 + +instance Arbitrary ArbitraryText where + arbitrary = coerce genValidUtf8 + shrink = coerce shrinkValidUtf8 + +instance Arbitrary NonEmptyText where + arbitrary = coerce genValidUtf81 + shrink = coerce shrinkValidUtf81 + +eval :: Bool -> HDL -> State Id.IdentifierSet a -> a +eval esc hdl a = evalState a (Id.emptyIdentifierSet esc Id.PreserveCase hdl) + +eval' :: State Id.IdentifierSet a -> a +eval' = eval True VHDL + +roundTrip :: Bool -> HDL -> Text -> Text +roundTrip esc hdl = Id.toText . eval esc hdl . Id.make + +roundTrip' :: Text -> Text +roundTrip' = roundTrip True VHDL + +roundTripTest :: Text -> TestTree +roundTripTest t = + testCase (Text.unpack ("roundTrip: " <> t)) (t @=? roundTrip' t) + +-- | Raw identifiers should always come up the same after 'Id.toText' +rawToIdProperty :: NonEmptyText -> Property +rawToIdProperty t = coerce t === Id.toText (eval' (Id.addRaw (coerce t))) + +xor :: Bool -> Bool -> Bool +xor True True = False +xor True False = True +xor False True = True +xor False False = False + +tests :: TestTree +tests = + testGroup + "Clash.Tests.Netlist.Id" + [ testCase "roundTrip: empty id" ("clash_internal" @=? roundTrip' "") + + -- Round trip tests tess whether a "make -> to text" roundtrip ~ id + , roundTripTest "foo_bar" + , roundTripTest "foo_1" + , roundTripTest "foo_1_2" + , roundTripTest "foo_1_2_ab" + , roundTripTest "foo_1_ab_2" + + , testGroup "no collisions (one id)" $ flip map [minBound..maxBound] $ \hdl -> + testProperty (show hdl) $ \id0 -> eval True hdl $ do + id0t <- Id.toText <$> Id.make (coerce @ArbitraryAsciiText id0) + id1t <- Id.toText <$> Id.make (coerce @ArbitraryAsciiText id0) + pure (id0t /= id1t) + + , testGroup "no collisions (two ids)" $ flip map [minBound..maxBound] $ \hdl -> + testProperty (show hdl) $ \id0 id1 -> eval True hdl $ do + id0t <- Id.toText <$> Id.make (coerce @ArbitraryAsciiText id0) + id1t <- Id.toText <$> Id.make (coerce @ArbitraryAsciiText id1) + pure (id0t /= id1t) + + , testGroup "make0" $ eval' $ do + id0 <- Id.toText <$> Id.make "foo" + id1 <- Id.toText <$> Id.make "foo" + id2 <- Id.toText <$> Id.make "foo_0" + id3 <- Id.toText <$> Id.make "foo" + id4 <- Id.toText <$> Id.make "foo_0" + pure [ testCase "id0 == foo" $ id0 @?= "foo" + , testCase "id1 == foo_0" $ id1 @?= "foo_0" + , testCase "id2 == foo_0_0" $ id2 @?= "foo_0_0" + , testCase "id3 == foo_0_1" $ id3 @?= "foo_1" + , testCase "id4 == foo_0_0" $ id4 @?= "foo_0_1" + ] + + , testGroup "make1" $ eval' $ do + id0 <- Id.toText <$> Id.make "foo" + id1 <- Id.toText <$> Id.make "foo_37" + id2 <- Id.toText <$> Id.make "foo" + id3 <- Id.toText <$> Id.make "foo_3" + pure [ testCase "id0 == foo" $ id0 @?= "foo" + , testCase "id1 == foo_37" $ id1 @?= "foo_37" + , testCase "id2 == foo_38" $ id2 @?= "foo_38" + , testCase "id3 == foo_3" $ id3 @?= "foo_3" + ] + + , testGroup "Id.add" $ eval' $ do + old <- get + id0 <- Id.addRaw "LED" + put old + Id.add id0 + traceM . ppShow =<< get + id1 <- Id.toText <$> Id.make "led" + pure [ testCase "id1 == led_0" $ id1 @?= "led_0" ] + + -- Some tools/hdls are case insensitive, so we should make sure we are too + , testGroup "case sensitivity" $ eval' $ do + id0 <- Id.toText <$> Id.make "foobar" + id1 <- Id.toText <$> Id.make "fOoBAr" + pure [ testCase "id0 == foobar" $ id0 @?= "foobar" + , testCase "id1 == fOoBAr_0" $ id1 @?= "fOoBAr_0" + ] + + -- An identifier made with 'mkBasic' should pass the 'isBasic' test + , testGroup "mkBasic" $ concat $ flip map [minBound..maxBound] $ \hdl -> + [ testProperty (show hdl <> " (ascii)") + (Id.isBasic# hdl . roundTrip False hdl . coerce @ArbitraryAsciiText) + , testProperty (show hdl <> " (UTF8)") + (Id.isBasic# hdl . roundTrip False hdl . coerce @ArbitraryText) + ] + + -- We expect a processed identifier to be either a valid basic xor + -- extended identifier. Anything "in between" is an error. + , testGroup "Basic XOR Extended" $ flip map [minBound..maxBound] $ \hdl -> + testProperty (show hdl) $ \id0 -> + let id1 = roundTrip True hdl (coerce @ArbitraryText id0) in + Id.isBasic# hdl id1 `xor` Id.isExtended# hdl id1 + + , testCase "keyword (use => \\use\\)" ("\\use\\" @=? roundTrip' "use") + , testCase "keyword (else => \\else\\)" ("\\else\\" @=? roundTrip' "else") + , testCase "keyword (record => \\record\\)" ("\\record\\" @=? roundTrip' "record") + , testCase "keyword (configuration => \\configuration\\)" ("\\configuration\\" @=? roundTrip' "configuration") + , testCase "keyword (cOnFiGUrAtiON => \\cOnFiGUrAtiON\\)" ("\\cOnFiGUrAtiON\\" @=? roundTrip' "cOnFiGUrAtiON") + , testCase "Verilog keyword in VHDL (always => always)" ("always" @=? roundTrip' "always") + + , testGroup "extended identifiers" + [ testCase "(1) foo bar => \\foo bar\\" $ "\\foo bar\\" @=? roundTrip' "foo bar" + , testCase "(2) foo bar => \\foo bar\\" $ 9 @=? Text.length (roundTrip' "foo bar") + + , testCase "foo\\bar => foobar" $ "foobar" @=? roundTrip' "foo\\bar" + , testCase "\\foobar\\ => foobar" $ "foobar" @=? roundTrip' "\\foobar\\" + + -- This behavior makes sense, but it results in ugly identifiers, so + -- backslashes are stripped + -- , testCase "foo\\bar => \\foo\\\\bar\\" $ "\\foo\\\\bar\\" @=? roundTrip' "foo\\bar" + -- , testCase "\\foobar\\ => \\\\\\foobar\\\\\\" $ "\\\\\\foobar\\\\\\" @=? roundTrip' "\\foobar\\" + ] + + , testGroup "pretty names" + [ testCase "(# #) => Unit" $ "Unit" @=? roundTrip' "(# #)" + , testCase "() => Unit" $ "Unit" @=? roundTrip' "()" + , testCase "(,,) => Tup3" $ "Tup3" @=? roundTrip' "(,,)" + , testCase "(#,,,,#) => Tup5" $ "Tup5" @=? roundTrip' "(,,,,)" + ] + + , testGroup "pretty names (force basic)" + [ testCase "(# #) => Unit" $ "Unit" @=? roundTrip False VHDL "(# #)" + , testCase "() => Unit" $ "Unit" @=? roundTrip False VHDL "()" + , testCase "(,,) => Tup3" $ "Tup3" @=? roundTrip False VHDL "(,,)" + , testCase "(#,,,,#) => Tup5" $ "Tup5" @=? roundTrip False VHDL "(,,,,)" + ] + + , testGroup "disallow escaped identifiers" + [ testCase "foo bar => foobar" $ "foobar" @=? roundTrip False VHDL "foo bar" + , testCase "foo\\bar => foobar" $ "foobar" @=? roundTrip False VHDL "foo\\bar" + ] + + -- Raw identifiers are a bit weird: they're passed in by users and should + -- be spliced into the HDL at verbatim. Clash shouldn't generate collisions + -- though. + , testGroup "raw identifiers" + [ testProperty "id" rawToIdProperty + , testGroup "Verilog: \\foo bar␣" $ eval True Verilog $ do + id0 <- Id.toText <$> Id.addRaw "\\foo bar " + id1 <- Id.toText <$> Id.make "foo bar" + pure [ testCase "id0 == \\foo bar " $ id0 @?= "\\foo bar " + , testCase "id1 == \\foo bar_0 " $ id1 @?= "\\foo bar_0 " + ] + , testGroup "Verilog: \\foo bar␣␣" $ eval True Verilog $ do + id0 <- Id.toText <$> Id.addRaw "\\foo bar " + id1 <- Id.toText <$> Id.make "foo bar" + pure [ testCase "id0 == \\foo bar " $ id0 @?= "\\foo bar " + , testCase "id1 == \\foo bar_0 " $ id1 @?= "\\foo bar_0 " + ] + , testGroup "VHDL: \\foo bar\\" $ eval True VHDL $ do + id0 <- Id.toText <$> Id.addRaw "\\foo bar\\" + id1 <- Id.toText <$> Id.make "foo bar" + pure [ testCase "id0 == \\foo bar\\" $ id0 @?= "\\foo bar\\" + , testCase "id1 == \\foo bar_0\\ " $ id1 @?= "\\foo bar_0\\" + ] + , testGroup "VHDL: \\foo bar \\" $ eval True VHDL $ do + id0 <- Id.toText <$> Id.addRaw "\\foo bar \\" + id1 <- Id.toText <$> Id.make "foo bar" + -- While 'id1' could strictly be \foo bar\, it's probably best to be + -- whitespace insensitive. + pure [ testCase "id0 == \\foo bar \\" $ id0 @?= "\\foo bar \\" + , testCase "id1 == \\foo bar_0\\ " $ id1 @?= "\\foo bar_0\\" + ] + ] + ] diff --git a/tests/Test/Clash/Rewrite.hs b/tests/Test/Clash/Rewrite.hs --- a/tests/Test/Clash/Rewrite.hs +++ b/tests/Test/Clash/Rewrite.hs @@ -8,9 +8,10 @@ {-# OPTIONS_GHC -Wno-orphans #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} module Test.Clash.Rewrite where @@ -64,6 +65,7 @@ , _dbgTransformations=Set.empty , _dbgTransformationsFrom=0 , _dbgTransformationsLimit=maxBound + , _dbgRewriteHistoryFile=Nothing , _aggressiveXOpt=False , _typeTranslator=error "_typeTranslator: NYI" , _tcCache=emptyUniqMap @@ -71,6 +73,7 @@ , _evaluator=error "_evaluator: NYI" , _topEntities=emptyVarSet , _customReprs=buildCustomReprs [] + , _fuelLimit=10 } instance Default extra => Default (RewriteState extra) where @@ -81,7 +84,12 @@ , _curFun=error "_curFun: NYI" , _nameCounter=2 , _workFreeBinders=emptyVarEnv +#if EXPERIMENTAL_EVALUATOR + , _ioHeap=error "_ioHeap: NYI" + , _ioAddr=0 +#else , _globalHeap=error "_globalHeap: NYI" +#endif , _extra=def } @@ -304,4 +312,3 @@ , TH.quoteType = error "parseToTerm.quoteType: NYI" , TH.quoteDec = error "parseToTerm.quoteDec: NYI" } - diff --git a/tests/unittests.hs b/tests/unittests.hs --- a/tests/unittests.hs +++ b/tests/unittests.hs @@ -1,19 +1,33 @@ module Main where import Test.Tasty +import Test.Tasty.QuickCheck import qualified Clash.Tests.Core.FreeVars import qualified Clash.Tests.Core.Subst +import qualified Clash.Tests.Driver.Manifest +import qualified Clash.Tests.Netlist.Id import qualified Clash.Tests.Util.Interpolate import qualified Clash.Tests.Normalize.Transformations +-- AFAIK there's no good way to override the default, so we just detect the +-- default value and change it. +setDefaultQuickCheckTests :: QuickCheckTests -> QuickCheckTests +setDefaultQuickCheckTests (QuickCheckTests 100) = 10000 +setDefaultQuickCheckTests opt = opt + tests :: TestTree tests = testGroup "Unittests" [ Clash.Tests.Core.FreeVars.tests , Clash.Tests.Core.Subst.tests + , Clash.Tests.Driver.Manifest.tests , Clash.Tests.Util.Interpolate.tests + , Clash.Tests.Netlist.Id.tests , Clash.Tests.Normalize.Transformations.tests ] main :: IO () -main = defaultMain tests +main = + defaultMain + $ adjustOption setDefaultQuickCheckTests + $ tests