diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,105 @@ # Changelog for the Clash project +## 1.10.0 *Apr 23rd, 2026* + +Release highlight: +* `Clash.Class.NumConvert`: Utilities for safely converting between various Clash number types [#2915](https://github.com/clash-lang/clash-compiler/pull/2915) + +Added: +* Added GHC 9.12 support +* `Clash.Class.NumConvert`: Utilities for safely converting between various Clash number types [#2915](https://github.com/clash-lang/clash-compiler/pull/2915) +* Add `Clash.XException.ShowX` instance for `Foreign.C.Types.CUShort`. [#2397](https://github.com/clash-lang/clash-compiler/pull/2397) +* Introduced various new types to `Clash.Signal` to more easily represent time and its relation to your clock domain. New types: `Seconds`, `Milliseconds`, `Microseconds`, `Nanoseconds`, `Picoseconds`, `DomainToHz`, `HzToPeriod`, `PeriodToHz`, `PeriodToCycles`, `ClockDivider`. [#2734](https://github.com/clash-lang/clash-compiler/pull/2734) +* `Distributive` and `Representable` instances for `Vec` +* Resize functions `maybeResize` and `maybeTruncateB` to `Clash.Class.Resize`. Can be used to resize without loss of information. [#2779](https://github.com/clash-lang/clash-compiler/issues/2779) +* Alongside the existing Eq-like and Ord-like signal operators like `.==.` and `.<=.` etc., there are now new functions for comparing with constants: `.==`, `==.`, `./=`, `/=.`, `.<=`, `<=.`, `.>=`, `>=.`, `.>`, `>.`, `.<`, `<.`, `.&&`, `&&.`, `.||`, `||.`. These are useful for comparing signals with constants in a more readable way. For example, `a .==. pure True` can now be replaced with `a .== True`. [#2545](https://github.com/clash-lang/clash-compiler/pull/2545) +* instance `HasField f (Signal dom r) (Signal dom a)`. This means record dot accesses will be passed to the underlying type. For example, this will work: + + ```haskell + data MyRecord = MyRecord { myField :: Int } + + a :: Signal dom MyRecord + a = pure (MyRecord 3) + + b :: Signal dom Int + b = a.myField + ``` +* `BitPack` instance for `Data.Proxy.Proxy` +* `apEn`, which is a `mux` that optionally applies an update function to a value. [#3029](https://github.com/clash-lang/clash-compiler/pull/3029) +* `regEnN`, which is a chain of `regEn`s. [#3029](https://github.com/clash-lang/clash-compiler/pull/3029) +* `Index 0` instances for `BitPack`, `Bits`, `Counter`, `FiniteBits`, `Parity`, and `SaturatingNum`. [#2784](https://github.com/clash-lang/clash-compiler/pull/2784) +* Zero-sized block RAM implementations for `blockRam1` and `blockRamU`. [#2784](https://github.com/clash-lang/clash-compiler/pull/2784) +* `Counter a => Counter (Vec 0 a)` instance. [#2784](https://github.com/clash-lang/clash-compiler/pull/2784) +* `SaturatingNum` and `Bounded` instances for `Signal dom a`. The `sat` family (`satAdd`, `satSucc`, ...) can now be used on `Signal`s and `{min,max}Bound` can be used to construct them [#2931](https://github.com/clash-lang/clash-compiler/issues/2931) +* `-fclash-no-concurrent-topentity-compilation` flag to disable concurrent compilation of top entities. This is mostly useful to get a consistent debug output. +* `SomeBoundedSNat` and Hedgehog generators [#3183](https://github.com/clash-lang/clash-compiler/pull/3183) +* `Eq`, `NFData`, `ShowX` and `BitPack` instances for `RamOp`. +* `smapWithBounds` extending `smap` via offering a proof witness for the upper bound of the vector size to the mapping function. [#2686](https://github.com/clash-lang/clash-compiler/pull/2686) +* The function `Clash.Explicit.DDR.ddrForwardClock`, which uses a DDR output primitive to forward a clock signal to a DDR-capable output pin. [#2876](https://github.com/clash-lang/clash-compiler/pull/2876) + +Removed: +* Support for GHC versions 9.4 and older +* Newer Verilators (> v5) can deal with delay statements, hence removing the need for Clash specific workarounds. If you relied on Clash-generated Verilator shims, consider using `verilator --build --binary` instead. +* Experimental feature "multiple hidden domains" [#2750](https://github.com/clash-lang/clash-compiler/pull/2750) +* The deprecated module `Clash.Prelude.DataFlow` was removed. The `clash-protocols` package provides dataflow-based protocols and circuits. [#3181](https://github.com/clash-lang/clash-compiler/pull/3181) +* The deprecated functions `altpll` and `alteraPll` were removed from the `Clash.Intel.ClockGen` module. Clash 1.8 introduced the new functions `altpllSync`, `alteraPllSync`, `unsafeAltpll` and `unsafeAlteraPll`. A name for the IP instantiation, handled by the _name_ argument to `altpll` and `alteraPll`, can be provided with the `Clash.Magic.setName` function. [#3181](https://github.com/clash-lang/clash-compiler/pull/3181) + +Changed: +* `dfold` now offers a proof witness for the upper bound of the vector size to the folding function. Note that this change may require additional type annotations, as solutions working in the past may complain with an untouchable type error now. [#2686](https://github.com/clash-lang/clash-compiler/pull/2686) +* You can now only create an `SDomainConfiguration` when the `period` of the domain is at least `1`. Pattern matching on an `SDomainConfiguration` bring the `1 <= period` into scope. This in turns enables the following code to typecheck: + ``` + import Clash.Prelude + import Data.Proxy + + f :: + forall dom . + KnownDomain dom => + Proxy dom -> + SNat (PeriodToCycles dom (Milliseconds 1)) + f Proxy = case knownDomain @dom of + SDomainConfiguration {} -> SNat + ``` + where the `DivRU` in + ``` + type PeriodToCycles (dom :: Domain) (period :: Nat) = period `DivRU` DomainPeriod dom + ``` + requires that the `DomainPeriod dom` is at least `1`. [#2740](https://github.com/clash-lang/clash-compiler/pull/2740) +* `select` and `selectI` now use `<=` constraints instead of `CmpNat`. [#2873](https://github.com/clash-lang/clash-compiler/pull/2873) +* `ResetStrategy` now contains the reset function, to avoid dummy arguments on `NoClearOnReset` [#2849](https://github.com/clash-lang/clash-compiler/pull/2849) +* `Clash.Explicit.DDR`, `Clash.Intel.DDR` and `Clash.Xilinx.DDR`: [#2833](https://github.com/clash-lang/clash-compiler/pull/2833) + - The constraints for the functions have been rewritten to use `DomainPeriod`, which makes them more readable and relaxes unnecessary constraints on the virtual DDR domain. The type-level variables for the domains have been renamed. `dom` is a real domain, `domDDR` is the virtual DDR domain. + - The Xilinx and Intel primitives only support domains where the rising edge is the active edge. This is now enforced at the type level by adding a constraint. + - The Xilinx and Intel primitives now directly support any data type that has a `BitPack` instance. +* Order of type arguments for functions in `clash-prelude-hedgehog` now follows _size_, _domain_, _monad_. [#2880](https://github.com/clash-lang/clash-compiler/pull/2880) +* The Clash Prelude now exports the `Default` class from the package `data-default` instead of from the now superseded `data-default-class`. If you import the `Default` class name or the `def` function from the `data-default-class` package _older than version 0.2_, or one of your dependencies does, you might get a bewildering error message. You might get the error "No instance for (Default T)" even though there appears to be such an instance. The best solution is to make sure all your packages and dependencies use the `data-default` package and not the `data-default-class` package. The next most obvious solution is to make sure `data-default-class` is of version 0.2 or higher, for instance by depending on it in your own package. If this creates a dependency conflict, another solution is to import the correct module. `Default` and `def` from `Clash.Prelude` or `Data.Default` are for the new `data-default` package. `Data.Default.Class` is for the `data-default-class` package. There are situations where this will still not be enough, but luckily the `Default` class is not used all that much. [#2891](https://github.com/clash-lang/clash-compiler/pull/2891) +* Changed implementation of `(+>>)` to no longer require `KnownNat` +* The `clash-prelude` package now uses `PolyKinds` by default, meaning all its type class instances are now more general than before. As an example, without `PolyKinds`, `BitPack (Proxy a)` would only be defined when `a :: Type`, with the extension it would be defined for any `a :: k`. After this change, some instances in user code might now overlap. [#2994](https://github.com/clash-lang/clash-compiler/pull/2994) +* When generating (System)Verilog, Clash now resets the default net type from none to the verilog default after the generated module. [#3005](https://github.com/clash-lang/clash-compiler/pull/3005) +* The content from the `Clash.Tutorial` module and from https://clash-lang.readthedocs.io/ has been split and moved to two new locations. + 1. The actual tutorial parts has been moved to: https://docs.clash-lang.org/tutorial/ + 2. Parts that fit better in the clash compiler user guide have been moved to: https://docs.clash-lang.org/compiler-user-guide/ + + Moving the documentation to these locations makes it easier to update their content as it is no longer needed to release a new version of the `clash-prelude` package for the publication of this content. +* Vector functions in Verilog now have indices consistent with the Vec inputs/outputs (before they were reversed). This is convenient when writing design constraints, which can now be referenced consistently like `imap[0],imap[1],..`. See [#3088](https://github.com/clash-lang/clash-compiler/issues/3088). + +Fixed: +* Clash no longer gives `Dubious primitive instantiation warning` when using `unpack` [#2386](https://github.com/clash-lang/clash-compiler/issues/2386). +* Clash now generates more intuitive names for specialized binders. See [#2508](https://github.com/clash-lang/clash-compiler/issues/2508). +* `foldl` on `Vec` is now strict. See [this GitHub discussion](https://github.com/hasura/graphql-engine/pull/2933#discussion_r328821960) and [this blog post](https://well-typed.com/blog/90/) for more information. [#2482](https://github.com/clash-lang/clash-compiler/issues/2482) +* Type families that appear in GHC core types are now normalized before being translated into their Clash core equivalent. See [#3063](https://github.com/clash-lang/clash-compiler/issues/3063). +* Added an evaluator rule for `bigNatEq#` with compile-time constant arguments [#3084](https://github.com/clash-lang/clash-compiler/issues/3084) +* Reduce constants to NF before specialization [#3129](https://github.com/clash-lang/clash-compiler/issues/3129) +* `rotateL` and `rotateR` no longer error when used on `BitVector 0` [#2980](https://github.com/clash-lang/clash-compiler/issues/2980) +* Behavior of `shiftR` is now documented for `Unsigned`, `BitVector`, `Index`, and `Signed` [#2959](https://github.com/clash-lang/clash-compiler/issues/2959) +* Clash will no longer error if it finds the same data file more than once due to duplicate `-i` flags [#3141](https://github.com/clash-lang/clash-compiler/issues/3141) +* Higher order blackboxes not propagating usage metadata for generated results [#3147](https://github.com/clash-lang/clash-compiler/issues/3147) +* Run `caseCon` after post-normalization `inlineCleanup` [#3159](https://github.com/clash-lang/clash-compiler/issues/3159) +* Failure to generate binder assignments in very specific cases [#3185](https://github.com/clash-lang/clash-compiler/issues/3185) +* Clash won't create (invalid) netlist cases on Integer and Natural constructors anymore [#3157](https://github.com/clash-lang/clash-compiler/issues/3157) +* Post-normalization flattening could leave a `Just` constructor as the scrutinee of a `case` after simplifying tuple projections [#3204](https://github.com/clash-lang/clash-compiler/issues/3204) +* Clash no longer crashes on false positive free variable introduction in `reduceConst` and `constantSpec`. Fixes [#3206](https://github.com/clash-lang/clash-compiler/issues/3206). +* `negate` for `Num Bit` is now defined as the additive inverse, i.e., `negate = id`. [#2999](https://github.com/clash-lang/clash-compiler/issues/2999) + ## 1.8.5 *Mar 24th, 2026* Added: @@ -358,7 +458,7 @@ * Don't overflow the range of VHDL's natural type in shift/rotate, leading to simulation issues. Shift now saturates to a 31-bit shift amount. For rotate, in simulation only, the rotate amount is modulo the word width of the rotated value [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) * `shiftL` for Clash datatypes does not cause a crash anymore when running Clash code with a really large shift amount [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) * VHDL generated for `Signed.fromInteger` now truncates, like the Clash simulation, when the result is smaller than the argument [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) - * Clash now preserves boolean combinatorial logic better when generating HDL [#1881](https://github.com/clash-lang/clash-compiler/issues/1881) + * Clash now preserves boolean combinational logic better when generating HDL [#1881](https://github.com/clash-lang/clash-compiler/issues/1881) * `valid` field of `TemplateFunction` is now checked for includes [#1945](https://github.com/clash-lang/clash-compiler/issues/1945) * Clash now generates clock generators that ensure that the amount of time between simulation start and the first active edge of the clock is equal to (/or longer than/) the period of the clock. The first active edges of the clocks do still occur simultaneously. [#2001](https://github.com/clash-lang/clash-compiler/issues/2001) * Expected values in assert become undefined when using `-fclash-compile-ultra` [#2040](https://github.com/clash-lang/clash-compiler/issues/2040) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -31,6 +31,6 @@ - [Discourse: long form discussions and questions](https://clash-lang.discourse.group/) - [Discord: short form discussions and community chat room](https://discord.gg/rebGq25FB4) -- [Slack: short form discussions and questions](https://functionalprogramming.slack.com/archives/CPGMJFF50) - (Invite yourself at [fpslack.com](https://fpslack.com)) +- [Fosstodon: microblogging and community chat room](https://fosstodon.org/@ClashHDL) +- [Bluesky: microblogging and community chat room](https://bsky.app/profile/clash-lang.bsky.social) - [Github: issue tracker](https://github.com/clash-lang/clash-compiler/issues) diff --git a/clash-lib.cabal b/clash-lib.cabal --- a/clash-lib.cabal +++ b/clash-lib.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: clash-lib -Version: 1.8.5 +Version: 1.10.0 Synopsis: Clash: a functional hardware description language - As a library Description: Clash is a functional hardware description language that borrows both its @@ -54,6 +54,10 @@ 2017-2023, QBayLogic B.V., Google Inc. Category: Hardware Build-type: Simple +tested-with: GHC == 9.6.7, + GHC == 9.8.4, + GHC == 9.10.3, + GHC == 9.12.4 Extra-source-files: README.md, @@ -140,19 +144,19 @@ RecordWildCards TemplateHaskell - Build-depends: aeson >= 0.6.2.0 && < 2.3, + Build-depends: aeson >= 2.0.0.0 && < 2.3, attoparsec-aeson >= 2.1 && < 2.3, aeson-pretty >= 0.8 && < 0.9, ansi-terminal >= 0.8.0.0 && < 1.2, array, async >= 2.2.0 && < 2.3, attoparsec >= 0.10.4.0 && < 0.15, - base >= 4.11 && < 5, + base >= 4.18 && < 5, base16-bytestring >= 0.1.1 && < 1.1, binary >= 0.8.5 && < 0.11, bytestring >= 0.10.0.2 && < 0.13, - clash-prelude == 1.8.5, - containers >= 0.5.0.0 && < 0.8, + clash-prelude == 1.10.0, + containers >= 0.6.7 && < 0.9, cryptohash-sha256 >= 0.11 && < 0.12, data-binary-ieee754 >= 0.4.4 && < 0.6, data-default >= 0.7 && < 0.9, @@ -162,41 +166,35 @@ exceptions >= 0.8.3 && < 0.11.0, extra >= 1.6.17 && < 1.9, filepath >= 1.3.0.1 && < 1.6, - ghc >= 8.6.0 && < 9.11, + ghc >= 9.6.0 && < 9.13, + ghc-boot, ghc-boot-th, ghc-prim, - hashable >= 1.2.1.0 && < 1.6, + ghc-bignum >=1.0 && <1.4, + hashable >= 1.4.1.0 && < 1.6, haskell-src-meta >= 0.8 && < 0.9, hint >= 0.7 && < 0.10, infinite-list ^>= 0.1, lens >= 4.10 && < 5.4, - mtl >= 2.1.2 && < 2.4, + mtl >= 2.3.1 && < 2.4, ordered-containers >= 0.2 && < 0.3, prettyprinter >= 1.2.0.1 && < 1.8, prettyprinter-interp ^>= 0.2, pretty-show >= 1.9 && < 2.0, primitive >= 0.5.0.1 && < 1.0, string-interpolate ^>= 0.3, - template-haskell >= 2.8.0.0 && < 2.23, + template-haskell >= 2.20.0.0 && < 2.24, temporary >= 1.2.1 && < 1.4, terminal-size >= 0.3 && < 0.4, text >= 1.2.2 && < 2.2, time >= 1.4.0.1 && < 1.15, - transformers >= 0.5.2.0 && < 0.7, + transformers >= 0.6.1.0 && < 0.7, trifecta >= 1.7.1.1 && < 2.2, vector >= 0.11 && < 1.0, vector-binary-instances >= 0.2.3.5 && < 0.3, - unordered-containers >= 0.2.3.3 && < 0.3, + unordered-containers >= 0.2.11 && < 0.3, yaml >= 0.11 && < 0.12, - if impl(ghc < 9.4.0) - build-depends: - - if impl(ghc >= 9.0.0) - build-depends: ghc-bignum >=1.0 && <1.4 - else - build-depends: integer-gmp >=1.0 && <1.1 - Autogen-Modules: Paths_clash_lib Exposed-modules: Clash.Annotations.BitRepresentation.ClashLib @@ -240,6 +238,7 @@ Clash.Driver Clash.Driver.Bool + Clash.Driver.BrokenGhcs Clash.Driver.Manifest Clash.Driver.Types @@ -322,7 +321,6 @@ GHC.BasicTypes.Extra Other-Modules: Clash.Annotations.TopEntity.Extra - Data.IntMap.Extra Data.List.Extra Data.Map.Ordered.Extra Data.Monoid.Extra @@ -363,8 +361,7 @@ filepath GHC-Options: -Wall -Wcompat default-language: Haskell2010 - if impl(ghc >= 9.2.0) - buildable: False + buildable: False test-suite doctests diff --git a/prims/commonverilog/Clash_Class_BitPack.primitives.yaml b/prims/commonverilog/Clash_Class_BitPack.primitives.yaml --- a/prims/commonverilog/Clash_Class_BitPack.primitives.yaml +++ b/prims/commonverilog/Clash_Class_BitPack.primitives.yaml @@ -5,8 +5,128 @@ template: ~ARG[0] workInfo: Never - BlackBox: + name: Clash.Class.BitPack.Internal.packInt8# + kind: Expression + type: 'packInt8# :: Int8 -> Bitvector 8' + template: $unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt16# + kind: Expression + type: 'packInt16# :: Int16 -> Bitvector 16' + template: $unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt32# + kind: Expression + type: 'packInt32# :: Int32 -> Bitvector 32' + template: $unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt64# + kind: Expression + type: 'packInt64# :: Int64 -> Bitvector 64' + template: $unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord# + kind: Expression + type: 'packWord# :: Word -> Bitvector WORD_SIZE_IN_BITS' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord8# + kind: Expression + type: 'packWord8# :: Word8 -> Bitvector 8' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord16# + kind: Expression + type: 'packWord16# :: Word16 -> Bitvector 16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord32# + kind: Expression + type: 'packWord32# :: Word32 -> Bitvector 32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord64# + kind: Expression + type: 'packWord64# :: Word64 -> Bitvector 64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packCUShort# + kind: Expression + type: 'packCUShort# :: CUShort -> Bitvector 16' + template: ~ARG[0] + workInfo: Never +- BlackBox: name: Clash.Class.BitPack.Internal.unpackChar# kind: Expression type: 'unpackChar# :: BitVector 21 -> Char' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt8# + kind: Expression + type: 'unpackInt8# :: Bitvector 8 -> Int8' + template: $signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt16# + kind: Expression + type: 'unpackInt16# :: Bitvector 16 -> Int16' + template: $signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt32# + kind: Expression + type: 'unpackInt32# :: Bitvector 32 -> Int32' + template: $signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt64# + kind: Expression + type: 'unpackInt64# :: Bitvector 64 -> Int64' + template: $signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord# + kind: Expression + type: 'unpackWord# :: Bitvector WORD_SIZE_IN_BITS -> Word' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord8# + kind: Expression + type: 'unpackWord8# :: Bitvector 8 -> Word8' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord16# + kind: Expression + type: 'unpackWord16# :: Bitvector 16 -> Word16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord32# + kind: Expression + type: 'unpackWord32# :: Bitvector 32 -> Word32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord64# + kind: Expression + type: 'unpackWord64# :: Bitvector 64 -> Word64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackCUShort# + kind: Expression + type: 'unpackCUShort# :: Bitvector 16 -> CUShort' template: ~ARG[0] workInfo: Never diff --git a/prims/commonverilog/Clash_Intel_DDR.primitives.yaml b/prims/commonverilog/Clash_Intel_DDR.primitives.yaml --- a/prims/commonverilog/Clash_Intel_DDR.primitives.yaml +++ b/prims/commonverilog/Clash_Intel_DDR.primitives.yaml @@ -5,23 +5,26 @@ - altera_mf 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) + :: forall deviceFamily n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => SSymbol deviceFamily -- ARG[6] + -> Clock dom -- ARG[7] + -> Reset dom -- ARG[8] + -> Enable dom -- ARG[9] + -> Signal dom (BitVector n) -- ARG[10] + -> Signal dom (BitVector n) -- ARG[11] + -> Signal domDDR (BitVector n) template: |- // altddioOut begin altddio_out #( .extend_oe_disable ("OFF"), - .intended_device_family (~LIT[4]), + .intended_device_family (~LIT[6]), .invert_output ("OFF"), .lpm_hint ("UNUSED"), .lpm_type ("altddio_out"), @@ -29,15 +32,15 @@ .power_up_high ("OFF"), .width (~SIZE[~TYPO]) ) - ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), + ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] (~IF ~ISSYNC[1] ~THEN + .sclr (~ARG[8]), .aclr (1'b0),~ELSE - .aclr (~ARG[6]), + .aclr (~ARG[8]), .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), + .datain_h (~ARG[10]), + .datain_l (~ARG[11]), + .outclock (~ARG[7]), + .outclocken (~IF ~ISACTIVEENABLE[9] ~THEN ~ARG[9] ~ELSE 1'b1 ~FI), .dataout (~RESULT), .aset (1'b0), .sset (1'b0), diff --git a/prims/commonverilog/Clash_Sized_Internal_Index.primitives.yaml b/prims/commonverilog/Clash_Sized_Internal_Index.primitives.yaml --- a/prims/commonverilog/Clash_Sized_Internal_Index.primitives.yaml +++ b/prims/commonverilog/Clash_Sized_Internal_Index.primitives.yaml @@ -1,16 +1,16 @@ - BlackBox: name: Clash.Sized.Internal.Index.pack# kind: Expression - type: 'pack# :: Index - n -> BitVector (CLog 2 n)' + type: |- + pack# :: Index n -> BitVector (CLogWZ 2 n 0) template: ~ARG[0] workInfo: Never - BlackBox: name: Clash.Sized.Internal.Index.unpack# kind: Expression - type: 'unpack# :: (KnownNat - n, 1 <= n) => BitVector (CLog 2 n) -> Index n' - template: ~ARG[2] + type: |- + unpack# :: KnownNat n => BitVector (CLogWZ 2 n 0) -> Index n + template: ~ARG[1] workInfo: Never - BlackBox: name: Clash.Sized.Internal.Index.eq# diff --git a/prims/commonverilog/GHC_Num_Integer.primitives.yaml b/prims/commonverilog/GHC_Num_Integer.primitives.yaml --- a/prims/commonverilog/GHC_Num_Integer.primitives.yaml +++ b/prims/commonverilog/GHC_Num_Integer.primitives.yaml @@ -111,7 +111,7 @@ kind: Expression type: 'integerGt# :: Integer -> Integer -> Int#' - template: '(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]''sd1 : ~SIZE[~TYPO]''sd0' + template: '(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]''sd1 : ~SIZE[~TYPO]''sd0' warning: 'GHC.Num.Integer.integerGt#: Integers are dynamically sized in simulation, but fixed-length after synthesis. Use carefully.' - BlackBox: diff --git a/prims/commonverilog/GHC_Num_Natural.primitives.yaml b/prims/commonverilog/GHC_Num_Natural.primitives.yaml --- a/prims/commonverilog/GHC_Num_Natural.primitives.yaml +++ b/prims/commonverilog/GHC_Num_Natural.primitives.yaml @@ -74,7 +74,7 @@ kind: Expression type: 'naturalGt# :: Natural -> Natural -> Int#' - template: '(~ARG[0] > ~ARG[1] ? ~SIZE[~TYPO]''d1 : ~SIZE[~TYPO]''d0' + template: '(~ARG[0] > ~ARG[1]) ? ~SIZE[~TYPO]''d1 : ~SIZE[~TYPO]''d0' warning: 'GHC.Num.Natural.naturalGt#: Naturals are dynamically sized in simulation, but fixed-length after synthesis. Use carefully.' - BlackBox: diff --git a/prims/systemverilog/Clash_Explicit_DDR.primitives.yaml b/prims/systemverilog/Clash_Explicit_DDR.primitives.yaml --- a/prims/systemverilog/Clash_Explicit_DDR.primitives.yaml +++ b/prims/systemverilog/Clash_Explicit_DDR.primitives.yaml @@ -2,42 +2,43 @@ name: Clash.Explicit.DDR.ddrIn# kind: Declaration type: |- - ddrIn# :: forall a slow fast n pFast gated synchronous. - ( HasCallStack -- ARG[0] - , NFDataX 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) + ddrIn# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> a -- ARG[10] + -> Signal domDDR a -- ARG[11] + -> Signal dom (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]; + ~SIGD[~GENSYM[data_Pos][1]][11]; + ~SIGD[~GENSYM[data_Neg][2]][11]; + ~SIGD[~GENSYM[data_Neg_Latch][3]][11]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[1] <= ~ARG[9]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[11]; 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 + always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin ~SYM[2] <= ~ARG[10]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[11]; 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 + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[3] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin ~SYM[3] <= ~SYM[2]; end end @@ -49,38 +50,40 @@ kind: Declaration outputUsage: Blocking type: |- - ddrOut# :: ( HasCallStack -- ARG[0] - , NFDataX 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 + ddrOut# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> Signal dom a -- ARG[9] + -> Signal dom a -- ARG[10] + -> Signal domDDR 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 + ~SIGD[~GENSYM[data_Pos][1]][8]; + ~SIGD[~GENSYM[data_Neg][2]][8]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin ~SYM[1] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[9]; 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]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[2] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[10]; end end always @(*) begin - if (~ARG[4]) begin + if (~ARG[5]) 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; diff --git a/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml b/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml --- a/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml +++ b/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml @@ -17,6 +17,9 @@ 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]]); + `ifdef VERILATOR + $c("std::exit(1);"); + `endif $stop; end end @@ -47,10 +50,12 @@ 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]]); + `ifdef VERILATOR + $c("std::exit(1);"); + `endif $stop; end end // pragma translate_on assign ~RESULT = ~ARG[7]; // assertBitVector end - diff --git a/prims/systemverilog/Clash_Intel_DDR.primitives.yaml b/prims/systemverilog/Clash_Intel_DDR.primitives.yaml --- a/prims/systemverilog/Clash_Intel_DDR.primitives.yaml +++ b/prims/systemverilog/Clash_Intel_DDR.primitives.yaml @@ -5,38 +5,41 @@ - altera_mf 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) + :: forall deviceFamily n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => SSymbol deviceFamily -- ARG[6] + -> Clock dom -- ARG[7] + -> Reset dom -- ARG[8] + -> Enable dom -- ARG[9] + -> Signal domDDR (BitVector n) -- ARG[10] + -> Signal dom (BitVector n, BitVector n) template: |- // altddioIn begin - ~SIGD[~GENSYM[dataout_l][1]][8]; - ~SIGD[~GENSYM[dataout_h][2]][8]; + ~SIGD[~GENSYM[dataout_l][1]][10]; + ~SIGD[~GENSYM[dataout_h][2]][10]; altddio_in #( - .intended_device_family (~LIT[4]), + .intended_device_family (~LIT[6]), .invert_input_clocks ("OFF"), .lpm_hint ("UNUSED"), .lpm_type ("altddio_in"), .power_up_high ("OFF"), - .width (~SIZE[~TYP[8]]) + .width (~SIZE[~TYP[10]]) ) - ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), + ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[1] ~THEN + .sclr (~ARG[8]), .aclr (1'b0),~ELSE - .aclr (~ARG[6]), + .aclr (~ARG[8]), .sclr (1'b0),~FI - .datain (~ARG[8]), - .inclock (~ARG[5]), - .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN~ARG[7]~ELSE1'b1~FI), + .datain (~ARG[10]), + .inclock (~ARG[7]), + .inclocken (~IF ~ISACTIVEENABLE[9] ~THEN~ARG[9]~ELSE1'b1~FI), .dataout_h (~SYM[2]), .dataout_l (~SYM[1]), .aset (1'b0), diff --git a/prims/systemverilog/Clash_Signal_Internal.primitives.yaml b/prims/systemverilog/Clash_Signal_Internal.primitives.yaml --- a/prims/systemverilog/Clash_Signal_Internal.primitives.yaml +++ b/prims/systemverilog/Clash_Signal_Internal.primitives.yaml @@ -100,10 +100,12 @@ localparam ~GENSYM[half_period][0] = (~PERIOD[0]0 / 2); always begin ~RESULT = ~IF~ACTIVEEDGE[Rising][0]~THEN 0 ~ELSE 1 ~FI; - `ifndef VERILATOR #~LONGESTPERIOD0 forever begin ~IF~ISACTIVEENABLE[1]~THEN if (~ ~ARG[1]) begin + `ifdef VERILATOR + $c("std::exit(0);"); + `endif $finish; end ~ELSE~FI @@ -112,40 +114,7 @@ ~RESULT = ~ ~RESULT; #~SYM[0]; end - `else - ~RESULT = $c("this->~GENSYM[tb_clock_gen][1](",~SYM[0],",~IF~ACTIVEEDGE[Rising][0]~THENtrue~ELSEfalse~FI,",(~ ~ARG[1]),")"); - `endif end - - `ifdef VERILATOR - `systemc_interface - CData ~SYM[1](vluint32_t half_period, bool active_rising, bool result_rec) { - static vluint32_t init_wait = ~LONGESTPERIOD0; - static vluint32_t to_wait = 0; - static CData clock = active_rising ? 0 : 1; - - if(init_wait == 0) { - if(result_rec) { - std::exit(0); - } - else { - if(to_wait == 0) { - to_wait = half_period - 1; - clock = clock == 0 ? 1 : 0; - } - else { - to_wait = to_wait - 1; - } - } - } - else { - init_wait = init_wait - 1; - } - - return clock; - } - `verilog - `endif // pragma translate_on // tbClockGen end warning: Clash.Signal.Internal.tbClockGen is not synthesizable! @@ -170,6 +139,9 @@ #~LONGESTPERIOD0 forever begin ~IF~ISACTIVEENABLE[2]~THEN if (~ ~ARG[2]) begin + `ifdef VERILATOR + $c("std::exit(0);"); + `endif $finish; end ~ELSE~FI @@ -196,39 +168,10 @@ // resetGen begin // pragma translate_off localparam ~GENSYM[reset_period][0] = ~LONGESTPERIOD0 - 10 + (~LIT[2] * ~PERIOD[0]0); - `ifndef VERILATOR initial begin #1 ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 1 ~ELSE 0 ~FI; #~SYM[0] ~RESULT = ~IF ~ISACTIVEHIGH[0] ~THEN 0 ~ELSE 1 ~FI; end - `else - always begin - // The redundant (~RESULT | ~ ~RESULT) is needed to ensure that this is - // calculated in every cycle by verilator. Without it, the reset will stop - // being updated and will be stuck as asserted forever. - ~RESULT = - $c("this->~GENSYM[reset_gen][1](",~SYM[0],",~IF~ISACTIVEHIGH[0]~THENtrue~ELSEfalse~FI)") & (~RESULT | ~ ~RESULT); - end - `systemc_interface - CData ~SYM[1](vluint32_t reset_period, bool active_high) { - static vluint32_t to_wait = reset_period; - static CData reset = active_high ? 1 : 0; - static bool finished = false; - - if(!finished) { - if(to_wait == 0) { - reset = reset == 0 ? 1 : 0; - finished = true; - } - else { - to_wait = to_wait - 1; - } - } - - return reset; - } - `verilog - `endif // pragma translate_on // resetGen end warning: Clash.Signal.Internal.resetGenN can not be synthesized to hardware! diff --git a/prims/systemverilog/Clash_Xilinx_DDR.primitives.yaml b/prims/systemverilog/Clash_Xilinx_DDR.primitives.yaml --- a/prims/systemverilog/Clash_Xilinx_DDR.primitives.yaml +++ b/prims/systemverilog/Clash_Xilinx_DDR.primitives.yaml @@ -3,37 +3,40 @@ 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal domDDR (BitVector n) -- ARG[9] + -> Signal dom (BitVector n, BitVector n) template: |- // iddr begin - ~SIGD[~GENSYM[data_pos][1]][7]; - ~SIGD[~GENSYM[data_neg][2]][7]; - ~SIGD[~GENSYM[d][3]][7]; - assign ~SYM[3] = ~ARG[7]; + ~SIGD[~GENSYM[data_pos][1]][9]; + ~SIGD[~GENSYM[data_neg][2]][9]; + ~SIGD[~GENSYM[d][3]][9]; + assign ~SYM[3] = ~ARG[9]; genvar ~GENSYM[i][8]; ~GENERATE - for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] + for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[9]]; ~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) + .SRTYPE(~IF ~ISSYNC[1] ~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), + .C(~ARG[6]), + .CE(~IF ~ISACTIVEENABLE[8] ~THEN ~ARG[8] ~ELSE 1'b1 ~FI), .D(~SYM[3][~SYM[8]]), - .R(~ARG[5]), + .R(~ARG[7]), .S(1'b0) ); end @@ -46,38 +49,42 @@ 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal dom (BitVector n) -- ARG[9] + -> Signal dom (BitVector n) -- ARG[10] + -> Signal domDDR (BitVector n) template: |- // oddr begin - ~SIGD[~GENSYM[data_pos][1]][7]; - ~SIGD[~GENSYM[data_neg][2]][7]; - ~SIGD[~GENSYM[q][3]][7]; + ~SIGD[~GENSYM[data_pos][1]][10]; + ~SIGD[~GENSYM[data_neg][2]][10]; + ~SIGD[~GENSYM[q][3]][10]; - assign ~SYM[1] = ~ARG[6]; - assign ~SYM[2] = ~ARG[7]; + assign ~SYM[1] = ~ARG[9]; + assign ~SYM[2] = ~ARG[10]; genvar ~GENSYM[i][8]; ~GENERATE - for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] + for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[10]]; ~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), + .C(~ARG[6]), + .CE(~IF ~ISACTIVEENABLE[8] ~THEN ~ARG[8] ~ELSE 1'b1 ~FI), .D1(~SYM[1][~SYM[8]]), .D2(~SYM[2][~SYM[8]]), - .R(~ARG[4]), + .R(~ARG[7]), .S(1'b0) ); end diff --git a/prims/verilog/Clash_Explicit_DDR.primitives.yaml b/prims/verilog/Clash_Explicit_DDR.primitives.yaml --- a/prims/verilog/Clash_Explicit_DDR.primitives.yaml +++ b/prims/verilog/Clash_Explicit_DDR.primitives.yaml @@ -2,42 +2,43 @@ name: Clash.Explicit.DDR.ddrIn# kind: Declaration type: |- - ddrIn# :: forall a slow fast n pFast gated synchronous. - ( HasCallStack -- ARG[0] - , NFDataX 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) + ddrIn# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> a -- ARG[10] + -> Signal domDDR a -- ARG[11] + -> Signal dom (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]; + reg ~SIGD[~GENSYM[data_Pos][1]][11]; + reg ~SIGD[~GENSYM[data_Neg][2]][11]; + reg ~SIGD[~GENSYM[data_Neg_Latch][3]][11]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_pos][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[1] <= ~ARG[9]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[11]; 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 + always @(~IF~ACTIVEEDGE[Rising][2]~THENnegedge~ELSEposedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg][7] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin ~SYM[2] <= ~ARG[10]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[11]; 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 + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[3] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin ~SYM[3] <= ~SYM[2]; end end @@ -48,45 +49,47 @@ name: Clash.Explicit.DDR.ddrOut# kind: Declaration type: |- - ddrOut# :: ( HasCallStack -- ARG[0] - , NFDataX 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 + ddrOut# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> Signal dom a -- ARG[9] + -> Signal dom a -- ARG[10] + -> Signal domDDR a template: |- // ddrOut begin - reg ~SIGD[~GENSYM[data_Pos][1]][7]; - reg ~SIGD[~GENSYM[data_Neg][2]][7]; + reg ~SIGD[~GENSYM[data_Pos][1]][8]; + reg ~SIGD[~GENSYM[data_Neg][2]][8]; ~IF ~VIVADO ~THENreg ~SIGDO[~GENSYM[ddrOut][3]];~ELSE~FI - 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 + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrOut_pos][5] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin ~SYM[1] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[1] <= ~ARG[9]; 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]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[5]~IF~ISSYNC[2]~THEN)~ELSE or ~IF~ISACTIVEHIGH[2]~THENposedge~ELSEnegedge~FI ~ARG[6])~FI begin : ~GENSYM[~COMPNAME_ddrOut_neg][6] + if (~IF~ISACTIVEHIGH[2]~THEN~ARG[6]~ELSE! ~ARG[6]~FI) begin + ~SYM[2] <= ~ARG[8]; + end else ~IF ~ISACTIVEENABLE[7] ~THEN if (~ARG[7]) ~ELSE ~FI begin + ~SYM[2] <= ~ARG[10]; end end ~IF ~VIVADO ~THENalways @(*) begin - if (~ARG[4]) begin + if (~ARG[5]) begin ~SYM[3] = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI; end else begin ~SYM[3] = ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; end end assign ~RESULT = ~SYM[3];~ELSE - assign ~RESULT = ~ARG[4] ? ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1] : ~SYM[2]~ELSE~SYM[2] : ~SYM[1]~FI;~FI + assign ~RESULT = ~ARG[5] ? ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1] : ~SYM[2]~ELSE~SYM[2] : ~SYM[1]~FI;~FI // ddrOut end diff --git a/prims/verilog/Clash_Explicit_Testbench.primitives.yaml b/prims/verilog/Clash_Explicit_Testbench.primitives.yaml --- a/prims/verilog/Clash_Explicit_Testbench.primitives.yaml +++ b/prims/verilog/Clash_Explicit_Testbench.primitives.yaml @@ -17,6 +17,9 @@ always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin if (~VAR[checked][6] !== ~VAR[expected][7]) begin $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[5], ~VAR[expected][7], ~VAR[checked][6]); + `ifdef VERILATOR + $c("std::exit(1);"); + `endif $finish; end end @@ -47,6 +50,9 @@ 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], ~VAR[expected][6], ~VAR[checked][5]); + `ifdef VERILATOR + $c("std::exit(1);"); + `endif $finish; end end diff --git a/prims/verilog/Clash_Intel_DDR.primitives.yaml b/prims/verilog/Clash_Intel_DDR.primitives.yaml --- a/prims/verilog/Clash_Intel_DDR.primitives.yaml +++ b/prims/verilog/Clash_Intel_DDR.primitives.yaml @@ -5,38 +5,41 @@ - altera_mf 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) + :: forall deviceFamily n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => SSymbol deviceFamily -- ARG[6] + -> Clock dom -- ARG[7] + -> Reset dom -- ARG[8] + -> Enable dom -- ARG[9] + -> Signal domDDR (BitVector n) -- ARG[10] + -> Signal dom (BitVector n, BitVector n) template: |- // altddioIn begin - wire ~SIGD[~GENSYM[dataout_l][1]][8]; - wire ~SIGD[~GENSYM[dataout_h][2]][8]; + wire ~SIGD[~GENSYM[dataout_l][1]][10]; + wire ~SIGD[~GENSYM[dataout_h][2]][10]; altddio_in #( - .intended_device_family (~LIT[4]), + .intended_device_family (~LIT[6]), .invert_input_clocks ("OFF"), .lpm_hint ("UNUSED"), .lpm_type ("altddio_in"), .power_up_high ("OFF"), - .width (~SIZE[~TYP[8]]) + .width (~SIZE[~TYP[10]]) ) - ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[2] ~THEN - .sclr (~ARG[6]), + ~GENSYM[~COMPNAME_ALTDDIO_IN][7] (~IF ~ISSYNC[1] ~THEN + .sclr (~ARG[8]), .aclr (1'b0),~ELSE - .aclr (~ARG[6]), + .aclr (~ARG[8]), .sclr (1'b0),~FI - .datain (~ARG[8]), - .inclock (~ARG[5]), - .inclocken (~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] ~ELSE 1'b1 ~FI), + .datain (~ARG[10]), + .inclock (~ARG[7]), + .inclocken (~IF ~ISACTIVEENABLE[9] ~THEN ~ARG[9] ~ELSE 1'b1 ~FI), .dataout_h (~SYM[2]), .dataout_l (~SYM[1]), .aset (1'b0), diff --git a/prims/verilog/Clash_Signal_Internal.primitives.yaml b/prims/verilog/Clash_Signal_Internal.primitives.yaml --- a/prims/verilog/Clash_Signal_Internal.primitives.yaml +++ b/prims/verilog/Clash_Signal_Internal.primitives.yaml @@ -101,10 +101,12 @@ 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; - `ifndef VERILATOR #~LONGESTPERIOD0 forever begin ~IF~ISACTIVEENABLE[1]~THEN if (~ ~ARG[1]) begin + `ifdef VERILATOR + $c("std::exit(0);"); + `endif $finish(0); end ~ELSE~FI @@ -113,41 +115,8 @@ ~SYM[0] = ~ ~SYM[0]; #~SYM[1]; end - `else - ~SYM[0] = $c("this->~GENSYM[tb_clock_gen][2](",~SYM[1],",~IF~ACTIVEEDGE[Rising][0]~THENtrue~ELSEfalse~FI,",(~ ~ARG[1]),")"); - `endif end - `ifdef VERILATOR - `systemc_interface - CData ~SYM[2](vluint32_t half_period, bool active_rising, bool result_rec) { - static vluint32_t init_wait = ~LONGESTPERIOD0; - static vluint32_t to_wait = 0; - static CData clock = active_rising ? 0 : 1; - - if(init_wait == 0) { - if(result_rec) { - std::exit(0); - } - else { - if(to_wait == 0) { - to_wait = half_period - 1; - clock = clock == 0 ? 1 : 0; - } - else { - to_wait = to_wait - 1; - } - } - } - else { - init_wait = init_wait - 1; - } - - return clock; - } - `verilog - `endif - assign ~RESULT = ~SYM[0]; // pragma translate_on // tbClockGen end @@ -173,6 +142,9 @@ #~LONGESTPERIOD0 forever begin ~IF~ISACTIVEENABLE[2]~THEN if (~ ~ARG[2]) begin + `ifdef VERILATOR + $c("std::exit(0);"); + `endif $finish(0); end ~ELSE~FI @@ -201,38 +173,10 @@ // pragma translate_off reg ~TYPO ~GENSYM[rst][0]; localparam ~GENSYM[reset_period][1] = ~LONGESTPERIOD0 - 10 + (~LIT[2] * ~PERIOD[0]0); - `ifndef VERILATOR 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 - `else - always begin - // The redundant (~SYM[0] | ~ ~SYM[0]) is needed to ensure that this is - // calculated in every cycle by verilator. Without it, the reset will stop - // being updated and will be stuck as asserted forever. - ~SYM[0] = $c("this->~GENSYM[reset_gen][2](",~SYM[1],",~IF~ISACTIVEHIGH[0]~THENtrue~ELSEfalse~FI)") & (~SYM[0] | ~ ~SYM[0]); - end - `systemc_interface - CData ~SYM[2](vluint32_t reset_period, bool active_high) { - static vluint32_t to_wait = reset_period; - static CData reset = active_high ? 1 : 0; - static bool finished = false; - - if(!finished) { - if(to_wait == 0) { - reset = reset == 0 ? 1 : 0; - finished = true; - } - else { - to_wait = to_wait - 1; - } - } - - return reset; - } - `verilog - `endif assign ~RESULT = ~SYM[0]; // pragma translate_on // resetGen end diff --git a/prims/verilog/Clash_Sized_Vector.primitives.yaml b/prims/verilog/Clash_Sized_Vector.primitives.yaml --- a/prims/verilog/Clash_Sized_Vector.primitives.yaml +++ b/prims/verilog/Clash_Sized_Vector.primitives.yaml @@ -86,15 +86,16 @@ // 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 + for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[map][2] + localparam ~GENSYM[vec_index][5] = ~MAXINDEX[~TYPO] - ~SYM[1];~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 + assign ~SYM[3] = ~VAR[vec][1][~SYM[5]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI ~OUTPUTUSAGE[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]; + assign ~RESULT[~SYM[5]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[4]; end ~ENDGENERATE // map end @@ -108,18 +109,19 @@ genvar ~GENSYM[i][1]; ~GENERATE for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + localparam ~GENSYM[vec_index][6] = ~MAXINDEX[~TYPO] - ~SYM[1]; 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 + assign ~SYM[4] = ~VAR[vec][2][~SYM[6]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI ~OUTPUTUSAGE[1] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; - assign ~SYM[3] = ~SIZE[~INDEXTYPE[~LIT[0]]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~INDEXTYPE[~LIT[0]]]]; + assign ~SYM[3] = ~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]; + assign ~RESULT[~SYM[6]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; end ~ENDGENERATE // imap end @@ -129,25 +131,26 @@ kind: Declaration type: 'imap_go :: (Index n -> a -> b) -> Vec m a -> Index n -> Vec m b' template: |- - // imap begin + // imap_go begin genvar ~GENSYM[i][1]; ~GENERATE - for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap][2] + for (~SYM[1]=0; ~SYM[1] < ~LENGTH[~TYPO]; ~SYM[1] = ~SYM[1] + 1) begin : ~GENSYM[imap_go][2] + localparam ~GENSYM[vec_index][6] = ~MAXINDEX[~TYPO] - ~SYM[1]; wire ~TYP[2] ~GENSYM[map_index][3];~IF~SIZE[~TYP[1]]~THEN wire ~TYPEL[~TYP[1]] ~GENSYM[map_in][4]; - assign ~SYM[4] = ~VAR[vec][1][~SYM[1]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI + assign ~SYM[4] = ~VAR[vec][1][~SYM[6]*~SIZE[~TYPEL[~TYP[1]]]+:~SIZE[~TYPEL[~TYP[1]]]];~ELSE ~FI ~OUTPUTUSAGE[0] ~TYPEL[~TYPO] ~GENSYM[map_out][5]; - assign ~SYM[3] = ~SIZE[~TYP[2]]'d~MAXINDEX[~TYPO] - ~SYM[1][0+:~SIZE[~TYP[2]]] + ~ARG[2]; + assign ~SYM[3] = ~SYM[1][0+:~SIZE[~TYP[2]]] + ~ARG[2]; ~INST 0 ~OUTPUT <= ~SYM[5]~ ~TYPEL[~TYPO]~ ~INPUT <= ~SYM[3]~ ~TYP[2]~ ~INPUT <= ~SYM[4]~ ~TYPEL[~TYP[1]]~ ~INST - assign ~RESULT[~SYM[1]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; + assign ~RESULT[~SYM[6]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; end ~ENDGENERATE - // imap end + // imap_go end workInfo: Never - BlackBox: name: Clash.Sized.Vector.zipWith @@ -157,18 +160,19 @@ // 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 + for (~SYM[2] = 0; ~SYM[2] < ~LENGTH[~TYPO]; ~SYM[2] = ~SYM[2] + 1) begin : ~GENSYM[zipWith][6] + localparam ~GENSYM[vec_index][7] = ~MAXINDEX[~TYPO] - ~SYM[2];~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 + assign ~SYM[3] = ~VAR[vec1][1][~SYM[7]*~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 - ~OUTPUTUSAGE[0] ~TYPEL[~TYPO] ~SYM[5]; + assign ~SYM[4] = ~VAR[vec2][2][~SYM[7]*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI + ~OUTPUTUSAGE[0] ~TYPEL[~TYPO] ~GENSYM[zip_out][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]; + assign ~RESULT[~SYM[7]*~SIZE[~TYPEL[~TYPO]]+:~SIZE[~TYPEL[~TYPO]]] = ~SYM[5]; end ~ENDGENERATE // zipWith end @@ -185,8 +189,9 @@ 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 + localparam ~GENSYM[vec_index][8] = ~MAXINDEX[~TYP[2]] - ~SYM[3]; 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 + assign ~SYM[5] = ~VAR[xs][2][(~SYM[8])*~SIZE[~TYPEL[~TYP[2]]]+:~SIZE[~TYPEL[~TYP[2]]]];~ELSE ~FI wire ~TYPO ~GENSYM[foldr_in2][6]; ~OUTPUTUSAGE[0] ~TYPO ~GENSYM[foldr_out][7]; diff --git a/prims/verilog/Clash_Xilinx_DDR.primitives.yaml b/prims/verilog/Clash_Xilinx_DDR.primitives.yaml --- a/prims/verilog/Clash_Xilinx_DDR.primitives.yaml +++ b/prims/verilog/Clash_Xilinx_DDR.primitives.yaml @@ -3,37 +3,40 @@ 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal domDDR (BitVector n) -- ARG[9] + -> Signal dom (BitVector n, BitVector n) template: |- // iddr begin - wire ~SIGD[~GENSYM[data_pos][1]][7]; - wire ~SIGD[~GENSYM[data_neg][2]][7]; - wire ~SIGD[~GENSYM[d][3]][7]; - assign ~SYM[3] = ~ARG[7]; + wire ~SIGD[~GENSYM[data_pos][1]][9]; + wire ~SIGD[~GENSYM[data_neg][2]][9]; + wire ~SIGD[~GENSYM[d][3]][9]; + assign ~SYM[3] = ~ARG[9]; genvar ~GENSYM[i][8]; ~GENERATE - for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddri_array][7] + for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[9]]; ~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) + .SRTYPE(~IF ~ISSYNC[1] ~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), + .C(~ARG[6]), + .CE(~IF ~ISACTIVEENABLE[8] ~THEN ~ARG[8] ~ELSE 1'b1 ~FI), .D(~SYM[3][~SYM[8]]), - .R(~ARG[5]), + .R(~ARG[7]), .S(1'b0) ); end @@ -46,38 +49,42 @@ 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal dom (BitVector n) -- ARG[9] + -> Signal dom (BitVector n) -- ARG[10] + -> Signal domDDR (BitVector n) template: |- // oddr begin - wire ~SIGD[~GENSYM[data_pos][1]][7]; - wire ~SIGD[~GENSYM[data_neg][2]][7]; - wire ~SIGD[~GENSYM[q][3]][7]; + wire ~SIGD[~GENSYM[data_pos][1]][10]; + wire ~SIGD[~GENSYM[data_neg][2]][10]; + wire ~SIGD[~GENSYM[q][3]][10]; - assign ~SYM[1] = ~ARG[6]; - assign ~SYM[2] = ~ARG[7]; + assign ~SYM[1] = ~ARG[9]; + assign ~SYM[2] = ~ARG[10]; genvar ~GENSYM[i][8]; ~GENERATE - for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[7]]; ~SYM[8]=~SYM[8]+1) begin : ~GENSYM[ddro_array][7] + for (~SYM[8]=0; ~SYM[8] < ~SIZE[~TYP[10]]; ~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), + .C(~ARG[6]), + .CE(~IF ~ISACTIVEENABLE[8] ~THEN ~ARG[8] ~ELSE 1'b1 ~FI), .D1(~SYM[1][~SYM[8]]), .D2(~SYM[2][~SYM[8]]), - .R(~ARG[4]), + .R(~ARG[7]), .S(1'b0) ); end diff --git a/prims/vhdl/Clash_Class_BitPack.primitives.yaml b/prims/vhdl/Clash_Class_BitPack.primitives.yaml --- a/prims/vhdl/Clash_Class_BitPack.primitives.yaml +++ b/prims/vhdl/Clash_Class_BitPack.primitives.yaml @@ -5,8 +5,128 @@ template: std_logic_vector(~ARG[0]) workInfo: Never - BlackBox: + name: Clash.Class.BitPack.Internal.packInt8# + kind: Expression + type: 'packInt8# :: Int8 -> Bitvector 8' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt16# + kind: Expression + type: 'packInt16# :: Int16 -> Bitvector 16' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt32# + kind: Expression + type: 'packInt32# :: Int32 -> Bitvector 32' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt64# + kind: Expression + type: 'packInt64# :: Int64 -> Bitvector 64' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord# + kind: Expression + type: 'packWord# :: Word -> Bitvector WORD_SIZE_IN_BITS' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord8# + kind: Expression + type: 'packWord8# :: Word8 -> Bitvector 8' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord16# + kind: Expression + type: 'packWord16# :: Word16 -> Bitvector 16' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord32# + kind: Expression + type: 'packWord32# :: Word32 -> Bitvector 32' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord64# + kind: Expression + type: 'packWord64# :: Word64 -> Bitvector 64' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packCUShort# + kind: Expression + type: 'packCUShort# :: CUShort -> Bitvector 16' + template: std_logic_vector(~ARG[0]) + workInfo: Never +- BlackBox: name: Clash.Class.BitPack.Internal.unpackChar# kind: Expression type: 'unpackChar# :: BitVector 21 -> Char' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt8# + kind: Expression + type: 'unpackInt8# :: Bitvector 8 -> Int8' + template: signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt16# + kind: Expression + type: 'unpackInt16# :: Bitvector 16 -> Int16' + template: signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt32# + kind: Expression + type: 'unpackInt32# :: Bitvector 32 -> Int32' + template: signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt64# + kind: Expression + type: 'unpackInt64# :: Bitvector 64 -> Int64' + template: signed(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord# + kind: Expression + type: 'unpackWord# :: Bitvector WORD_SIZE_IN_BITS -> Word' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord8# + kind: Expression + type: 'unpackWord8# :: Bitvector 8 -> Word8' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord16# + kind: Expression + type: 'unpackWord16# :: Bitvector 16 -> Word16' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord32# + kind: Expression + type: 'unpackWord32# :: Bitvector 32 -> Word32' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord64# + kind: Expression + type: 'unpackWord64# :: Bitvector 64 -> Word64' + template: unsigned(~ARG[0]) + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackCUShort# + kind: Expression + type: 'unpackCUShort# :: Bitvector 16 -> CUShort' template: unsigned(~ARG[0]) workInfo: Never diff --git a/prims/vhdl/Clash_Explicit_DDR.primitives.yaml b/prims/vhdl/Clash_Explicit_DDR.primitives.yaml --- a/prims/vhdl/Clash_Explicit_DDR.primitives.yaml +++ b/prims/vhdl/Clash_Explicit_DDR.primitives.yaml @@ -2,57 +2,58 @@ name: Clash.Explicit.DDR.ddrIn# kind: Declaration type: |- - ddrIn# :: forall a slow fast n pFast enabled synchronous. - ( HasCallStack -- ARG[0] - , NFDataX 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) + ddrIn# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> a -- ARG[9] + -> a -- ARG[10] + -> Signal domDDR a -- ARG[11] + -> Signal dom (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]; + signal ~GENSYM[data_Pos][1] : ~TYP[11]; + signal ~GENSYM[data_Neg][2] : ~TYP[11]; + signal ~GENSYM[data_Neg_Latch][3] : ~TYP[11]; begin - ~IF ~ISSYNC[3] ~THEN + ~IF ~ISSYNC[2] ~THEN -- sync ------------- - ~GENSYM[~COMPNAME_ddrIn_pos][6] : process(~ARG[4]) + ~GENSYM[~COMPNAME_ddrIn_pos][6] : process(~ARG[5]) 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]; + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[9]; + els~IF ~ISACTIVEENABLE[7] ~THENif ~ARG[7] then~ELSEe~FI + ~SYM[1] <= ~ARG[11]; end if; end if; end process; - ~GENSYM[~COMPNAME_ddrIn_neg][7] : process(~ARG[4]) + ~GENSYM[~COMPNAME_ddrIn_neg][7] : process(~ARG[5]) 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 + if ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[5]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then ~SYM[2] <= ~ARG[10]; + els~IF ~ISACTIVEENABLE[7] ~THENif ~ARG[7] then~ELSEe~FI + ~SYM[2] <= ~ARG[11]; end if; end if; end process; - ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] : process(~ARG[4]) + ~GENSYM[~COMPNAME_ddrIn_neg_latch][8] : process(~ARG[5]) 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 + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[3] <= ~ARG[8]; + els~IF ~ISACTIVEENABLE[7] ~THENif ~ARG[7] then~ELSEe~FI ~SYM[3] <= ~SYM[2]; end if; end if; @@ -60,29 +61,29 @@ ~ELSE -- async -------------- - ~SYM[6] : process(~ARG[4],~ARG[5]) + ~SYM[6] : process(~ARG[5],~ARG[6]) 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]; + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[1] <= ~ARG[9]; + elsif ~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + ~SYM[1] <= ~ARG[11]; end if; end process; - ~SYM[7] : process(~ARG[4],~ARG[5]) + ~SYM[7] : process(~ARG[5],~ARG[6]) 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 + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then ~SYM[2] <= ~ARG[10]; + elsif ~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENfalling_edge~ELSErising_edge~FI(~ARG[5]) then + ~SYM[2] <= ~ARG[11]; end if; end process; - ~SYM[8] : process(~ARG[4],~ARG[5]) + ~SYM[8] : process(~ARG[5],~ARG[6]) 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 + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[3] <= ~ARG[8]; + elsif ~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then ~SYM[3] <= ~SYM[2]; end if; end process; @@ -94,68 +95,70 @@ name: Clash.Explicit.DDR.ddrOut# kind: Declaration type: |- - ddrOut# :: ( HasCallStack -- ARG[0] - , NFDataX 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 + ddrOut# :: forall a dom domDDR + . HasCallStack -- ARG[0] + => NFDataX a -- ARG[1] + => KnownDomain dom -- ARG[2] + => KnownDomain domDDR -- ARG[3] + => DomPeriod ~ 2 * ... -- ARG[4] + => Clock dom -- ARG[5] + -> Reset dom -- ARG[6] + -> Enable dom -- ARG[7] + -> a -- ARG[8] + -> Signal dom a -- ARG[9] + -> Signal dom a -- ARG[10] + -> Signal domDDR a template: |- -- ddrOut begin ~GENSYM[~COMPNAME_ddrOut][0] : block - signal ~GENSYM[data_Pos][1] : ~TYP[7]; - signal ~GENSYM[data_Neg][2] : ~TYP[7]; + signal ~GENSYM[data_Pos][1] : ~TYP[8]; + signal ~GENSYM[data_Neg][2] : ~TYP[8]; begin - ~IF ~ISSYNC[3] ~THEN + ~IF ~ISSYNC[2] ~THEN -- sync ------------- - ~GENSYM[~COMPNAME_ddrOut_pos][5] : process(~ARG[4]) + ~GENSYM[~COMPNAME_ddrOut_pos][5] : process(~ARG[5]) 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 + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then ~SYM[1] <= ~ARG[8]; + els~IF ~ISACTIVEENABLE[7] ~THENif ~ARG[7] then~ELSEe~FI + ~SYM[1] <= ~ARG[9]; end if; end if; end process; - ~GENSYM[~COMPNAME_ddrOut_neg][6] : process(~ARG[4]) + ~GENSYM[~COMPNAME_ddrOut_neg][6] : process(~ARG[5]) 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]; + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[8]; + els~IF ~ISACTIVEENABLE[7] ~THENif ~ARG[7] then~ELSEe~FI + ~SYM[2] <= ~ARG[10]; end if; end if; end process; ~ELSE -- async -------------- - ~SYM[5] : process(~ARG[4],~ARG[5]~VARS[8]) + ~SYM[5] : process(~ARG[5],~ARG[6]~VARS[9]) begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[1] <= ~ARG[7]; - elsif ~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then ~SYM[1] <= ~ARG[8]; + elsif ~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + ~SYM[1] <= ~ARG[9]; end if; end process; - ~SYM[6] : process(~ARG[4],~ARG[5]~VARS[9]) + ~SYM[6] : process(~ARG[5],~ARG[6]~VARS[10]) begin - if ~ARG[5] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then - ~SYM[2] <= ~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[2] <= ~ARG[9]; + if ~ARG[6] = ~IF~ISACTIVEHIGH[2]~THEN'1'~ELSE'0'~FI then + ~SYM[2] <= ~ARG[8]; + elsif ~IF ~ISACTIVEENABLE[7] ~THEN ~ARG[7] and ~ELSE ~FI ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[5]) then + ~SYM[2] <= ~ARG[10]; end if; end process; ~FI - ~RESULT <= ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI when (~ARG[4] = '1') else ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; + ~RESULT <= ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[1]~ELSE~SYM[2]~FI when (~ARG[5] = '1') else ~IF~ACTIVEEDGE[Rising][2]~THEN~SYM[2]~ELSE~SYM[1]~FI; end block; -- ddrOut end diff --git a/prims/vhdl/Clash_Intel_DDR.primitives.yaml b/prims/vhdl/Clash_Intel_DDR.primitives.yaml --- a/prims/vhdl/Clash_Intel_DDR.primitives.yaml +++ b/prims/vhdl/Clash_Intel_DDR.primitives.yaml @@ -7,39 +7,42 @@ - altera_mf 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) + :: forall deviceFamily n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => SSymbol deviceFamily -- ARG[6] + -> Clock dom -- ARG[7] + -> Reset dom -- ARG[8] + -> Enable dom -- ARG[9] + -> Signal domDDR (BitVector n) -- ARG[10] + -> Signal dom (BitVector n, BitVector n) 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[dataout_l][1] : ~TYP[10]; + signal ~GENSYM[dataout_h][2] : ~TYP[10];~IF ~ISACTIVEENABLE[9] ~THEN signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI - begin~IF ~ISACTIVEENABLE[7] ~THEN - ~SYM[4] <= '1' when (~ARG[7]) else '0';~ELSE ~FI + begin~IF ~ISACTIVEENABLE[9] ~THEN + ~SYM[4] <= '1' when (~ARG[9]) else '0';~ELSE ~FI ~GENSYM[~COMPNAME_ALTDDIO_IN][7] : ALTDDIO_IN GENERIC MAP ( - intended_device_family => ~LIT[4], + intended_device_family => ~LIT[6], invert_input_clocks => "OFF", lpm_hint => "UNUSED", lpm_type => "altddio_in", power_up_high => "OFF", - width => ~SIZE[~TYP[8]] + width => ~SIZE[~TYP[10]] ) - PORT MAP (~IF ~ISSYNC[6] ~THEN - sclr => ~ARG[6],~ELSE - aclr => ~ARG[6],~FI - datain => ~ARG[8],~IF ~ISACTIVEENABLE[7] ~THEN + PORT MAP (~IF ~ISSYNC[1] ~THEN + sclr => ~ARG[8],~ELSE + aclr => ~ARG[8],~FI + datain => ~ARG[10],~IF ~ISACTIVEENABLE[9] ~THEN inclocken => ~SYM[4],~ELSE ~FI - inclock => ~ARG[5], + inclock => ~ARG[7], dataout_h => ~SYM[2], dataout_l => ~SYM[1] ); @@ -55,27 +58,30 @@ - altera_mf 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) + :: forall deviceFamily n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => SSymbol deviceFamily -- ARG[6] + -> Clock dom -- ARG[7] + -> Reset dom -- ARG[8] + -> Enable dom -- ARG[9] + -> Signal dom (BitVector n) -- ARG[10] + -> Signal dom (BitVector n) -- ARG[11] + -> Signal domDDR (BitVector n) template: |- -- altddioOut begin - ~GENSYM[~COMPNAME_ALTDDIO_OUT][0] : block ~IF ~ISACTIVEENABLE[7] ~THEN + ~GENSYM[~COMPNAME_ALTDDIO_OUT][0] : block ~IF ~ISACTIVEENABLE[9] ~THEN signal ~GENSYM[ce_logic][1] : std_logic; ~ELSE ~FI - begin~IF ~ISACTIVEENABLE[7] ~THEN - ~SYM[1] <= '1' when (~ARG[7]) else '0'; ~ELSE ~FI + begin~IF ~ISACTIVEENABLE[9] ~THEN + ~SYM[1] <= '1' when (~ARG[9]) else '0'; ~ELSE ~FI ~GENSYM[~COMPNAME_ALTDDIO_OUT][7] : ALTDDIO_OUT GENERIC MAP ( extend_oe_disable => "OFF", - intended_device_family => ~LIT[4], + intended_device_family => ~LIT[6], invert_output => "OFF", lpm_hint => "UNUSED", lpm_type => "altddio_out", @@ -83,13 +89,13 @@ 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 + PORT MAP (~IF ~ISSYNC[1] ~THEN + sclr => ~ARG[8],~ELSE + aclr => ~ARG[8],~FI ~IF ~ISACTIVEENABLE[9] ~THEN outclocken => ~SYM[1],~ELSE ~FI - outclock => ~ARG[5], - datain_h => ~ARG[8], - datain_l => ~ARG[9], + outclock => ~ARG[7], + datain_h => ~ARG[10], + datain_l => ~ARG[11], dataout => ~RESULT ); end block; diff --git a/prims/vhdl/Clash_Sized_Internal_Index.primitives.yaml b/prims/vhdl/Clash_Sized_Internal_Index.primitives.yaml --- a/prims/vhdl/Clash_Sized_Internal_Index.primitives.yaml +++ b/prims/vhdl/Clash_Sized_Internal_Index.primitives.yaml @@ -1,16 +1,16 @@ - BlackBox: name: Clash.Sized.Internal.Index.pack# kind: Expression - type: 'pack# :: Index - n -> BitVector (CLog 2 n)' + type: |- + pack# :: Index n -> BitVector (CLogWZ 2 n 0) template: std_logic_vector(~ARG[0]) workInfo: Never - BlackBox: name: Clash.Sized.Internal.Index.unpack# kind: Expression - type: 'unpack# :: (KnownNat - n, 1 <= n) => BitVector (CLog 2 n) -> Index n' - template: unsigned(~ARG[2]) + type: |- + unpack# :: KnownNat n => BitVector (CLogWZ 2 n 0) -> Index n + template: unsigned(~ARG[1]) workInfo: Never - BlackBox: name: Clash.Sized.Internal.Index.eq# diff --git a/prims/vhdl/Clash_Xilinx_DDR.primitives.yaml b/prims/vhdl/Clash_Xilinx_DDR.primitives.yaml --- a/prims/vhdl/Clash_Xilinx_DDR.primitives.yaml +++ b/prims/vhdl/Clash_Xilinx_DDR.primitives.yaml @@ -7,25 +7,28 @@ - UNISIM 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal domDDR (BitVector n) -- ARG[9] + -> Signal dom (BitVector n, BitVector n) template: |- -- iddr begin ~GENSYM[~COMPNAME_IDDR][0] : block - signal ~GENSYM[data_pos][1] : ~TYP[7]; - signal ~GENSYM[data_neg][2] : ~TYP[7]; - signal ~GENSYM[d][3] : ~TYP[7];~IF ~ISACTIVEENABLE[6] ~THEN + signal ~GENSYM[data_pos][1] : ~TYP[9]; + signal ~GENSYM[data_neg][2] : ~TYP[9]; + signal ~GENSYM[d][3] : ~TYP[9];~IF ~ISACTIVEENABLE[8] ~THEN signal ~GENSYM[ce_logic][4]: std_logic;~ELSE ~FI - begin~IF ~ISACTIVEENABLE[6] ~THEN - ~SYM[4] <= '1' when (~ARG[6]) else '0';~ELSE ~FI - ~SYM[3] <= ~ARG[7]; + begin~IF ~ISACTIVEENABLE[8] ~THEN + ~SYM[4] <= '1' when (~ARG[8]) else '0';~ELSE ~FI + ~SYM[3] <= ~ARG[9]; ~GENSYM[gen_iddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate begin @@ -34,14 +37,14 @@ DDR_CLK_EDGE => "SAME_EDGE", INIT_Q1 => '0', INIT_Q2 => '0', - SRTYPE => ~IF ~ISSYNC[2] ~THEN "SYNC" ~ELSE "ASYNC" ~FI) + SRTYPE => ~IF ~ISSYNC[1] ~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 + C => ~ARG[6], -- 1-bit clock input + CE => ~IF ~ISACTIVEENABLE[8] ~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 + R => ~ARG[7], -- 1-bit reset S => '0' -- 1-bit set ); end generate; @@ -58,26 +61,30 @@ - UNISIM 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) + :: forall n dom domDDR + . HasCallStack -- ARG[0] + => KnownDomain dom -- ARG[1] + => KnownDomain domDDR -- ARG[2] + => DomPeriod ~ 2 * ... -- ARG[3] + => DomEdge ~ Rising -- ARG[4] + => KnownNat n -- ARG[5] + => Clock dom -- ARG[6] + -> Reset dom -- ARG[7] + -> Enable dom -- ARG[8] + -> Signal dom (BitVector n) -- ARG[9] + -> Signal dom (BitVector n) -- ARG[10] + -> Signal domDDR (BitVector n) template: |- -- oddr begin ~GENSYM[~COMPNAME_ODDR][0] : block signal ~GENSYM[data_pos][1] : ~TYPO; signal ~GENSYM[data_neg][2] : ~TYPO; - signal ~GENSYM[q][3] : ~TYPO;~IF ~ISACTIVEENABLE[5] ~THEN + signal ~GENSYM[q][3] : ~TYPO;~IF ~ISACTIVEENABLE[8] ~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]; + begin~IF ~ISACTIVEENABLE[8] ~THEN + ~SYM[4] <= '1' when (~ARG[8]) else '0';~ELSE ~FI + ~SYM[1] <= ~ARG[9]; + ~SYM[2] <= ~ARG[10]; ~GENSYM[gen_oddr][7] : for ~GENSYM[i][8] in ~SYM[3]'range generate begin @@ -88,11 +95,11 @@ SRTYPE => ~IF ~ISSYNC[1] ~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 + C => ~ARG[6], -- 1-bit clock input + CE => ~IF ~ISACTIVEENABLE[8] ~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 + R => ~ARG[7], -- 1-bit reset input S => '0' -- 1-bit set input ); end generate; diff --git a/src/Clash/Backend.hs b/src/Clash/Backend.hs --- a/src/Clash/Backend.hs +++ b/src/Clash/Backend.hs @@ -21,11 +21,7 @@ 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.Driver.Types (ClashOpts) import {-# SOURCE #-} Clash.Netlist.Types 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 @@ -238,14 +238,17 @@ where cName = componentName c verilog = commentHeader <> line <> - nettype <> line <> + nettypeNone <> line <> timescale <> line <> - module_ c + module_ c <> line <> + nettypeDefault + commentHeader = "/* AUTOMATICALLY GENERATED SYSTEMVERILOG-2005 SOURCE CODE." <> line <> "** GENERATED BY CLASH " <> string (Text.pack clashVer) <> ". DO NOT MODIFY." <> line <> "*/" - nettype = "`default_nettype none" + nettypeNone = "`default_nettype none" + nettypeDefault = "`default_nettype wire" timescale = "`timescale 100fs/" <> string (Text.pack precision) precision = periodToString (opt_timescalePrecision opts) 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 @@ -21,9 +21,6 @@ module Clash.Backend.VHDL (VHDLState) where import Control.Arrow (second) -#if !MIN_VERSION_base(4,18,0) -import Control.Applicative (liftA2) -#endif import Control.Lens hiding (Indexed, Empty) import Control.Monad (forM,join,zipWithM) import Control.Monad.State (State, StateT) 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 @@ -234,7 +234,11 @@ usages .= usage setSrcSpan sp - v <- commentHeader <> line <> nettype <> line <> timescale <> line <> module_ c + v <- commentHeader <> line <> + nettypeNone <> line <> + timescale <> line <> + module_ c <> line <> + nettypeDefault incs <- Ap $ use includes return ((TextS.unpack (Id.toText cName), v), incs) where @@ -243,7 +247,8 @@ = "/* AUTOMATICALLY GENERATED VERILOG-2001 SOURCE CODE." <> line <> "** GENERATED BY CLASH " <> string (Text.pack clashVer) <> ". DO NOT MODIFY." <> line <> "*/" - nettype = "`default_nettype none" + nettypeNone = "`default_nettype none" + nettypeDefault = "`default_nettype wire" timescale = "`timescale 100fs/" <> string (Text.pack precision) precision = periodToString (opt_timescalePrecision opts) diff --git a/src/Clash/Backend/Verilog/Time.hs b/src/Clash/Backend/Verilog/Time.hs --- a/src/Clash/Backend/Verilog/Time.hs +++ b/src/Clash/Backend/Verilog/Time.hs @@ -15,6 +15,9 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} +-- TryDomain instance +{-# OPTIONS_GHC -Wno-deprecations #-} + module Clash.Backend.Verilog.Time where import Clash.Class.HasDomain.HasSingleDomain 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 @@ -19,12 +19,8 @@ import Clash.Core.Var import Clash.Core.VarEnv (VarSet, elemVarSet, emptyVarSet, mkVarSet) import Clash.Unique (fromGhcUnique) -#if MIN_VERSION_ghc(9,0,0) import Clash.Core.DataCon (dcUniq) import GHC.Builtin.Names (unsafeReflDataConKey, eqPrimTyConKey, typeNatAddTyFamNameKey) -#else -import PrelNames (eqPrimTyConKey, typeNatAddTyFamNameKey) -#endif -- | Data type that indicates what kind of solution (if any) was found data TypeEqSolution @@ -139,12 +135,10 @@ :: TyConMap -> Pat -> Bool -#if MIN_VERSION_base(4,15,0) isAbsurdPat _tcm (DataPat dc _ _) -- unsafeCoerce is not absurd in the way intended by /isAbsurdPat/ | dcUniq dc == fromGhcUnique unsafeReflDataConKey = False -#endif isAbsurdPat tcm pat = any (isAbsurdEq tcm exts) (patEqs tcm pat) where diff --git a/src/Clash/Core/HasType.hs b/src/Clash/Core/HasType.hs --- a/src/Clash/Core/HasType.hs +++ b/src/Clash/Core/HasType.hs @@ -67,14 +67,12 @@ CharLiteral _ -> charPrimTy Int64Literal _ -> int64PrimTy Word64Literal _ -> word64PrimTy -#if MIN_VERSION_ghc(8,8,0) Int8Literal _ -> int8PrimTy Int16Literal _ -> int16PrimTy Int32Literal _ -> int32PrimTy Word8Literal _ -> word8PrimTy Word16Literal _ -> word16PrimTy Word32Literal _ -> word32PrimTy -#endif NaturalLiteral _ -> naturalPrimTy ByteArrayLiteral _ -> byteArrayPrimTy 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 @@ -51,14 +51,12 @@ | WordLiteral !Integer | Int64Literal !Integer | Word64Literal !Integer -#if MIN_VERSION_ghc(8,8,0) | Int8Literal !Integer | Int16Literal !Integer | Int32Literal !Integer | Word8Literal !Integer | Word16Literal !Integer | Word32Literal !Integer -#endif | StringLiteral !String | FloatLiteral !Word32 | DoubleLiteral !Word64 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 @@ -26,11 +26,7 @@ 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/Monad.hs b/src/Clash/Core/PartialEval/Monad.hs --- a/src/Clash/Core/PartialEval/Monad.hs +++ b/src/Clash/Core/PartialEval/Monad.hs @@ -63,10 +63,6 @@ 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 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 @@ -27,6 +27,7 @@ , tracePprId , tracePpr , fromPpr + , unsafeLookupEnvBool ) where @@ -47,11 +48,7 @@ #endif import GHC.Show (showMultiLineString) import GHC.Stack (HasCallStack) -#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) @@ -371,14 +368,12 @@ Int64Literal i -> parensIf (i < 0) (pretty i <> "#64") WordLiteral w -> pretty w <> "##" Word64Literal w -> pretty w <> "##64" -#if MIN_VERSION_ghc(8,8,0) Int8Literal i -> parensIf (i < 0) (pretty i <> "#8") Int16Literal i -> parensIf (i < 0) (pretty i <> "#16") Int32Literal i -> parensIf (i < 0) (pretty i <> "#32") Word8Literal w -> pretty w <> "##8" Word16Literal w -> pretty w <> "##16" Word32Literal w -> pretty w <> "##32" -#endif FloatLiteral w -> pretty (wordToFloat w) <> "#" DoubleLiteral w -> pretty (wordToDouble w) <> "##" CharLiteral c -> pretty c <> "#" 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 @@ -71,11 +71,7 @@ import Data.List (nub, partition) import Data.Text (Text) import GHC.Generics -#if MIN_VERSION_ghc(9,0,0) import GHC.Types.SrcLoc (SrcSpan, leftmost_smallest) -#else -import SrcLoc (SrcSpan, leftmost_smallest) -#endif -- Internal Modules import Clash.Core.DataCon (DataCon) 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 @@ -32,11 +32,9 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Extra (showt) -#if MIN_VERSION_ghc(9,4,0) import qualified Data.Text.Internal as Text import qualified Data.Text.Array as Text import qualified Data.Primitive.ByteArray as BA -#endif import Data.Typeable (Typeable, typeRep) import GHC.Natural import GHC.Stack @@ -101,12 +99,10 @@ instance TermLiteral Text where termToData (collectArgs -> (_, [Left (Literal (StringLiteral s))])) = Right (Text.pack s) -#if MIN_VERSION_ghc(9,4,0) termToData (collectArgs -> (_, [ Left (Literal (ByteArrayLiteral (BA.ByteArray ba))) , Left (Literal (IntLiteral off)) , Left (Literal (IntLiteral len))])) = Right (Text.Text (Text.ByteArray ba) (fromInteger off) (fromInteger len)) -#endif termToData t = Left t instance KnownNat n => TermLiteral (Index n) where 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 @@ -39,11 +39,7 @@ -- module Clash.Core.Subst cannot be linked; it is only available as a boot module import Clash.Core.Subst () -#if __GLASGOW_HASKELL__ >= 900 type CompatTyVarBndr = TyVarBndr () -#else -type CompatTyVarBndr = TyVarBndr -#endif dcName' :: DataCon -> String dcName' = Text.unpack . nameOcc . dcName @@ -66,15 +62,9 @@ -- | Extracts variable names from a 'TyVarBndr'. typeVarName :: CompatTyVarBndr -> Q (Name, Maybe Type) typeVarName = \case -#if __GLASGOW_HASKELL__ >= 900 PlainTV typVarName () -> pure (typVarName, Nothing) KindedTV typVarName () StarT -> pure (typVarName, Nothing) KindedTV typVarName () kind -> pure (typVarName, Just kind) -#else - PlainTV typVarName -> pure (typVarName, Nothing) - KindedTV typVarName StarT -> pure (typVarName, Nothing) - KindedTV typVarName kind -> pure (typVarName, Just kind) -#endif -- | Derive a t'Clash.Core.TermLiteral.TermLiteral' instance for given type deriveTermLiteral :: Name -> Q [Dec] @@ -222,11 +212,7 @@ termName (ViewP (VarE 'collectArgs) -#if MIN_VERSION_template_haskell(2,18,0) (TupP [ ConP 'Data [] [ViewP (VarE 'dcName') (VarP nameName)] -#else - (TupP [ ConP 'Data [ViewP (VarE 'dcName') (VarP nameName)] -#endif , ViewP (VarE 'lefts) (if nArgs == 0 then WildP else VarP argsName)])) 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 @@ -73,22 +73,15 @@ import GHC.Integer (smallInteger) import GHC.Integer.Logarithms (integerLogBase#) import GHC.TypeLits (type TypeError, ErrorMessage(Text, (:<>:))) -#if MIN_VERSION_base(4,16,0) import GHC.Base (ord) import Data.Char (chr) import Data.Maybe (fromMaybe) import Data.Text.Extra (showt) -#endif -- GHC API -#if MIN_VERSION_ghc(9,0,0) -#if MIN_VERSION_ghc(9,2,0) import GHC.Builtin.Names (typeCharCmpTyFamNameKey, typeConsSymbolTyFamNameKey, typeUnconsSymbolTyFamNameKey, typeCharToNatTyFamNameKey, typeNatToCharTyFamNameKey) -#else -import GHC.Builtin.Names (typeNatLeqTyFamNameKey) -#endif import GHC.Builtin.Names (integerTyConKey, typeNatAddTyFamNameKey, typeNatExpTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey, @@ -96,23 +89,6 @@ typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey, typeNatDivTyFamNameKey, typeNatModTyFamNameKey) import GHC.Types.SrcLoc (wiredInSrcSpan) -#else -#if __GLASGOW_HASKELL__ >= 808 -import PrelNames - (ordLTDataConKey, ordEQDataConKey, ordGTDataConKey) -#else -import Unique (Unique) -import PrelNames - (ltDataConKey, eqDataConKey, gtDataConKey) -#endif -import PrelNames - (integerTyConKey, typeNatAddTyFamNameKey, typeNatExpTyFamNameKey, - typeNatLeqTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey, - typeNatCmpTyFamNameKey, - typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey, - typeNatDivTyFamNameKey, typeNatModTyFamNameKey) -import SrcLoc (wiredInSrcSpan) -#endif -- Local imports import Clash.Annotations.SynthesisAttributes @@ -125,13 +101,6 @@ import Clash.Unique (fromGhcUnique) import Clash.Util -#if __GLASGOW_HASKELL__ <= 806 -ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique.Unique -ordLTDataConKey = ltDataConKey -ordEQDataConKey = eqDataConKey -ordGTDataConKey = gtDataConKey -#endif - varAttrs :: Var a -> [Attr Text] varAttrs t@(TyVar {}) = error $ $(curLoc) ++ "Unexpected argument: " ++ show t @@ -545,19 +514,6 @@ -> Just (LitTy (NumTy z)) _ -> Nothing -#if !MIN_VERSION_ghc(9,2,0) - | nameUniq tc == fromGhcUnique typeNatLeqTyFamNameKey - = case mapMaybe (litView tcm) tys of - [i1, i2] - | Just (FunTyCon {tyConKind = tck}) <- UniqMap.lookup tc tcm - , (_,tyView -> TyConApp boolTcNm []) <- splitFunTys tcm tck - , Just boolTc <- UniqMap.lookup boolTcNm tcm - -> let [falseTc,trueTc] = map (coerce . dcName) (tyConDataCons boolTc) - in if i1 <= i2 then Just (mkTyConApp trueTc []) - else Just (mkTyConApp falseTc []) - _ -> Nothing -#endif - | nameUniq tc == fromGhcUnique typeNatCmpTyFamNameKey -- "GHC.TypeNats.CmpNat" = case mapMaybe (litView tcm) tys of [i1, i2] -> @@ -584,7 +540,6 @@ (fromGhcUnique ordGTDataConKey) wiredInSrcSpan _ -> Nothing -#if MIN_VERSION_base(4,16,0) | nameUniq tc == fromGhcUnique typeCharCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol" = case mapMaybe (charLitView tcm) tys of [s1, s2] -> @@ -629,7 +584,6 @@ | nameUniq tc == fromGhcUnique typeNatToCharTyFamNameKey -- NatToChar , [n1] <- mapMaybe (litView tcm) tys = Just (LitTy (CharTy (chr (fromInteger n1)))) -#endif | nameUniq tc == fromGhcUnique typeSymbolAppendFamNameKey -- GHC.TypeLits.AppendSymbol" = case mapMaybe (symLitView tcm) tys of @@ -692,7 +646,6 @@ -> Just (LitTy (NumTy (i1 `mod` i2))) _ -> Nothing -#if MIN_VERSION_base(4,11,0) | nameUniq tc == fromGhcUnique typeNatDivTyFamNameKey = case mapMaybe (litView tcm) tys of [i1, i2] @@ -706,7 +659,6 @@ | i2 > 0 -> Just (LitTy (NumTy (i1 `mod` i2))) _ -> Nothing -#endif | Just (FunTyCon {tyConSubst = tcSubst}) <- UniqMap.lookup tc tcm = let -- See [Note: Eager type families] @@ -736,12 +688,10 @@ symLitView m (reduceTypeFamily m -> Just ty') = symLitView m ty' symLitView _ _ = Nothing -#if MIN_VERSION_base(4,16,0) charLitView :: TyConMap -> Type -> Maybe Char charLitView _ (LitTy (CharTy c)) = Just c charLitView m (reduceTypeFamily m -> Just t) = charLitView m t charLitView _ _ = Nothing -#endif isIntegerTy :: Type -> Bool isIntegerTy (ConstTy (TyCon nm)) = nameUniq nm == fromGhcUnique integerTyConKey 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 @@ -1,7 +1,7 @@ {-| Copyright : (C) 2012-2016, University of Twente, 2016 , Myrtle Software Ltd, - 2021-2024, QBayLogic B.V. + 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -21,46 +21,34 @@ , integerPrimTy , charPrimTy , stringPrimTy -#if !MIN_VERSION_ghc(9,2,0) - , voidPrimTy -#endif , wordPrimTy , int64PrimTy , word64PrimTy -#if MIN_VERSION_ghc(8,8,0) , int8PrimTy , int16PrimTy , int32PrimTy , word8PrimTy , word16PrimTy , word32PrimTy -#endif , floatPrimTy , doublePrimTy , naturalPrimTy , byteArrayPrimTy , eqPrimTy , tysPrimMap + , integerIsDc + , naturalNsDc ) where - -#if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names -#else -import PrelNames -#endif -#if MIN_VERSION_ghc(8,8,0) import GHC.Base hiding (Type, TyCon) import Data.Text.Extra (showt) -#endif -#if MIN_VERSION_base(4,17,0) import Clash.Core.DataCon (DataCon(..), DcStrictness(..)) import GHC.Num.Integer (Integer(..)) import GHC.Num.Natural (Natural(..)) -#endif import Clash.Core.Name import Clash.Core.TyCon @@ -73,12 +61,7 @@ liftedTypeKindTyConName, typeNatKindTyConName, typeSymbolKindTyConName :: TyConName liftedTypeKindTyConName = mkUnsafeSystemName "Type" (fromGhcUnique liftedTypeKindTyConKey) -#if MIN_VERSION_ghc(9,2,0) typeNatKindTyConName = naturalPrimTyConName -#else -typeNatKindTyConName = mkUnsafeSystemName "Nat" - (fromGhcUnique typeNatKindConNameKey) -#endif typeSymbolKindTyConName = mkUnsafeSystemName "Symbol" (fromGhcUnique typeSymbolKindConNameKey) @@ -97,47 +80,32 @@ wordPrimTyConName, int64PrimTyConName, word64PrimTyConName, floatPrimTyConName, doublePrimTyConName, naturalPrimTyConName, byteArrayPrimTyConName, eqPrimTyConName :: TyConName -intPrimTyConName = mkUnsafeSystemName "GHC.Prim.Int#" +intPrimTyConName = mkUnsafeSystemName (showt ''Int#) (fromGhcUnique intPrimTyConKey) -#if MIN_VERSION_base(4,15,0) -integerPrimTyConName = mkUnsafeSystemName "GHC.Num.Integer.Integer" - (fromGhcUnique integerTyConKey) -#else -integerPrimTyConName = mkUnsafeSystemName "GHC.Integer.Type.Integer" +integerPrimTyConName = mkUnsafeSystemName (showt ''Integer) (fromGhcUnique integerTyConKey) -#endif -stringPrimTyConName = mkUnsafeSystemName "GHC.Prim.Addr#" +stringPrimTyConName = mkUnsafeSystemName (showt ''Addr#) (fromGhcUnique addrPrimTyConKey) -charPrimTyConName = mkUnsafeSystemName "GHC.Prim.Char#" +charPrimTyConName = mkUnsafeSystemName (showt ''Char#) (fromGhcUnique charPrimTyConKey) -wordPrimTyConName = mkUnsafeSystemName "GHC.Prim.Word#" +wordPrimTyConName = mkUnsafeSystemName (showt ''Word#) (fromGhcUnique wordPrimTyConKey) -int64PrimTyConName = mkUnsafeSystemName "GHC.Prim.Int64#" +int64PrimTyConName = mkUnsafeSystemName (showt ''Int64#) (fromGhcUnique int64PrimTyConKey) -word64PrimTyConName = mkUnsafeSystemName "GHC.Prim.Word64#" +word64PrimTyConName = mkUnsafeSystemName (showt ''Word64#) (fromGhcUnique word64PrimTyConKey) -floatPrimTyConName = mkUnsafeSystemName "GHC.Prim.Float#" +floatPrimTyConName = mkUnsafeSystemName (showt ''Float#) (fromGhcUnique floatPrimTyConKey) -doublePrimTyConName = mkUnsafeSystemName "GHC.Prim.Double#" +doublePrimTyConName = mkUnsafeSystemName (showt ''Double#) (fromGhcUnique doublePrimTyConKey) -#if MIN_VERSION_base(4,15,0) -naturalPrimTyConName = mkUnsafeSystemName "GHC.Num.Natural.Natural" - (fromGhcUnique naturalTyConKey) -#else -naturalPrimTyConName = mkUnsafeSystemName "GHC.Natural.Natural" +naturalPrimTyConName = mkUnsafeSystemName (showt ''Natural) (fromGhcUnique naturalTyConKey) -#endif -byteArrayPrimTyConName = mkUnsafeSystemName "GHC.Prim.ByteArray#" +byteArrayPrimTyConName = mkUnsafeSystemName (showt ''ByteArray#) (fromGhcUnique byteArrayPrimTyConKey) eqPrimTyConName = mkUnsafeSystemName "GHC.Prim.~#" (fromGhcUnique eqPrimTyConKey) -#if !MIN_VERSION_ghc(9,2,0) -voidPrimTyConName :: TyConName -voidPrimTyConName = mkUnsafeSystemName "Void#" (fromGhcUnique voidPrimTyConKey) -#endif -#if MIN_VERSION_ghc(8,8,0) int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word32PrimTyConName :: TyConName int8PrimTyConName = mkUnsafeSystemName (showt ''Int8#) @@ -152,7 +120,6 @@ (fromGhcUnique word16PrimTyConKey) word32PrimTyConName = mkUnsafeSystemName (showt ''Word32#) (fromGhcUnique word32PrimTyConKey) -#endif liftedPrimTC :: TyConName -> TyCon @@ -163,7 +130,7 @@ int64PrimTc, word64PrimTc, floatPrimTc, doublePrimTc, naturalPrimTc, byteArrayPrimTc :: TyCon intPrimTc = liftedPrimTC intPrimTyConName -#if MIN_VERSION_base(4,17,0) + -- While GHC might have dropped Integer and Natural literals, in Clash it is -- still nice to have them around. However, Integer and Natural are also no -- longer primitive types in GHC, but we still want to give the Integer and @@ -172,10 +139,9 @@ -- So instead of recording the primitive types, we record the algebraic types, -- i.e. the complete data type for Integer and Natural, data constructors and all. -integerPrimTc = - let - name = integerPrimTyConName - uniq = nameUniq name +integerIsDc, naturalNsDc :: DataCon +integerIsDc = isDc + where isDcNm = mkUnsafeSystemName (showt 'IS) (fromGhcUnique integerISDataConKey) isDc = MkData { dcName = isDcNm @@ -188,6 +154,12 @@ , dcArgStrict = [Strict] , dcFieldLabels = [] } + +integerPrimTc = + let + name = integerPrimTyConName + uniq = nameUniq name + isDc = integerIsDc ipDcNm = mkUnsafeSystemName (showt 'IP) (fromGhcUnique integerIPDataConKey) ipDc = MkData { dcName = ipDcNm @@ -216,10 +188,8 @@ in AlgTyCon uniq name liftedTypeKind 0 rhs False -naturalPrimTc = - let - name = naturalPrimTyConName - uniq = nameUniq name +naturalNsDc = nsDc + where nsDcNm = mkUnsafeSystemName (showt 'NS) (fromGhcUnique naturalNSDataConKey) nsDc = MkData { dcName = nsDcNm @@ -232,6 +202,12 @@ , dcArgStrict = [Strict] , dcFieldLabels = [] } + +naturalPrimTc = + let + name = naturalPrimTyConName + uniq = nameUniq name + nsDc = naturalNsDc nbDcNm = mkUnsafeSystemName (showt 'NB) (fromGhcUnique naturalNBDataConKey) nbDc = MkData { dcName = nbDcNm @@ -247,10 +223,6 @@ rhs = DataTyCon [nsDc,nbDc] in AlgTyCon uniq name liftedTypeKind 0 rhs False -#else -integerPrimTc = liftedPrimTC integerPrimTyConName -naturalPrimTc = liftedPrimTC naturalPrimTyConName -#endif charPrimTc = liftedPrimTC charPrimTyConName stringPrimTc = liftedPrimTC stringPrimTyConName wordPrimTc = liftedPrimTC wordPrimTyConName @@ -260,12 +232,7 @@ doublePrimTc = liftedPrimTC doublePrimTyConName byteArrayPrimTc = liftedPrimTC byteArrayPrimTyConName -#if !MIN_VERSION_ghc(9,2,0) -voidPrimTc :: TyCon -voidPrimTc = liftedPrimTC voidPrimTyConName -#endif -#if MIN_VERSION_ghc(8,8,0) int8PrimTc, int16PrimTc, int32PrimTc, word8PrimTc, word16PrimTc, word32PrimTc :: TyCon int8PrimTc = liftedPrimTC int8PrimTyConName @@ -274,7 +241,6 @@ word8PrimTc = liftedPrimTC word8PrimTyConName word16PrimTc = liftedPrimTC word16PrimTyConName word32PrimTc = liftedPrimTC word32PrimTyConName -#endif eqPrimTc :: TyCon eqPrimTc = PrimTyCon (nameUniq eqPrimTyConName) eqPrimTyConName ty 4 @@ -305,12 +271,6 @@ byteArrayPrimTy = mkTyConTy byteArrayPrimTyConName eqPrimTy = mkTyConTy eqPrimTyConName -#if !MIN_VERSION_ghc(9,2,0) -voidPrimTy :: Type -voidPrimTy = mkTyConTy voidPrimTyConName -#endif - -#if MIN_VERSION_ghc(8,8,0) int8PrimTy, int16PrimTy, int32PrimTy, word8PrimTy, word16PrimTy, word32PrimTy :: Type int8PrimTy = mkTyConTy int8PrimTyConName @@ -319,7 +279,6 @@ word8PrimTy = mkTyConTy word8PrimTyConName word16PrimTy = mkTyConTy word16PrimTyConName word32PrimTy = mkTyConTy word32PrimTyConName -#endif tysPrimMap :: TyConMap tysPrimMap = UniqMap.fromList @@ -330,20 +289,15 @@ , (integerPrimTyConName , integerPrimTc) , (charPrimTyConName , charPrimTc) , (stringPrimTyConName , stringPrimTc) -#if !MIN_VERSION_ghc(9,2,0) - , (voidPrimTyConName , voidPrimTc) -#endif , (wordPrimTyConName , wordPrimTc) , (int64PrimTyConName , int64PrimTc) , (word64PrimTyConName , word64PrimTc) -#if MIN_VERSION_ghc(8,8,0) , (int8PrimTyConName , int8PrimTc) , (int16PrimTyConName , int16PrimTc) , (int32PrimTyConName , int32PrimTc) , (word8PrimTyConName , word8PrimTc) , (word16PrimTyConName , word16PrimTc) , (word32PrimTyConName , word32PrimTc) -#endif , (floatPrimTyConName , floatPrimTc) , (doublePrimTyConName , doublePrimTc) , (naturalPrimTyConName , naturalPrimTc) 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 @@ -19,11 +19,7 @@ module Clash.Core.Util where import Control.Exception.Base (patError) -#if MIN_VERSION_base(4,16,0) import GHC.Prim.Panic (absentError) -#else -import Control.Exception.Base (absentError) -#endif import Control.Monad.Trans.Except (Except, throwE, runExcept) import Data.Bifunctor (first, second) import qualified Data.HashSet as HashSet @@ -41,11 +37,7 @@ (divZeroError, overflowError, ratioZeroDenominatorError, underflowError) import GHC.Stack (HasCallStack) -#if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names (ipClassKey) -#else -import PrelNames (ipClassKey) -#endif import Clash.Core.DataCon import Clash.Core.EqSolver diff --git a/src/Clash/Data/UniqMap.hs b/src/Clash/Data/UniqMap.hs --- a/src/Clash/Data/UniqMap.hs +++ b/src/Clash/Data/UniqMap.hs @@ -58,10 +58,6 @@ #endif import qualified Data.List as List (foldl') -#if !MIN_VERSION_containers(0,6,2) -import qualified Data.IntMap.Extra as IntMap -#endif - #if MIN_VERSION_prettyprinter(1,7,0) import Prettyprinter #else diff --git a/src/Clash/Driver.hs b/src/Clash/Driver.hs --- a/src/Clash/Driver.hs +++ b/src/Clash/Driver.hs @@ -60,11 +60,6 @@ import qualified Data.Text.Lazy as Text import Data.Text.Lazy.Encoding as Text import qualified Data.Text.Lazy.IO as Text -#if MIN_VERSION_prettyprinter(1,7,0) -import Prettyprinter (pretty) -#else -import Data.Text.Prettyprint.Doc (pretty) -#endif import Data.Text.Prettyprint.Doc.Extra (Doc, LayoutOptions (..), PageWidth (..) , layoutPretty, renderLazy) import qualified Data.Time.Clock as Clock @@ -85,15 +80,9 @@ import Text.Trifecta.Result (Result(Success, Failure), _errDoc) -#if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names (eqTyConKey, ipClassKey) import GHC.Types.SrcLoc (SrcSpan) -#else -import PrelNames (eqTyConKey, ipClassKey) - -import SrcLoc (SrcSpan) -#endif import GHC.BasicTypes.Extra () import Clash.Annotations.Primitive @@ -118,6 +107,7 @@ import Clash.Core.VarEnv (elemVarEnv, emptyVarEnv, lookupVarEnv, lookupVarEnv', mkVarEnv, lookupVarEnvDirectly, eltsVarEnv, VarEnv) import Clash.Debug (debugIsOn) +import qualified Clash.Driver.BrokenGhcs as BrokenGhcs import Clash.Driver.Types import Clash.Driver.Manifest (Manifest(..), readFreshManifest, UnexpectedModification, pprintUnexpectedModifications, @@ -327,6 +317,9 @@ let topEntities0 = designEntities design let opts = envOpts env + -- Detect "broken" GHCs and throw an error (unless silenced) + unless (opt_ignoreBrokenGhcs opts) BrokenGhcs.assertWorking + removeHistoryFile (dbg_historyFile (opt_debug opts)) unless (opt_cachehdl opts) $ @@ -349,8 +342,13 @@ edamFiles <- newMVar HashMap.empty ioLock <- newMVar () - mapConcurrently_ (go compNames idSet edamFiles ioLock deps topEntityMap) tes + let + maybeMapConcurrently_ + | opt_concurrentTopEntities opts = mapConcurrently_ + | otherwise = mapM_ + maybeMapConcurrently_ (go compNames idSet edamFiles ioLock deps topEntityMap) tes + time <- Clock.getCurrentTime let diff = reportTimeDiff time startTime putStrLn $ "Clash: Total compilation took " ++ diff @@ -416,14 +414,7 @@ then writeEdam hdlDir (topNm, varUniq topEntity) deps edamFiles fileNames else pure (edamFiles, fileNames) - -- If we are generating (System)Verilog, we could potentially verilate - -- the results. Clash can output a C++ shim for doing this automatically. - fileNames2 <- - case hdlFromBackend (Proxy @backend) of - VHDL -> pure fileNames1 - _ -> writeVerilatorShim hdlDir topNm fileNames1 - - writeManifest manPath manifest0{fileNames=fileNames2} + writeManifest manPath manifest0{fileNames=fileNames1} topTime <- Clock.getCurrentTime let topDiff = reportTimeDiff topTime prevTime @@ -493,11 +484,6 @@ then writeEdam hdlDir (topNm, varUniq topEntity) deps edamFiles filesAndDigests0 else pure (edamFiles, filesAndDigests0) - filesAndDigests2 <- - case hdlFromBackend (Proxy @backend) of - VHDL -> pure filesAndDigests1 - _ -> writeVerilatorShim hdlDir topNm filesAndDigests1 - let depUniques = fromMaybe [] (HashMap.lookup (getUnique topEntity) deps) depBindings = mapMaybe (flip lookupVarEnvDirectly bindingsMap) depUniques @@ -506,7 +492,7 @@ manifest = mkManifest hdlState' domainConfs opts topComponent components depIds - filesAndDigests2 topHash + filesAndDigests1 topHash writeManifest manPath manifest topTime <- hdlDocs `seq` Clock.getCurrentTime @@ -811,48 +797,6 @@ (error $ $(curLoc) ++ "Unknown synthesis domain: " ++ show dom) dom domainConfs - -writeVerilatorShim - :: FilePath - -> Id.Identifier - -> [(FilePath, ByteString)] - -> IO [(FilePath, ByteString)] -writeVerilatorShim hdlDir topNm filesAndDigests = do - let file = Data.Text.unpack (Id.toText topNm) <> "_shim" <.> "cpp" - digest <- writeHDL hdlDir (file, pprVerilatorShim topNm) - pure ((file, digest) : filesAndDigests) - --- | Create a shim for using verilator, which loads the entity and steps --- through simulation until finished. --- -pprVerilatorShim :: Id.Identifier -> Doc -pprVerilatorShim (Id.toText -> topNm) = - -- Extra newlines are aggressively inserted so the quasiquoter doesn't wrap - -- the outlines lines in the file. It doesn't matter for code inside main, - -- but is fatal for the #include directives. - pretty $ Data.Text.pack [I.i| - \#include - - \#include - - \#include "V#{topNm}.h" - - int main(int argc, char **argv) { - Verilated::commandArgs(argc, argv); - - V#{topNm} *top = new V#{topNm}; - - while(!Verilated::gotFinish()) { - top->eval(); - } - - top->final(); - - delete top; - - return EXIT_SUCCESS; - } - |] writeEdam :: FilePath -> diff --git a/src/Clash/Driver/Bool.hs b/src/Clash/Driver/Bool.hs --- a/src/Clash/Driver/Bool.hs +++ b/src/Clash/Driver/Bool.hs @@ -12,13 +12,7 @@ import Data.Hashable (Hashable) import GHC.Generics (Generic) -#if MIN_VERSION_ghc(9,4,0) import qualified GHC.Data.Bool as Ghc -#elif MIN_VERSION_ghc(9,0,0) -import qualified GHC.Utils.Misc as Ghc -#else -import qualified Util as Ghc -#endif data OverridingBool = Auto | Never | Always deriving (Show, Read, Eq, Ord, Enum, Bounded, Hashable, Generic, NFData) diff --git a/src/Clash/Driver/BrokenGhcs.hs b/src/Clash/Driver/BrokenGhcs.hs new file mode 100644 --- /dev/null +++ b/src/Clash/Driver/BrokenGhcs.hs @@ -0,0 +1,157 @@ +{-| +Copyright : (C) 2024, Martijn Bastiaan +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +Utilities to detect and report GHC / operating system combinations that are +known to be buggy. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} + +module Clash.Driver.BrokenGhcs where + +import Data.Maybe (listToMaybe) +import Data.Version (Version(Version, versionBranch)) +import GHC.Platform (OS(..)) + +import System.Info (fullCompilerVersion) + +import qualified Clash.Util.Interpolate as I +import qualified System.Info + +-- | Current OS. Currently only recognizes Linux, Windows, and macOS. +os :: OS +os = case System.Info.os of + "darwin" -> OSDarwin + "linux" -> OSLinux + "mingw32" -> OSMinGW32 + _ -> OSUnknown + +-- | What OS GHC is broken on (or all) +data BrokenOn = All | SomeOs OS + +data GhcVersion = Ghc + { major0 :: Int + , major1 :: Int + , patch :: Int + } + deriving (Eq, Ord) + +data GhcRange = GhcRange + { from :: GhcVersion + -- ^ Start of range, inclusive + , to :: GhcVersion + -- ^ End of range, exclusive + } + +-- | Check if a 'GhcVersion' is within a 'GhcRange' +ghcInRange :: GhcVersion -> GhcRange -> Bool +ghcInRange ghc GhcRange{from, to} = from <= ghc && ghc < to + +-- | Construct a range of all GHC versions matching a major version +ghcMajor :: Int -> Int -> GhcRange +ghcMajor major0 major1 = GhcRange + { from=Ghc major0 major1 0 + , to=Ghc major0 (major1 + 1) 0 + } + +data Why = Why + { what :: String + -- ^ What is broken + , solution :: String + -- ^ What can be done to work around or solve the issue + , issue :: String + -- ^ Link to issue + , brokenOn :: [(BrokenOn, GhcRange)] + -- ^ What operation systems are affected + } + +-- | Get current GHC version expressed as a triple. It probably does something +-- non-sensible on unreleased GHCs. +ghcVersion :: GhcVersion +ghcVersion = Ghc{major0, major1, patch} + where + (major0, major1, patch) = + case fullCompilerVersion of + Version{versionBranch} -> + case versionBranch of + [] -> (0, 0, 1) + [a] -> (a, 0, 1) + [a, b] -> (a, b, 1) + [a, b, c] -> (a, b, c) + (a:b:c:_) -> (a, b, c) + +-- | Pretty print 'Why' into an error message +whyPp :: Why -> String +whyPp Why{what, solution, issue}= [I.i| + Clash has known issues on #{major0}.#{major1}.#{patch} on your current + OS. While not completely preventing the compiler from working, we recommend + switching to another GHC version. Symptoms: + + #{what} + + Consider the following work around or solution: + + #{solution} + + More information can be found at: + + #{issue} + + If you want to ignore this message, pass the following flag to Clash: + + -fclash-ignore-broken-ghcs + + Alternatively, you can set the environment variable CLASH_IGNORE_BROKEN_GHCS + to 'True'. + |] + where + Ghc{major0, major1, patch} = ghcVersion + +-- | Which GHCs are broken and why +brokenGhcs :: [Why] +brokenGhcs = [brokenClashCores, brokenTypeErrors, slowStarts] + where + brokenClashCores = Why + { what = "GHC is known to fail compilation of libraries used by the Clash compiler test suite" + , solution = "Upgrade to GHC 9.4 or downgrade to GHC 8.10" + , issue = "" + , brokenOn = [(SomeOs OSMinGW32, ghcMajor 9 0)] + } + + brokenTypeErrors = Why + { what = "Clash type error messages are indecipherable" + , solution = "Upgrade to GHC 9.4 or downgrade to GHC 9.0" + , issue = "" + , brokenOn = [(All, ghcMajor 9 2)] + } + + slowStarts = Why + { what = "Clash starts really slowly from GHC 9.4.8 up to and including 9.6.2" + , solution = "Upgrade to GHC 9.6.3 or newer, or downgrade to GHC 9.4.7" + , issue = "https://github.com/clash-lang/clash-compiler/issues/2710" + , brokenOn = [(All, GhcRange{from=Ghc 9 4 8, to=Ghc 9 6 3})] + } + +-- | Given a 'BrokenOn', determine whether current OS matches +matchOs :: BrokenOn -> Bool +matchOs All = True +matchOs (SomeOs brokenOs) = os == brokenOs + +-- | Given a 'BrokenOn' and 'GhcVersion', determine whether it matches current OS and GHC +matchBroken :: (BrokenOn, GhcRange) -> Bool +matchBroken (brokenOs, brokenRange) = matchOs brokenOs && ghcInRange ghcVersion brokenRange + +-- | Get first reason for GHC/OS being broken, if any +broken :: Maybe Why +broken = listToMaybe [why | why <- brokenGhcs, any matchBroken (brokenOn why)] + +-- | Throw an error if current OS / GHC version is known to be buggy +assertWorking :: IO () +assertWorking = case broken of + Nothing -> pure () + Just why -> error (whyPp why) diff --git a/src/Clash/Driver/Manifest.hs b/src/Clash/Driver/Manifest.hs --- a/src/Clash/Driver/Manifest.hs +++ b/src/Clash/Driver/Manifest.hs @@ -404,11 +404,12 @@ -- 2. Caching , opt_cachehdl = True - -- 3. Warnings + -- 3. Warnings / errors , opt_primWarn = True , opt_color = Auto , opt_errorExtra = False , opt_checkIDir = True + , opt_ignoreBrokenGhcs = False -- 4. Optional output , opt_edalize = False 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 @@ -42,21 +42,14 @@ import GHC.Generics (Generic) -#if MIN_VERSION_ghc(9,4,0) import GHC.Types.Basic (InlineSpec) import GHC.Types.SrcLoc (SrcSpan) -#elif MIN_VERSION_ghc(9,0,0) -import GHC.Types.Basic (InlineSpec) -import GHC.Types.SrcLoc (SrcSpan) -#else -import BasicTypes (InlineSpec) -import SrcLoc (SrcSpan) -#endif import Clash.Annotations.BitRepresentation.Internal (CustomReprs) import Clash.Signal.Internal import Clash.Backend.Verilog.Time (Period(..), Unit(Fs)) +import Clash.Core.Pretty (unsafeLookupEnvBool) import Clash.Core.Term (Term) import Clash.Core.TyCon (TyConMap, TyConName) import Clash.Core.Var (Id) @@ -403,6 +396,14 @@ , opt_timescalePrecision :: Period -- ^ Timescale precision set in Verilog files. E.g., setting this would sets -- the second part of @`timescale 100fs/100fs@. + , opt_ignoreBrokenGhcs :: Bool + -- ^ Don't error if we see a (potentially) broken GHC / platform combination. + -- See the project's @README.md@ for more information. + , opt_concurrentTopEntities :: Bool + -- ^ Compile top entities concurrently. Disabling this is useful when + -- investigating bugs, because it will make log output deterministic. + -- + -- Command line flag: -fclash-no-concurrent-topentity-compilation } deriving (Show, Eq, NFData, Generic, Hashable) @@ -439,6 +440,10 @@ , opt_edalize = False , opt_renderEnums = True , opt_timescalePrecision = Period 100 Fs + -- XXX: We probe environment variables until we've found a proper solution to + -- https://github.com/clash-lang/clash-compiler/issues/2762. + , opt_ignoreBrokenGhcs = unsafeLookupEnvBool "CLASH_IGNORE_BROKEN_GHCS" False + , opt_concurrentTopEntities = True } -- | Synopsys Design Constraint (SDC) information for a component. diff --git a/src/Clash/Netlist.hs b/src/Clash/Netlist.hs --- a/src/Clash/Netlist.hs +++ b/src/Clash/Netlist.hs @@ -44,13 +44,8 @@ import qualified Data.Text as StrictText import GHC.Stack (HasCallStack) -#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 (HDL) import Clash.Annotations.BitRepresentation.ClashLib @@ -71,6 +66,7 @@ import Clash.Core.Type (Type (..), coreView1, splitFunForallTy, splitCoreFunForallTy) import Clash.Core.TyCon (TyConMap) +import Clash.Core.TysPrim (integerPrimTy, naturalPrimTy) import Clash.Core.Util (splitShouldSplit) import Clash.Core.Var (Id, Var (..), isGlobalId) import Clash.Core.VarEnv @@ -273,7 +269,7 @@ -- 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})) + (args, binds, res{varType=varType1}) Left err -> throw (ClashException sp ($curLoc ++ err) Nothing) @@ -503,7 +499,8 @@ (_,sp) <- Lens.use curCompNm ite <- Lens.use backEndITE altHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) altTy - case iteAlts scrutHTy (NE.toList alts0) of + let e = Case scrut altTy (NE.toList alts0) + case iteAlts scrutHTy alts0 of Just (altT,altF) | ite , Concurrent <- declType @@ -530,6 +527,10 @@ | otherwise -> do dstAssign <- contAssign dstId (IfThenElse scrutExpr altTExpr altFExpr) return $! scrutDecls ++ altTDecls ++ altFDecls ++ tickDecls ++ [dstAssign] + _ | scrutTy == integerPrimTy + -> throw (ClashException sp ($(curLoc) ++ "Can't create netlist for: case (_ :: Integer) of ...") (Just $ showPpr e)) + _ | scrutTy == naturalPrimTy + -> throw (ClashException sp ($(curLoc) ++ "Can't create netlist for: case (_ :: Natural) of ...") (Just $ showPpr e)) _ -> do reprs <- Lens.view customReprs let alts1 = (reorderDefault . reorderCustom tcm reprs scrutTy) alts0 @@ -564,14 +565,12 @@ LitPat (CharLiteral c) -> return (Just (NumLit . toInteger $ ord c), altExpr) LitPat (Int64Literal i) -> return (Just (NumLit i), altExpr) LitPat (Word64Literal w) -> return (Just (NumLit w), altExpr) -#if MIN_VERSION_base(4,16,0) LitPat (Int8Literal i) -> return (Just (NumLit i), altExpr) LitPat (Int16Literal i) -> return (Just (NumLit i), altExpr) LitPat (Int32Literal i) -> return (Just (NumLit i), altExpr) LitPat (Word8Literal w) -> return (Just (NumLit w), altExpr) LitPat (Word16Literal w) -> return (Just (NumLit w), altExpr) LitPat (Word32Literal w) -> return (Just (NumLit w), altExpr) -#endif LitPat (NaturalLiteral n) -> return (Just (NumLit n), altExpr) _ -> do (_,sp) <- Lens.use curCompNm @@ -849,6 +848,7 @@ let hwTyA = case hwTys of hwTy:_ -> hwTy _ -> error ("internal error: unable to extract sufficient hwTys from: " <> show bndr) + let invalid kind = throw (ClashException sp ($(curLoc) ++ "Not in normal form: " ++ kind ++ "\n\n" ++ showPpr app) Nothing) case appF of Data dc -> mkDcApplication declType hwTys bndr dc tmArgs Prim pInfo -> mkPrimitive False bbEasD declType bndr pInfo args tickDecls @@ -858,9 +858,7 @@ return (Noop, []) else do return (Identifier (Id.unsafeFromCoreId f) Nothing, []) - | not (null tyArgs) -> - throw (ClashException sp ($(curLoc) ++ "Not in normal form: " - ++ "Var-application with Type arguments:\n\n" ++ showPpr app) Nothing) + | not (null tyArgs) -> invalid "Var-application with type arguments" | otherwise -> do argNm <- Id.suffix (netlistId1 id Id.unsafeFromCoreId bndr) "fun_arg" decls <- mkFunApp declType argNm f tmArgs tickDecls @@ -881,12 +879,20 @@ -- This net was already declared in the call to mkSelection return ( Identifier argNm Nothing , NetDecl' Nothing argNm hwTyA Nothing:decls) + Case _ _ [] -> invalid "No case alternatives\n\n" Letrec binders body -> do netDecls <- concatMapM mkNetDecl binders decls <- concatMapM (uncurry (mkDeclarations' declType)) 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) + Core.Literal _ -> invalid "application of literal" + Let _ _ -> invalid "application of let" + TyApp _ _ -> invalid "application of type application" + Tick _ _ -> invalid "application of tick" + Cast _ _ _ -> invalid "application of cast" + Lam _ _ -> invalid "application of lambda" + TyLam _ _ -> invalid "application of type lambda" + App _ _ -> invalid "application of application" -- | Generate an expression that projects a field out of a data-constructor. -- @@ -1092,42 +1098,22 @@ 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#" -#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#" -#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):_) <- 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#" -#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 , (a@(HW.Literal Nothing (NumLit _)):_) <- argExprs -> pure a 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 @@ -826,12 +826,7 @@ (mkLocalId (inferCoreTypeOf 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 @@ -956,11 +951,7 @@ -- | 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.view tcCache (ds0,subst) <- collectAction tcm let qS = substTm "collectBindIO1" subst q 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 @@ -1,7 +1,7 @@ {-| Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, - 2021-2023, QBayLogic B.V. + 2021-2026, QBayLogic B.V. 2022 , LUMI GUIDE FIETSDETECTIE B.V. 2022 , Google Inc. License : BSD2 (see the file LICENSE) @@ -22,6 +22,7 @@ module Clash.Netlist.BlackBox.Util ( renderTemplate + , lookupFunctionInstantiation , walkElement , verifyBlackBoxContext , onBlackBox @@ -46,6 +47,7 @@ import Data.Bitraversable (bitraverse) import Data.Bool (bool) import Data.Coerce (coerce) +import Data.Containers.ListUtils (nubOrd) import Data.Foldable (foldrM) import Data.Hashable (Hashable (..)) import qualified Data.HashMap.Strict as HashMap @@ -150,6 +152,41 @@ CtxName -> Nothing EscapedSymbol _ -> Nothing +lookupFunctionInstantiation + :: BlackBoxContext + -> Int + -> Int + -> Either + String + ( Either N.BlackBox (Id.Identifier, [Declaration]) + , N.Usage + , [BlackBoxTemplate] + , [BlackBoxTemplate] + , [((Data.Text.Text, Data.Text.Text), N.BlackBox)] + , BlackBoxContext + ) +lookupFunctionInstantiation bbCtx n subn = + case IntMap.lookup n (bbFunctions bbCtx) of + Nothing -> + Left + ( "Blackbox requested instantiation of function at argument " + ++ show n + ++ ", but BlackBoxContext did not contain one." + ) + Just funcs -> + case indexMaybe funcs subn of + Nothing -> + Left + ( "Blackbox requested at least " + ++ show (subn + 1) + ++ " renders of function at argument " + ++ show n + ++ " but found only " + ++ show (length funcs) + ) + Just func -> + Right func + -- | Determine if the number of normal\/literal\/function inputs of a blackbox -- context at least matches the number of argument that is expected by the -- template. @@ -186,21 +223,14 @@ ++ "used ~CONST[" ++ show n ++ "], but was:\n\n" ++ show inp) _ -> Nothing Component (Decl n subn l') -> - case IntMap.lookup n (bbFunctions bbCtx) of - Just funcs -> - case indexMaybe funcs subn of - Nothing -> - Just ( "Blackbox requested at least " ++ show (subn+1) - ++ " renders of function at argument " ++ show n ++ " but " - ++ "found only " ++ show (length funcs) ) - Just _ -> - orElses $ - map - (verifyBlackBoxContext bbCtx . N.BBTemplate) - (concatTups l') - Nothing -> - Just ( "Blackbox requested instantiation of function at argument " - ++ show n ++ ", but BlackBoxContext did not contain one.") + case lookupFunctionInstantiation bbCtx n subn of + Left lookupErr -> + Just lookupErr + Right _ -> + orElses $ + map + (verifyBlackBoxContext bbCtx . N.BBTemplate) + (concatTups l') _ -> case inputHole e of Nothing -> @@ -332,7 +362,7 @@ (canonicalizePath toCanonicalize) (error [I.i|Could not find data file #{show toCanonicalize}. Does it exist?|]) | otherwise = unsafePerformIO $ do - let candidates = map ( toCanonicalize) idirs + let candidates = map ( toCanonicalize) (nubOrd idirs) found <- filterM doesFileExist candidates case found of [] -> error [I.i| @@ -481,11 +511,8 @@ (o,oTy,_) <- idToExpr <$> bitraverse (lineToIdentifier b) (return . lineToType b) l is <- mapM (fmap idToExpr . bitraverse (lineToIdentifier b) (return . lineToType b)) ls sp <- getSrcSpan - let func0 = IntMap.lookup n (bbFunctions b) - errr = concat [ "renderElem: not enough functions rendered? Needed " - , show (subN +1 ), " got only ", show (length (fromJust func0)) ] - case indexNote' errr subN <$> func0 of - Just (templ0,_,libs,imps,inc,pCtx) -> do + case lookupFunctionInstantiation b n subN of + Right (templ0,_,libs,imps,inc,pCtx) -> do let b' = pCtx { bbResults = [(o,oTy)], bbInputs = bbInputs pCtx ++ is } layoutOptions = LayoutOptions (AvailablePerLine 120 0.4) render = N.BBTemplate . parseFail b' . renderLazy . layoutPretty layoutOptions @@ -524,12 +551,8 @@ , Data.Text.unpack (bbName b), ". Verification procedure " , "reported:\n\n" ++ err0 ] throw (ClashException sp ($(curLoc) ++ err1) Nothing) - Nothing -> - let err1 = concat [show n - , "'th argument isn't a function, only " - , show (IntMap.keys (bbFunctions b)) - , "are."] - in throw (ClashException sp ($(curLoc) ++ err1) Nothing) + Left err0 -> + throw (ClashException sp ($(curLoc) ++ "renderElem: " ++ err0) Nothing) renderElem b (SigD e m) = do e' <- Text.concat <$> mapM (fmap ($ 0) . renderElem b) e @@ -897,7 +920,9 @@ renderTag b (MaxIndex e) = return . Text.pack . show . vecLen $ lineToType b [e] where vecLen (Vector n _) = n-1 + vecLen (Void (Just (Vector n _))) = n-1 vecLen (MemBlob n _) = n-1 + vecLen (Void (Just (MemBlob n _))) = n-1 vecLen thing = error $ $(curLoc) ++ "vecLen of a non-vector-like type: " ++ show thing 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 @@ -32,9 +32,6 @@ 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 qualified Control.Monad.State as Lazy (State) import qualified Control.Monad.State.Strict as Strict @@ -57,17 +54,15 @@ import qualified Data.Set as Set import Data.Text (Text) +#if __GLASGOW_HASKELL__ <= 910 import Data.Typeable (Typeable) +#endif import Data.Text.Prettyprint.Doc.Extra (Doc) 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.SynthesisAttributes(Attr) import Clash.Annotations.BitRepresentation (FieldAnn) @@ -80,7 +75,8 @@ import Clash.Core.Var (Id) import Clash.Core.TyCon (TyConMap) import Clash.Core.VarEnv (VarEnv) -import Clash.Driver.Types (BindingMap, ClashEnv(..), ClashOpts(..)) +import Clash.Driver.Types + (BindingMap, ClashEnv(..), ClashOpts(..)) import Clash.Netlist.BlackBox.Types (BlackBoxTemplate) import Clash.Primitives.Types (CompiledPrimMap) import Clash.Signal.Internal @@ -368,6 +364,12 @@ data SomeBackend where SomeBackend :: Backend backend => backend -> SomeBackend +onSomeBackend :: (forall b. Backend b => b -> a) -> SomeBackend -> a +onSomeBackend f (SomeBackend b) = f b + +fromSomeBackend :: (forall b. Backend b => b -> a) -> Lens.Getter SomeBackend a +fromSomeBackend f = Lens.to (onSomeBackend f) + type Comment = Text type Directive = Text @@ -828,7 +830,10 @@ | L -- ^ Low | U -- ^ Undefined | Z -- ^ High-impedance - deriving (Eq,Show,Typeable,Lift) + deriving (Eq,Show,Lift) +#if __GLASGOW_HASKELL__ <= 910 + deriving Typeable +#endif toBit :: Integer -- ^ mask 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 @@ -2,7 +2,7 @@ Copyright : (C) 2012-2016, University of Twente, 2017 , Myrtle Software Ltd 2017-2018, Google Inc. - 2021-2024, QBayLogic B.V. + 2021-2026, QBayLogic B.V. 2022 , Google Inc. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -14,9 +14,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} -#if !MIN_VERSION_ghc(8,8,0) -{-# LANGUAGE MonadFailDesugaring #-} -#endif {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -50,6 +47,7 @@ import Control.Applicative (Alternative((<|>))) import Data.List (unzip4, partition) import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe @@ -62,23 +60,14 @@ import Data.Text.Lazy (toStrict) import Data.Text.Prettyprint.Doc.Extra -#if MIN_VERSION_base(4,15,0) import GHC.Num.Integer (Integer (..)) -#else -import GHC.Integer.GMP.Internals (Integer (..), BigNat (..)) -#endif import GHC.Stack (HasCallStack) import GHC.TypeLits (someNatVal) import GHC.TypeNats (SomeNat(..)) -#if MIN_VERSION_ghc(9,0,0) import GHC.Utils.Monad (zipWith3M) import GHC.Utils.Outputable (ppr, showSDocUnsafe) -#else -import MonadUtils (zipWith3M) -import Outputable (ppr, showSDocUnsafe) -#endif import Clash.Annotations.TopEntity (TopEntity(..), PortName(..), defSyn) @@ -133,11 +122,7 @@ import Clash.Util.Supply 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: -- @@ -1838,8 +1823,9 @@ where freeVars = concatMap (Lens.toListOf typeFreeVars) (map coreTypeOf tms) -iteAlts :: HWType -> [Alt] -> Maybe (Term,Term) -iteAlts sHTy [(pat0,alt0),(pat1,alt1)] | validIteSTy sHTy = case pat0 of +-- | Attempt to make an if-then-else construction out of this Case +iteAlts :: HWType -> NonEmpty 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) @@ -2189,21 +2175,15 @@ C.WordLiteral w -> HW.Literal (Just (Unsigned iw,iw)) $ NumLit w C.Int64Literal i -> HW.Literal (Just (Signed 64,64)) $ NumLit i C.Word64Literal w -> HW.Literal (Just (Unsigned 64,64)) $ NumLit w -#if MIN_VERSION_ghc(8,8,0) C.Int8Literal i -> HW.Literal (Just (Signed 8,8)) $ NumLit i C.Int16Literal i -> HW.Literal (Just (Signed 16,16)) $ NumLit i C.Int32Literal i -> HW.Literal (Just (Signed 32,32)) $ NumLit i C.Word8Literal w -> HW.Literal (Just (Unsigned 8,8)) $ NumLit w C.Word16Literal w -> HW.Literal (Just (Unsigned 16,16)) $ NumLit w C.Word32Literal w -> HW.Literal (Just (Unsigned 32,32)) $ NumLit w -#endif C.CharLiteral c -> HW.Literal (Just (Unsigned 21,21)) . NumLit . toInteger $ ord c C.FloatLiteral w -> HW.Literal (Just (BitVector 32,32)) (NumLit $ toInteger w) C.DoubleLiteral w -> HW.Literal (Just (BitVector 64,64)) (NumLit $ toInteger w) C.NaturalLiteral n -> HW.Literal (Just (Unsigned iw,iw)) $ NumLit n -#if MIN_VERSION_base(4,15,0) C.ByteArrayLiteral (ByteArray ba) -> HW.Literal Nothing (NumLit (IP ba)) -#else - C.ByteArrayLiteral (ByteArray ba) -> HW.Literal Nothing (NumLit (Jp# (BN# ba))) -#endif C.StringLiteral s -> HW.Literal Nothing $ StringLit s diff --git a/src/Clash/Normalize.hs b/src/Clash/Normalize.hs --- a/src/Clash/Normalize.hs +++ b/src/Clash/Normalize.hs @@ -2,7 +2,7 @@ Copyright : (C) 2012-2016, University of Twente, 2016 , Myrtle Software Ltd, 2017 , Google Inc., - 2021-2023, QBayLogic B.V. + 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -399,7 +399,10 @@ -- Note that we do this as the very last step, after all constant propagation -- has been done to avoid #3036. topdownSucR (apply "collapseRHSNoops" collapseRHSNoops) >-> - topdownSucR (apply "inlineCleanup" inlineCleanup) + topdownSucR (apply "inlineCleanup" inlineCleanup) >-> + bottomupR (apply "caseCon" caseCon) >-> -- https://github.com/clash-lang/clash-compiler/issues/3159 / #3204 + bottomupR (apply "flattenLet" flattenLet) >-> -- https://github.com/clash-lang/clash-compiler/issues/3185 + topdownSucR (apply "topLet" topLet) goCheap c@(CLeaf (nm2,(Binding _ _ inl2 _ e _))) | isNoInline inl2 = (Nothing ,[c]) 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 @@ -43,7 +43,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Bifunctor (second) -import Data.List (mapAccumR) +import Data.List (mapAccumR, uncons) import Data.List.Extra (zipEqual) #if MIN_VERSION_base(4,20,0) import qualified Data.List.NonEmpty as NE hiding (unzip) @@ -56,30 +56,27 @@ import Data.Text.Extra (showt) import GHC.Stack (HasCallStack) -#if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey) import GHC.Types.SrcLoc (wiredInSrcSpan) -#else -import PrelNames - (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, - typeNatSubTyFamNameKey) -import SrcLoc (wiredInSrcSpan) -#endif import Clash.Core.DataCon (DataCon) +import Clash.Core.FreeVars (typeFreeVars) import Clash.Core.HasType + import Clash.Core.Literal (Literal (..)) import Clash.Core.Name (nameOcc, Name(..), NameSort(User), mkUnsafeSystemName) import Clash.Core.Pretty (showPpr) +import Clash.Core.Subst (extendTvSubst, mkSubst, substTy) import Clash.Core.Term (IsMultiPrim (..), CoreContext (..), PrimInfo (..), Term (..), WorkInfo (..), Pat (..), collectTermIds, mkApps, PrimUnfolding(..)) import Clash.Core.Type (LitTy (..), Type (..), TypeView (..), coreView1, mkFunTy, mkTyConApp, + normalizeType, splitFunForallTy, tyView) import Clash.Core.TyCon (TyConMap, TyConName, tyConDataCons, tyConName) @@ -735,22 +732,34 @@ (uniqs1,(vars,elems)) = second (second sconcat . NE.unzip) $ extractElems uniqs0 is1 consCon aTy 'D' n arg snatDc = Maybe.fromMaybe (error "reduceDFold: faild to build SNat") $ do - (_ltv:Right snTy:_,_) <- pure (splitFunForallTy (inferCoreTypeOf tcm fun)) + (_ltv:_rubp:Right snTy:_,_) <- pure (splitFunForallTy (inferCoreTypeOf tcm fun)) (TyConApp snatTcNm _) <- pure (tyView snTy) snatTc <- UniqMap.lookup snatTcNm tcm Maybe.listToMaybe (tyConDataCons snatTc) - lbody = doFold (buildSNat snatDc) (n-1) (NE.toList vars) + ubp k = Maybe.fromMaybe + (error "reduceDFold: failed to extract upper bound proof") $ do + (_ltv:Right ubpT:_,_) <- pure (splitFunForallTy (inferCoreTypeOf tcm fun)) + -- toListOf does not de-duplicate, but we know that there is only + -- one free variable in here, thus, taking the first element is fine + (tvN, _) <- uncons $ Lens.toListOf typeFreeVars ubpT + let subst = extendTvSubst (mkSubst is0) tvN (LitTy (NumTy k)) + let witness = normalizeType tcm (substTy subst ubpT) + (TyConApp tupTcNm _) <- pure (tyView witness) + witnessTc <- UniqMap.lookup tupTcNm tcm + Maybe.listToMaybe (tyConDataCons witnessTc) + lbody = doFold ubp (buildSNat snatDc) (n-1) (NE.toList vars) lb = Letrec (NE.init elems) lbody uniqSupply Lens..= uniqs1 changed lb go _ ty = error $ $(curLoc) ++ "reduceDFold: argument does not have a vector type: " ++ showPpr ty - doFold _ _ [] = start - doFold snDc k (x:xs) = mkApps fun + doFold _ _ _ [] = start + doFold ubp snDc k (x:xs) = mkApps fun [Right (LitTy (NumTy k)) + ,Left (Data (ubp k)) ,Left (snDc k) ,Left x - ,Left (doFold snDc (k-1) xs) + ,Left (doFold ubp snDc (k-1) xs) ] -- | Replace an application of the @Clash.Sized.Vector.head@ primitive on 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 @@ -1,6 +1,6 @@ {-| Copyright : (C) 2012-2016, University of Twente, - (C) 2021, QBayLogic B.V. + (C) 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -17,7 +17,7 @@ import Clash.Rewrite.Types import Clash.Rewrite.Util --- [Note: bottomup traversal evalConst] +-- [Note: bottomup traversal reduceConst] -- -- 2-May-2019: There is a bug in the evaluator where all data constructors are -- considered lazy, even though their declaration says they have strict fields. @@ -36,6 +36,7 @@ bindConst >-> letTL >-> evalConst >-!-> cse >-!-> cleanup >-> + elimCaseBigNum >-> -- see [Note] late elimCaseBigNum xOptim >-> rmDeadcode >-> cleanup >-> bindSimIO >-> recLetRec >-> splitArgs where @@ -46,9 +47,10 @@ rmUnusedExpr = bottomupR (apply "removeUnusedExpr" removeUnusedExpr) rmDeadcode = bottomupR (apply "deadcode" deadCode) bindConst = topdownR (apply "bindConstantVar" bindConstantVar) - -- See [Note] bottomup traversal evalConst: - evalConst = bottomupR (apply "evalConst" reduceConst) + -- See [Note] bottomup traversal reduceConst: + evalConst = bottomupR (apply "reduceConst" reduceConst) cse = topdownR (apply "CSE" simpleCSE) + elimCaseBigNum = topdownR (apply "elimCaseBigNum" elimCaseBigNumInternals) xOptim = bottomupR (apply "xOptimize" xOptimize) cleanup = topdownR (apply "etaExpandSyn" etaExpandSyn) >-> topdownSucR (apply "inlineCleanup" inlineCleanup) !-> @@ -135,6 +137,17 @@ , ("zeroWidthSpec", zeroWidthSpec) -- See Note [zeroWidthSpec enabling transformations] ] + +{- +[Note] late elimCaseBigNum + +elimCaseBigNum is placed fairly late in the pipeline, after any constant folding and after caseCon. +Because Naturals also hide inside SNat/Nat/KnownNats, and those can be bigger then 64bits. +But they're ultimately monomorphic and thus static and will be evaluated. +We just have to make sure that evaluation happens before we do elimCaseBigNum. + +For an example of where this can happen see foldableSNat in tests/shouldwork/Issues/T3157_IntegerNaturalInternals.hs +-} {- Note [zeroWidthSpec enabling transformations] diff --git a/src/Clash/Normalize/Transformations/Case.hs b/src/Clash/Normalize/Transformations/Case.hs --- a/src/Clash/Normalize/Transformations/Case.hs +++ b/src/Clash/Normalize/Transformations/Case.hs @@ -24,14 +24,11 @@ , caseLet , caseOneAlt , elimExistentials + , elimCaseBigNumInternals ) where import Control.Exception.Base (patError) -#if MIN_VERSION_base(4,16,0) import GHC.Prim.Panic (absentError) -#else -import Control.Exception.Base (absentError) -#endif import qualified Control.Lens as Lens import Control.Monad.State.Strict (evalState) import Data.Bifunctor (second) @@ -44,11 +41,7 @@ import qualified Data.Text.Extra as Text (showt) import GHC.Stack (HasCallStack) -#if MIN_VERSION_base(4,15,0) import GHC.Num.Integer (Integer(..)) -#else -import GHC.Integer.GMP.Internals (BigNat(..), Integer(..)) -#endif import Clash.Sized.Internal.BitVector as BV (BitVector, eq#) import Clash.Sized.Internal.Index as I (Index, eq#) @@ -68,6 +61,7 @@ , collectTicks, mkApps, mkTicks, patIds, stripTicks, Bind(..)) import Clash.Core.TyCon (TyConMap) import Clash.Core.Type (LitTy(..), Type(..), TypeView(..), coreView1, tyView) +import Clash.Core.TysPrim (integerIsDc, naturalNsDc) import Clash.Core.Util (listToLets, mkInternalVar) import Clash.Core.VarEnv ( InScopeSet, elemVarSet, extendInScopeSet, extendInScopeSetList, mkVarSet @@ -388,11 +382,7 @@ else 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 fvs = Lens.foldMapOf freeLocalIds unitVarSet e bind = NonRec x (Literal (ByteArrayLiteral ba')) @@ -401,11 +391,7 @@ else 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 fvs = Lens.foldMapOf freeLocalIds unitVarSet e bind = NonRec x (Literal (ByteArrayLiteral ba')) @@ -434,11 +420,7 @@ else 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 fvs = Lens.foldMapOf freeLocalIds unitVarSet e bind = NonRec x (Literal (ByteArrayLiteral ba')) @@ -722,3 +704,41 @@ elimExistentials _ e = return e {-# SCC elimExistentials #-} + +-- | This finds cases on Integers and Naturals and rewrites them +-- to remove the alternatives with bignums/bytearrays in them. +-- +-- Natural and Integer are defined as: +-- @ +-- data Natural = NS Word# | NB ByteArray# +-- data Integer = IS Int# | IP ByteArray# | IN ByteArray# +-- @ +-- Both 'Natural' and 'Integer' have invariants stating that they will only use NB/IP/IN +-- when their values doesn't fit in NS/IS. And the code in base also makes use of that. +-- So we can be sure that small values, that are representable in HDL, are always encoded with NS/IS. +-- +-- Because the NB/IP/IN don't/can't exist in HDL, this transformation looks for case with +-- patterns for NS/IS and just always picks those alternatives, and removes the other +-- alternatives. +-- +-- This is as "safe" as the rest of the Natural/Integer handling that clash does in HDL, +-- because numbers bigger then Word/Int can't exist there anyway. +elimCaseBigNumInternals :: HasCallStack => NormRewrite +elimCaseBigNumInternals _ e@(Case scrut altsTy alts0@(_:_:_)) = + go alts0 + where + go [] = return e + go ((pat,altE):alts) = case pat of + DataPat dc [] [x] | (dc == integerIsDc || dc == naturalNsDc) -> + if elemVarSet x fvs then + -- field used, turn the case into a projection + -- It seems this pattern never happens after ANF. + changed (Case scrut altsTy [(DataPat dc [] [x],altE)]) + else + -- field not used, eliminate the case completely + changed altE + _ -> go alts + where + fvs = Lens.foldMapOf freeLocalIds unitVarSet altE + +elimCaseBigNumInternals _ e = return e diff --git a/src/Clash/Normalize/Transformations/DEC.hs b/src/Clash/Normalize/Transformations/DEC.hs --- a/src/Clash/Normalize/Transformations/DEC.hs +++ b/src/Clash/Normalize/Transformations/DEC.hs @@ -37,9 +37,6 @@ ( disjointExpressionConsolidation ) where -#if !MIN_VERSION_base(4,18,0) -import Control.Applicative (liftA2) -#endif import Control.Lens ((^.), _1) import qualified Control.Lens as Lens import qualified Control.Monad as Monad @@ -61,19 +58,9 @@ import GHC.Stack (HasCallStack) import qualified Language.Haskell.TH as TH -#if MIN_VERSION_ghc(9,6,0) import GHC.Core.Make (chunkify, mkChunkified) -#elif MIN_VERSION_ghc(8,10,0) -import GHC.Hs.Utils (chunkify, mkChunkified) -#else -import HsUtils (chunkify, mkChunkified) -#endif -#if MIN_VERSION_ghc(9,0,0) import GHC.Settings.Constants (mAX_TUPLE_SIZE) -#else -import Constants (mAX_TUPLE_SIZE) -#endif -- internal import Clash.Core.DataCon (DataCon) @@ -112,13 +99,7 @@ import qualified Clash.Sized.Internal.Unsigned import qualified GHC.Base import qualified GHC.Classes -#if MIN_VERSION_base(4,15,0) import qualified GHC.Num.Integer -#else --- interger-gmp primitives are defined in the hidden module GHC.Integer.Type, --- but exported from GHC.Integer -import qualified GHC.Integer as GHC.Integer.Type -#endif import qualified GHC.Prim -- | This transformation lifts applications of global binders out of @@ -763,19 +744,11 @@ ,('GHC.Base.modInt,lastNotPow2) ,('GHC.Classes.divInt#,lastNotPow2) ,('GHC.Classes.modInt#,lastNotPow2) -#if MIN_VERSION_base(4,15,0) ,('GHC.Num.Integer.integerMul,bothNotPow2) ,('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,bothNotPow2) - ,('GHC.Integer.Type.divInteger,lastNotPow2) - ,('GHC.Integer.Type.modInteger,lastNotPow2) - ,('GHC.Integer.Type.quotInteger,lastNotPow2) - ,('GHC.Integer.Type.remInteger,lastNotPow2) -#endif ,('(GHC.Prim.*#),bothNotPow2) ,('GHC.Prim.quotInt#,lastNotPow2) ,('GHC.Prim.remInt#,lastNotPow2) diff --git a/src/Clash/Normalize/Transformations/Specialize.hs b/src/Clash/Normalize/Transformations/Specialize.hs --- a/src/Clash/Normalize/Transformations/Specialize.hs +++ b/src/Clash/Normalize/Transformations/Specialize.hs @@ -2,7 +2,7 @@ Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2018, Google Inc., - 2021-2023, QBayLogic B.V. + 2021-2026, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -45,13 +45,10 @@ import qualified Data.Set.Ordered.Extra as OSet import qualified Data.Text as Text import qualified Data.Text.Extra as Text +import GHC.BasicTypes.Extra (isNoInline) import GHC.Stack (HasCallStack) -#if MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (InlineSpec (..)) -#else -import BasicTypes (InlineSpec (..)) -#endif import qualified Clash.Sized.Internal.BitVector as BV (BitVector, fromInteger#) import qualified Clash.Sized.Internal.Index as I (Index, fromInteger#) @@ -90,7 +87,7 @@ , typeTranslator, workFreeBinders, debugOpts, topEntities, specializationLimit) import Clash.Rewrite.Util ( mkBinderFor, mkDerivedName, mkFunction, mkTmBinderFor, setChanged, changed - , normalizeTermTypes, normalizeId) + , normalizeTermTypes, normalizeId, whnfRW) import Clash.Rewrite.WorkFree (isWorkFree) import Clash.Normalize.Types ( NormRewrite, NormalizeSession, specialisationCache, specialisationHistory) @@ -293,9 +290,17 @@ = do specInfo<- constantSpecInfo ctx e2 if csrFoundConstant specInfo then let newBindings = csrNewBindings specInfo in - if null newBindings then - -- Whole of e2 is constant - specialize ctx (App e1 e2) + if null newBindings then do + -- Whole of e2 is constant, we reduce it here eagerly before specialization + -- because we have observed long running compile times when having + -- recursively defined constants, see: + -- https://github.com/clash-lang/clash-compiler/issues/3129 + e2Red <- case collectArgs e2 of + (Prim p0, _) -> whnfRW False ctx e2 $ \_ctx1 e2Red -> case e2Red of + (collectArgs -> (Prim p1, _)) | primName p0 == primName p1 -> return e2 + _ -> changed e2Red + _ -> return e2 + specialize ctx (App e1 e2Red) else do -- Parts of e2 are constant let is1 = extendInScopeSetList is0 (fst <$> csrNewBindings specInfo) @@ -332,10 +337,10 @@ If one of these had been specialized, the other two would hit that term in the specialization cache, saving Clash from having to re-do work which is in effect -the same. To preserve this behaviour, we use 'stripAllTicks' on the keys for +the same. To preserve this behavior, we use 'stripAllTicks' on the keys for the specialization cache. -TODO While this preserves the old behaviour, the old behaviour is likely not +TODO While this preserves the old behavior, the old behavior is likely not quite what we want. Using a value from the specialization cache may change the ticks present, which can affect naming / debugging information in generated HDL. We may also not want to look at ticks, as then the specialization cache will @@ -351,17 +356,11 @@ where enumInlineSpec :: InlineSpec -> Int enumInlineSpec = \case -#if MIN_VERSION_ghc(9,2,0) NoUserInlinePrag {} -> -1 -#else - NoUserInline {} -> -1 -#endif Inline {} -> 0 Inlinable {} -> 1 NoInline {} -> 2 -#if MIN_VERSION_ghc(9,4,0) Opaque {} -> 3 -#endif -- | Specialize an application on its argument specialize' @@ -449,21 +448,31 @@ args -- Determine name the resulting specialized function, and the -- form of the specialized-on argument - (fId,inl',specArg') <- case specArg of + (newName, inl', specArg') <- case specArg of Left a@(collectArgsTicks -> (Var g,gArgs,_gTicks)) -> if isPolyFun tcm a then do -- In case we are specializing on an argument that is a - -- global function then we use that function's name as the - -- name of the specialized higher-order function. + -- global function then we use that function's name as part + -- of the name of the specialized higher-order function. -- Additionally, we will return the body of the global -- function, instead of a variable reference to the -- global function. -- - -- This will turn things like @mealy g k@ into a new - -- binding @g'@ where both the body of @mealy@ and @g@ + -- This will turn things like @mealy g@ into a new + -- binding where both the body of @mealy@ and @g@ -- are inlined, meaning the state-transition-function -- and the memory element will be in a single function. -- + -- The name of the new function depends on NOINLINE / OPAQUE + -- annotations. + -- + -- OPAQUE | Name for @f g@ + -- -----------|--------------- + -- f and g | f_g + -- f | f + -- g | g + -- !f and !g | f_g + -- -- Finally, we must make sure we do not inline the bodies -- of functions with a Synthesize annotation, as that would -- duplicate Clash compiler work. See also issue #3024 @@ -473,15 +482,15 @@ else fmap bindingTerm gTmM return - ( g + ( specializeName (inl, varName f) (bindingSpec <$> gTmM, varName g) , preferNoInline inl (maybe noUserInline bindingSpec gTmM) , maybe specArg (Left . (`mkApps` gArgs)) gBody ) - else return (f,inl,specArg) - _ -> return (f,inl,specArg) + else return (varName f, inl, specArg) + _ -> return (varName f, inl, specArg) -- Create specialized functions let newBody = mkAbstraction (mkApps bodyTm (argVars ++ [specArg'])) (boundArgs ++ specBndrs) - newf <- mkFunction (varName fId) sp inl' newBody + newf <- mkFunction newName sp inl' newBody -- Remember specialization (extra.specialisationHistory) %= UniqMap.insertWith (+) f 1 (extra.specialisationCache) %= Map.insert (f,argLen,specAbs) newf @@ -491,12 +500,21 @@ Nothing -> return e where noUserInline :: InlineSpec -#if MIN_VERSION_ghc(9,2,0) noUserInline = NoUserInlinePrag -#else - noUserInline = NoUserInline -#endif + specializeName :: (InlineSpec, Name Term) -> (Maybe InlineSpec, Name Term) -> Name Term + specializeName (spec0, n0) (spec1, n1) + | (ann0 && ann1) || (not ann0 && not ann1) + = n0{nameOcc=nameOcc n0 <> "_" <> stripMods (nameOcc n1)} + | ann0 = n0 + | otherwise = n1 + where + ann0 = isNoInline spec0 + ann1 = fmap isNoInline spec1 == Just True + + stripMods :: Text.Text -> Text.Text + stripMods = Text.takeWhileEnd (/= '.') + collectBndrsMinusApps :: Term -> [Name a] collectBndrsMinusApps = reverse . go [] where @@ -522,11 +540,7 @@ -- Create a new function if an alpha-equivalent binder doesn't exist newf <- case UniqMap.elems existing of [] -> do (cf,sp) <- Lens.use curFun -#if MIN_VERSION_ghc(9,2,0) mkFunction (appendToName (varName cf) "_specF") sp NoUserInlinePrag newBody -#else - mkFunction (appendToName (varName cf) "_specF") sp NoUserInline newBody -#endif (b:_) -> return (bindingId b) -- Create specialized argument let newArg = Left $ mkApps (Var newf) specVars 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 @@ -46,11 +46,7 @@ import qualified Data.Text as Text import qualified Data.Text.Extra as Text -#if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names (eqTyConKey) -#else -import PrelNames (eqTyConKey) -#endif import Clash.Annotations.Primitive (extractPrim) import Clash.Core.FreeVars 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 @@ -1,6 +1,6 @@ {-| Copyright : (C) 2019, Myrtle Software Ltd. - 2020-2024, QBayLogic B.V. + 2020-2026, QBayLogic B.V. 2021, Myrtle.ai 2022-2023, Google Inc License : BSD2 (see the file LICENSE) @@ -95,9 +95,8 @@ ) where import Control.Lens hiding (Indexed, assign) -#if MIN_VERSION_mtl(2,3,0) +import Control.Exception (throw) import Control.Monad (forM, forM_, zipWithM) -#endif import Control.Monad.State import Data.Default (Default(def)) import Data.IntMap (IntMap) @@ -119,13 +118,14 @@ import Clash.Backend hiding (Usage, fromBV, toBV) import Clash.Backend.VHDL (VHDLState) import Clash.Explicit.Signal (ResetPolarity(..), vResetPolarity) -import Clash.Netlist.BlackBox.Util (exprToString, getDomainConf, renderElem) +import Clash.Netlist.BlackBox.Util + (exprToString, getDomainConf, lookupFunctionInstantiation, 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 Clash.Util (clogBase) +import Clash.Util (ClashException(..), clogBase, curLoc) import qualified Data.String.Interpolate as I import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -837,6 +837,13 @@ resName <- declare' (ctxName <> "_" <> "ho" <> showt fPos <> "_" <> showt fSubPos <> "_res") resTy + -- Pick the fSubPos-th HO instantiation (if present) and reuse its usage. + sp <- zoom bsBackend getSrcSpan + case lookupFunctionInstantiation bbCtx fPos fSubPos of + Left err0 -> + throw (ClashException sp ($(curLoc) ++ "instHO: " ++ err0) Nothing) + Right (_, usage, _, _, _, _) -> + declareUseOnce usage resName let res = ([Text (Id.toLazyText resName)], bbResTy) -- Render HO argument to plain text 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 @@ -29,11 +29,9 @@ \case IntegerLiteral i -> Just i IntLiteral i -> Just i -#if MIN_VERSION_ghc(8,8,0) Int8Literal i -> Just i Int16Literal i -> Just i Int32Literal i -> Just i -#endif Int64Literal i -> Just i _ -> Nothing 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 @@ -32,11 +32,9 @@ getWordLit = \case WordLiteral i -> Just i -#if MIN_VERSION_ghc(8,8,0) Word8Literal i -> Just i Word16Literal i -> Just i Word32Literal i -> Just i -#endif Word64Literal i -> Just i _ -> Nothing 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 @@ -37,7 +37,7 @@ import qualified GHC.Utils.Outputable as Outputable import GHC.Types.Error (DiagnosticReason (WarningWithoutFlag)) import GHC.Types.SrcLoc (isGoodSrcSpan) -#elif MIN_VERSION_ghc(9,6,0) +#else import GHC.Utils.Error (DiagOpts(..), mkPlainDiagnostic, mkPlainMsgEnvelope, pprLocMsgEnvelopeDefault) import GHC.Utils.Outputable @@ -46,35 +46,6 @@ import qualified GHC.Utils.Outputable as Outputable import GHC.Types.Error (DiagnosticReason (WarningWithoutFlag)) import GHC.Types.SrcLoc (isGoodSrcSpan) -#elif MIN_VERSION_ghc(9,4,0) -import GHC.Utils.Error - (DiagOpts(..), mkPlainDiagnostic, mkPlainMsgEnvelope, pprLocMsgEnvelope) -import GHC.Utils.Outputable - (blankLine, empty, int, integer, showSDocUnsafe, text, ($$), ($+$), (<+>), - defaultSDocContext ) -import qualified GHC.Utils.Outputable as Outputable -import GHC.Types.Error (DiagnosticReason (WarningWithoutFlag)) -import GHC.Types.SrcLoc (isGoodSrcSpan) -#elif MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Error (mkPlainWarnMsg, pprLocMsgEnvelope) -import GHC.Utils.Outputable - (blankLine, empty, int, integer, showSDocUnsafe, text, ($$), ($+$), (<+>)) -import qualified GHC.Utils.Outputable as Outputable -import GHC.Types.SrcLoc (isGoodSrcSpan) -#elif 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)) @@ -115,22 +86,11 @@ diag = mkPlainDiagnostic WarningWithoutFlag [] (warnMsg i1 iw $+$ blankLine $+$ srcInfo1) warnMsg1 = mkPlainMsgEnvelope opts sp diag warnMsg2 = pprLocMsgEnvelopeDefault warnMsg1 -#elif MIN_VERSION_ghc(9,6,0) +#else opts = DiagOpts mempty mempty False False Nothing defaultSDocContext diag = mkPlainDiagnostic WarningWithoutFlag [] (warnMsg i1 iw $+$ blankLine $+$ srcInfo1) warnMsg1 = mkPlainMsgEnvelope opts sp diag warnMsg2 = pprLocMsgEnvelopeDefault warnMsg1 -#elif MIN_VERSION_ghc(9,4,0) - opts = DiagOpts mempty mempty False False Nothing defaultSDocContext - diag = mkPlainDiagnostic WarningWithoutFlag [] (warnMsg i1 iw $+$ blankLine $+$ srcInfo1) - warnMsg1 = mkPlainMsgEnvelope opts sp diag - warnMsg2 = pprLocMsgEnvelope warnMsg1 -#elif MIN_VERSION_ghc(9,2,0) - warnMsg1 = mkPlainWarnMsg sp (warnMsg i1 iw $+$ blankLine $+$ srcInfo1) - warnMsg2 = pprLocMsgEnvelope warnMsg1 -#else - warnMsg1 = mkPlainWarnMsg unsafeGlobalDynFlags sp (warnMsg i1 iw $+$ blankLine $+$ srcInfo1) - warnMsg2 = pprLocErrMsg warnMsg1 #endif liftIO (hPutStrLn stderr (showSDocUnsafe warnMsg2)) 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 @@ -56,9 +56,7 @@ import GHC.Stack (HasCallStack) import Text.Read (readMaybe) -#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as KeyMap -#endif -- | An unresolved primitive still contains pointers to files. type UnresolvedPrimitive = Primitive Text ((TemplateFormat,BlackBoxFunctionName),Maybe TemplateSource) (Maybe S.Text) (Maybe TemplateSource) @@ -238,11 +236,7 @@ instance FromJSON UnresolvedPrimitive where parseJSON (Object v) = -#if MIN_VERSION_aeson(2,0,0) case KeyMap.toList v of -#else - case H.toList v of -#endif [(conKey,Object conVal)] -> case conKey of "BlackBoxHaskell" -> do 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 @@ -26,16 +26,11 @@ import qualified Control.Lens as Lens import Control.Monad.Fix (MonadFix) import Control.Monad.State.Strict (State) -#if MIN_VERSION_transformers(0,5,6) import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State (MonadState (..)) import Control.Monad.Trans.RWS.CPS (RWST) import qualified Control.Monad.Trans.RWS.CPS as RWS import Control.Monad.Writer (MonadWriter (..)) -#else -import Control.Monad.Trans.RWS.Strict (RWST) -import qualified Control.Monad.Trans.RWS.Strict as RWS -#endif import Data.Binary (Binary) import Data.HashMap.Strict (HashMap) import Data.IntMap.Strict (IntMap) @@ -174,14 +169,10 @@ , Functor , Monad , MonadFix - ) -#if MIN_VERSION_transformers(0,5,6) && MIN_VERSION_mtl(2,3,0) - deriving newtype - ( MonadState (RewriteState extra) + , MonadState (RewriteState extra) , MonadWriter Any , MonadReader RewriteEnv ) -#endif -- | Run the computation in the RewriteMonad runR @@ -190,37 +181,6 @@ -> RewriteState extra -> IO (a, RewriteState extra, Any) runR m = RWS.runRWST (unR m) - -#if MIN_VERSION_transformers(0,5,6) && !MIN_VERSION_mtl(2,3,0) --- For Control.Monad.Trans.RWS.Strict these are already defined, however the --- CPS version of RWS is not included in `mtl` yet. - -instance MonadState (RewriteState extra) (RewriteMonad extra) where - get = R RWS.get - {-# INLINE get #-} - put = R . RWS.put - {-# INLINE put #-} - state = R . RWS.state - {-# INLINE state #-} - -instance MonadWriter Any (RewriteMonad extra) where - writer = R . RWS.writer - {-# INLINE writer #-} - tell = R . RWS.tell - {-# INLINE tell #-} - listen = R . RWS.listen . unR - {-# INLINE listen #-} - pass = R . RWS.pass . unR - {-# INLINE pass #-} - -instance MonadReader RewriteEnv (RewriteMonad extra) where - ask = R RWS.ask - {-# INLINE ask #-} - local f = R . RWS.local f . unR - {-# INLINE local #-} - reader = R . RWS.reader - {-# INLINE reader #-} -#endif instance MonadUnique (RewriteMonad extra) where getUniqueM = do 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 @@ -30,11 +30,7 @@ import qualified Control.Lens as Lens import qualified Control.Monad as Monad import qualified Control.Monad.State.Strict as State -#if MIN_VERSION_transformers(0,5,6) import qualified Control.Monad.Trans.RWS.CPS as RWS -#else -import qualified Control.Monad.Trans.RWS.Strict as RWS -#endif import qualified Control.Monad.Writer as Writer import Data.Bifunctor (second) import Data.Coerce (coerce) @@ -55,11 +51,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL -#if MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (InlineSpec (..)) -#else -import BasicTypes (InlineSpec (..)) -#endif import Clash.Core.Evaluator.Types (PureHeap, whnf') import Clash.Core.FreeVars @@ -217,7 +209,7 @@ newFV = not (afterFV `Set.isSubsetOf` beforeFV) accidentalShadows = findAccidentialShadows exprNew -- see NOTE [Filter free variables] - allowNewFVsFromCtx = name == "caseCon" + allowNewFVsFromCtx = name `elem` ["caseCon", "reduceConst", "constantSpec"] filterFVs | allowNewFVsFromCtx = Set.filter notInCtx | otherwise = id notInCtx v = notElemInScopeSet v (tfInScope ctx) @@ -273,15 +265,14 @@ after = showPpr exprNew -- NOTE [Filter free variables] --- Since [Give evaluator acces to inscope let-bindings #2571](https://github.com/clash-lang/clash-compiler/pull/2571) --- the evaluator can rewrite expressions using let bindings from the 'TransformContext', --- these bindings may reference other things bound in the context which weren't --- in the expression before, and in doing so introduces new free variables and --- fails this check for new free variables. --- To prevent this we filter out all variables from bound in the context. --- But only during a caseCon transformation, to not weaken this check unnecessarily. - - +-- Since [Give evaluator access to in-scope let-bindings #2571](https://github.com/clash-lang/clash-compiler/pull/2571) +-- the evaluator can rewrite expressions using let bindings from its 'TransformContext'. +-- These bindings may reference other variables bound in the context which weren't +-- in the expression before. By just looking at the expression (i.e., not accounting +-- for the 'TransformContext'), it would therefore seem that free variables are +-- introduce which would subsequently fail the freevar check. To prevent this we +-- filter out all variables bound in the context, but only during a transformations +-- that call 'whnfRW'. -- | Perform a transformation on a Term runRewrite @@ -628,11 +619,7 @@ -- function at this moment for a reason! -- (termination, CSE and DEC oppertunities, -- ,etc.) -#if MIN_VERSION_ghc(9,2,0) (Binding newBodyId sp NoUserInlinePrag IsFun newBody r) -#else - (Binding newBodyId sp NoUserInline IsFun newBody r) -#endif -- Return the new binder return (var, newExpr) -- If it does, use the existing binder diff --git a/src/Clash/Unique.hs b/src/Clash/Unique.hs --- a/src/Clash/Unique.hs +++ b/src/Clash/Unique.hs @@ -30,11 +30,7 @@ import GHC.Int (Int(I#)) import GHC.Exts (Int#) #endif -#if MIN_VERSION_ghc(9,0,0) import qualified GHC.Types.Unique as GHC -#else -import qualified Unique as GHC -#endif #ifdef UNIQUE_IS_WORD64 type Unique = Word64 diff --git a/src/Clash/Util.hs b/src/Clash/Util.hs --- a/src/Clash/Util.hs +++ b/src/Clash/Util.hs @@ -18,9 +18,7 @@ ( module Clash.Util , SrcSpan , noSrcSpan -#if MIN_VERSION_transformers(0,6,0) , hoistMaybe -#endif ) where @@ -28,11 +26,7 @@ import Control.Lens import Control.Monad.State (MonadState,StateT) import qualified Control.Monad.State as State -#if MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.Maybe (hoistMaybe) -#else -import Control.Monad.Trans.Maybe (MaybeT (..)) -#endif import Data.Hashable (Hashable) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMapL @@ -61,11 +55,7 @@ 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.Data.UniqMap (UniqMap) import qualified Clash.Data.UniqMap as UniqMap @@ -347,8 +337,3 @@ thenCompare :: Ordering -> Ordering -> Ordering thenCompare EQ rel = rel thenCompare rel _ = rel - -#if !MIN_VERSION_transformers(0,6,0) -hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b -hoistMaybe = MaybeT . pure -#endif diff --git a/src/Clash/Util/Supply.hs b/src/Clash/Util/Supply.hs --- a/src/Clash/Util/Supply.hs +++ b/src/Clash/Util/Supply.hs @@ -1,7 +1,5 @@ {-# LANGUAGE MagicHash, UnboxedTuples, CPP, PatternSynonyms #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} -#endif {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} ----------------------------------------------------------------------------- @@ -42,10 +40,6 @@ import Data.Hashable import Data.IORef -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710 -import Data.Functor ((<$>)) -import Data.Monoid -#endif import GHC.IO (unsafeDupablePerformIO, unsafePerformIO) import Clash.Unique (Unique, Unique#, pattern Unique#) 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 @@ -42,13 +42,8 @@ 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/IntMap/Extra.hs b/src/Data/IntMap/Extra.hs deleted file mode 100644 --- a/src/Data/IntMap/Extra.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Data.IntMap.Extra where - -#if !MIN_VERSION_containers(0,6,2) -import Data.IntMap.Internal - --- TODO We can remove this when support for GHC 8.6 is dropped. - --- | /O(n+m)/. Check whether the key sets of two maps are disjoint --- (i.e. their 'intersection' is empty). --- --- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())]) == True --- > disjoint (fromList [(2,'a')]) (fromList [(1,'a'), (2,'b')]) == False --- > disjoint (fromList []) (fromList []) == True --- --- > disjoint a b == null (intersection a b) --- -disjoint :: IntMap a -> IntMap b -> Bool -disjoint Nil _ = True -disjoint _ Nil = True -disjoint (Tip kx _) ys = notMember kx ys -disjoint xs (Tip ky _) = notMember ky xs -disjoint t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) - | shorter m1 m2 = disjoint1 - | shorter m2 m1 = disjoint2 - | p1 == p2 = disjoint l1 l2 && disjoint r1 r2 - | otherwise = True - where - disjoint1 | nomatch p2 p1 m1 = True - | zero p2 m1 = disjoint l1 t2 - | otherwise = disjoint r1 t2 - disjoint2 | nomatch p1 p2 m2 = True - | zero p1 m2 = disjoint t1 l2 - | otherwise = disjoint t1 r2 -#endif 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 @@ -26,10 +26,6 @@ import "extra" Data.List.Extra as NeilsExtra import "extra" Control.Monad.Extra (anyM, allM, orM, partitionM) -#if !MIN_VERSION_base(4,18,0) -import Control.Applicative (liftA2) -#endif - #if defined(DEBUG) import GHC.Stack (HasCallStack) #endif diff --git a/src/Data/Primitive/ByteArray/Extra.hs b/src/Data/Primitive/ByteArray/Extra.hs --- a/src/Data/Primitive/ByteArray/Extra.hs +++ b/src/Data/Primitive/ByteArray/Extra.hs @@ -18,14 +18,6 @@ -- In primitive < 0.8.0.0, its ByteArray is a distinct type from -- Data.Array.Byte.ByteArray (insofar as the latter even exists). #define DEFINE_HASHABLE_BYTEARRAY -#elif !MIN_VERSION_hashable(1,4,1) --- hashable < 1.4.1 doesn't define a Hashable ByteArray instance at all. -#define DEFINE_HASHABLE_BYTEARRAY -#elif !MIN_VERSION_hashable(1,4,2) --- hashable 1.4.1 defines hashable for the ByteArray added to base 4.17. -#if !MIN_VERSION_base(4,17,0) -#define DEFINE_HASHABLE_BYTEARRAY -#endif #endif #ifdef DEFINE_HASHABLE_BYTEARRAY 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 @@ -10,18 +10,12 @@ 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 -#if MIN_VERSION_ghc(9,4,0) import GHC.Types.SourceText -#endif #if MIN_VERSION_ghc(9,8,0) import Data.ByteString @@ -41,29 +35,21 @@ get = unsafeCoerce (get :: Get ByteString) #endif -#if MIN_VERSION_ghc(9,4,0) deriving instance Generic SourceText #if !MIN_VERSION_ghc(9,8,0) instance NFData SourceText #endif instance Binary SourceText -#endif -- | Determine whether given 'InlineSpec' is NOINLINE or more strict (OPAQUE) isNoInline :: InlineSpec -> Bool isNoInline NoInline{} = True -#if MIN_VERSION_ghc(9,4,0) isNoInline Opaque{} = True -#endif isNoInline _ = False -- | Determine whether given 'InlineSpec' is OPAQUE. If this function is used on -- a GHC that does not support OPAQUE yet (<9.4), it will return 'True' if given -- 'InlineSpec' is NOINLINE instead. isOpaque :: InlineSpec -> Bool -#if MIN_VERSION_ghc(9,4,0) isOpaque Opaque{} = True -#else -isOpaque NoInline{} = True -#endif isOpaque _ = False 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 @@ -13,7 +13,6 @@ 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, @@ -21,24 +20,11 @@ srcLocFile, srcLocLine, srcLocCol, srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol) import GHC.Data.FastString (FastString (..), bytesFS, mkFastStringByteList) -#else -import SrcLoc - (SrcSpan (..), RealSrcLoc, RealSrcSpan, - mkRealSrcLoc, mkRealSrcSpan, - realSrcSpanStart, realSrcSpanEnd, - srcLocFile, srcLocLine, srcLocCol, - srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol) -import FastString (FastString (..), bytesFS, mkFastStringByteList) -#endif -#if MIN_VERSION_ghc(9,4,0) import qualified GHC.Data.Strict -#endif -#if MIN_VERSION_ghc(9,4,0) deriving instance Generic (GHC.Data.Strict.Maybe a) instance Hashable a => Hashable (GHC.Data.Strict.Maybe a) instance Binary a => Binary (GHC.Data.Strict.Maybe a) -#endif deriving instance Generic SrcSpan instance Hashable SrcSpan @@ -64,7 +50,6 @@ 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 @@ -76,4 +61,3 @@ 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 @@ -3,11 +3,7 @@ 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/tools/v16-upgrade-primitives.hs b/tools/v16-upgrade-primitives.hs --- a/tools/v16-upgrade-primitives.hs +++ b/tools/v16-upgrade-primitives.hs @@ -7,12 +7,10 @@ module Main where -#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as Aeson import Data.String (IsString) import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText -#endif import qualified Data.Aeson.Extra as AesonExtra import qualified Data.Aeson as Aeson @@ -70,7 +68,6 @@ we like them to be. And find-and-replace those temporary names back in the resulting ByteString. -} -#if MIN_VERSION_aeson(2,0,0) keySortingRenames :: IsString str => [(str,str)] keySortingRenames = [ ("name", "aaaa_really_should_be_name_but_renamed_to_get_the_sorting_we_like") @@ -94,15 +91,6 @@ LazyText.encodeUtf8 (foldl go (LazyText.decodeUtf8 inp) keySortingRenames) where go txt (orig,temp) = LazyText.replace temp orig txt -#else --- < aeson-2.0 stores keys in HashMaps, whose order we can't possibly predict. -removeTempKey :: ByteString -> ByteString -removeTempKey = id - -customSortOutput:: Aeson.Value -> Aeson.Value -customSortOutput = id -#endif - main :: IO () main = do