clash-prelude 1.0.1 → 1.2.0

raw patch · 110 files changed

+5092/−1739 lines, 110 filesdep +quickcheck-classes-basedep +recursion-schemesdep +tasty-quickcheckdep ~ghc-typelits-extradep ~ghc-typelits-knownnatdep ~ghc-typelits-natnormalisePVP ok

version bump matches the API change (PVP)

Dependencies added: quickcheck-classes-base, recursion-schemes, tasty-quickcheck, text-show, th-abstraction

Dependency ranges changed: ghc-typelits-extra, ghc-typelits-knownnat, ghc-typelits-natnormalise, lens, template-haskell

API changes (from Hackage documentation)

Files

• AUTHORS.md +1/−2
• CHANGELOG.md +277/−396
• benchmarks/BenchBitVector.hs +143/−20
• benchmarks/BenchCommon.hs +9/−0
• benchmarks/BenchFixed.hs +11/−2
• benchmarks/BenchRAM.hs +95/−0
• benchmarks/BenchSigned.hs +169/−37
• benchmarks/BenchUnsigned.hs +226/−0
• benchmarks/benchmark-main.hs +10/−42
• clash-prelude.cabal +95/−33
• src/Clash/Annotations/BitRepresentation.hs +6/−5
• src/Clash/Annotations/BitRepresentation/Deriving.hs +47/−30
• src/Clash/Annotations/BitRepresentation/Internal.hs +56/−31
• src/Clash/Annotations/Primitive.hs +10/−14
• src/Clash/Annotations/SynthesisAttributes.hs +2/−3
• src/Clash/Annotations/TH.hs +520/−0
• src/Clash/Annotations/TopEntity.hs +2/−6
• src/Clash/CPP.hs +28/−1
• src/Clash/Class/AutoReg.hs +13/−0
• src/Clash/Class/AutoReg/Instances.hs +30/−0
• src/Clash/Class/AutoReg/Internal.hs +466/−0
• src/Clash/Class/BitPack.hs +29/−32
• src/Clash/Class/BitPack/Internal.hs +1/−1
• src/Clash/Class/Exp.hs +2/−9
• src/Clash/Class/HasDomain.hs +5/−0
• src/Clash/Class/HasDomain/CodeGen.hs +0/−2
• src/Clash/Class/HasDomain/Common.hs +2/−4
• src/Clash/Class/HasDomain/HasSingleDomain.hs +7/−8
• src/Clash/Class/HasDomain/HasSpecificDomain.hs +8/−9
• src/Clash/Class/Num.hs +1/−2
• src/Clash/Class/Parity.hs +114/−0
• src/Clash/Class/Resize.hs +2/−5
• src/Clash/Clocks.hs +12/−9
• src/Clash/Clocks/Deriving.hs +19/−6
• src/Clash/Examples.hs +11/−8
• src/Clash/Explicit/BlockRam.hs +10/−20
• src/Clash/Explicit/BlockRam/File.hs +13/−19
• src/Clash/Explicit/DDR.hs +3/−12
• src/Clash/Explicit/Prelude.hs +4/−3
• src/Clash/Explicit/Prelude/Safe.hs +2/−9
• src/Clash/Explicit/RAM.hs +14/−20
• src/Clash/Explicit/ROM.hs +6/−10
• src/Clash/Explicit/ROM/File.hs +1/−6
• src/Clash/Explicit/Signal.hs +78/−17
• src/Clash/Explicit/Signal/Delayed.hs +133/−13
• src/Clash/Explicit/SimIO.hs +333/−0
• src/Clash/Explicit/Synchronizer.hs +4/−7
• src/Clash/Explicit/Testbench.hs +4/−8
• src/Clash/HaskellPrelude.hs +6/−5
• src/Clash/Hidden.hs +4/−8
• src/Clash/Intel/ClockGen.hs +15/−17
• src/Clash/Intel/DDR.hs +2/−8
• src/Clash/Magic.hs +172/−7
• src/Clash/NamedTypes.hs +1/−2
• src/Clash/Prelude.hs +21/−8
• src/Clash/Prelude/BitIndex.hs +4/−8
• src/Clash/Prelude/BitReduction.hs +3/−6
• src/Clash/Prelude/BlockRam.hs +3/−5
• src/Clash/Prelude/BlockRam/File.hs +2/−8
• src/Clash/Prelude/DataFlow.hs +2/−6
• src/Clash/Prelude/RAM.hs +3/−9
• src/Clash/Prelude/ROM.hs +2/−5
• src/Clash/Prelude/ROM/File.hs +1/−6
• src/Clash/Prelude/Safe.hs +2/−5
• src/Clash/Prelude/Synchronizer.hs +1/−3
• src/Clash/Prelude/Testbench.hs +19/−4
• src/Clash/Promoted/Nat.hs +10/−14
• src/Clash/Promoted/Nat/Literals.hs +1/−2
• src/Clash/Promoted/Symbol.hs +4/−4
• src/Clash/Signal.hs +26/−30
• src/Clash/Signal/BiSignal.hs +16/−17
• src/Clash/Signal/Bundle.hs +76/−11
• src/Clash/Signal/Bundle/Internal.hs +125/−50
• src/Clash/Signal/Delayed.hs +19/−40
• src/Clash/Signal/Delayed/Bundle.hs +27/−16
• src/Clash/Signal/Delayed/Internal.hs +6/−13
• src/Clash/Signal/Internal.hs +22/−37
• src/Clash/Signal/Internal/Ambiguous.hs +3/−5
• src/Clash/Signal/Trace.hs +9/−23
• src/Clash/Sized/BitVector.hs +0/−2
• src/Clash/Sized/Fixed.hs +66/−22
• src/Clash/Sized/Index.hs +1/−5
• src/Clash/Sized/Internal/BitVector.hs +13/−19
• src/Clash/Sized/Internal/BitVector.hs-boot +4/−3
• src/Clash/Sized/Internal/Index.hs +21/−26
• src/Clash/Sized/Internal/Index.hs-boot +5/−4
• src/Clash/Sized/Internal/Signed.hs +16/−17
• src/Clash/Sized/Internal/Unsigned.hs +16/−16
• src/Clash/Sized/RTree.hs +23/−24
• src/Clash/Sized/Vector.hs +41/−25
• src/Clash/Sized/Vector.hs-boot +6/−5
• src/Clash/Tutorial.hs +183/−161
• src/Clash/XException.hs +234/−112
• src/Clash/XException/TH.hs +155/−0
• src/Clash/Xilinx/ClockGen.hs +2/−4
• src/Clash/Xilinx/DDR.hs +2/−8
• src/Language/Haskell/TH/Compat.hs +1/−0
• tests/Clash/Tests/AutoReg.hs +37/−0
• tests/Clash/Tests/BitPack.hs +1/−3
• tests/Clash/Tests/BitVector.hs +34/−7
• tests/Clash/Tests/DerivingDataRepr.hs +1/−4
• tests/Clash/Tests/DerivingDataReprTypes.hs +0/−2
• tests/Clash/Tests/NFDataX.hs +121/−18
• tests/Clash/Tests/Signal.hs +3/−4
• tests/Clash/Tests/Signed.hs +43/−0
• tests/Clash/Tests/SizedNum.hs +24/−0
• tests/Clash/Tests/TopEntityGeneration.hs +324/−0
• tests/Clash/Tests/Unsigned.hs +37/−0
• tests/doctests.hs +28/−4
• tests/unittests.hs +9/−1

@@ -1,2 +1,1 @@-* [Christiaan Baaij](mailto:christiaan.baaij@gmail.com) [@christiaanb](https://github.com/christiaanb)-* John Ericson [@Ericson2314](https://github.com/Ericson2314)+See [GitHub contributors statistics](https://github.com/clash-lang/clash-compiler/graphs/contributors) and [clash-lang.org/publications](https://clash-lang.org/publications/).

@@ -1,21 +1,155 @@-# Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude)+# Changelog for the Clash project +## 1.2.0 *March 5th 2020*+As promised when releasing 1.0, we've tried our best to keep the API stable. We+think most designs will continue to compile with this new version, although special+care needs to be taken when using:++  * Use inline blackboxes. Instead of taking a single HDL, inline primitives now+    take multiple. For example, `InlinePrimitive VHDL ".."` must now be written+    as `InlinePrimitive [VHDL] ".."`.++  * Use the `Enum` instance for `BitVector`, `Index`, `Signed`, or `Unsigned`, as+    they now respect their `maxBound`. See [#1089](https://github.com/clash-lang/clash-compiler/issues/1089).++On top of that, we've added a number of new features:++  * `makeTopEntity`: Template Haskell function for generating TopEntity annotations. See [the documentation on Haddock](http://hackage.haskell.org/package/clash-prelude-1.2.0/docs/Clash-Annotations-TopEntity.html) for more information.++  * `Clash.Explicit.SimIO`: ((System)Verilog only) I/O actions that can be translated to HDL I/O. See [the documentation on Haddock](http://hackage.haskell.org/package/clash-prelude-1.2.0/docs/Clash-Explicit-SimIO.html) for more information.++  * `Clash.Class.AutoReg`: A smart register that improves the chances of synthesis tools inferring clock-gated registers, when used. See [the documentation on Haddock](http://hackage.haskell.org/package/clash-prelude-1.2.0/docs/Clash-Class-AutoReg.html) for more information.++The full list of changes follows. Happy hacking!++* New features (API):+  * `Clash.Class.Parity` type class replaces Prelude `odd` and `even` functions due to assumptions that don't hold for Clash specific numerical types, see [#970](https://github.com/clash-lang/clash-compiler/pull/970).+  * `NFDataX.ensureSpine`, see [#748](https://github.com/clash-lang/clash-compiler/pull/803)+  * `makeTopEntity` Template Haskell function for generating TopEntity annotations+    intended to cover the majority of use cases. Generation failures should either+    result in an explicit error, or a valid annotation of an empty `PortProduct`.+    Any discrepancy between the _shape_ of generated annotations and the _shape_+    of the Clash compiler is a bug. See [#795](https://github.com/clash-lang/clash-compiler/pull/795).+    Known limitations:+    * Type application (excluding `Signal`s and `:::`) is best effort:+    * Data types with type parameters will work if the generator can discover a single relevant constructor after attempting type application.+    * Arbitrary explicit clock/reset/enables are supported, but only a single `HiddenClockResetEnable` constraint is supported.+    * Data/type family support is best effort.+  * Added `Bundle ((f :*: g) a)` instance+  * Added `NFDataX CUShort` instance+  * Clash's internal type family solver now recognizes `AppendSymbol` and `CmpSymbol`+  * Added `Clash.Magic.suffixNameFromNat`: can be used in cases where `suffixName` is too slow+  * Added `Clash.Class.AutoReg`. Improves the chances of synthesis tools inferring clock-gated registers, when used. See [#873](https://github.com/clash-lang/clash-compiler/pull/873).+  * `Clash.Magic.suffixNameP`, `Clash.Magic.suffixNameFromNatP`: enable prefixing of name suffixes+  * Added `Clash.Magic.noDeDup`: can be used to instruct Clash to /not/ share a function between multiple branches+  * A `BitPack a` constraint now implies a `KnownNat (BitSize a)` constraint, so you won't have to add it manually anymore. See [#942](https://github.com/clash-lang/clash-compiler/pull/942).+  * `Clash.Explicit.SimIO`: ((System)Verilog only) I/O actions that can be translated to HDL I/O; useful for generated test benches.+  * Export `Clash.Explicit.Testbench.assertBitVector` [#888](https://github.com/clash-lang/clash-compiler/pull/888/files)+  * Add `Clash.Prelude.Testbench.assertBitVector` to achieve feature parity with `Clash.Explicit.Testbench`. [#891](https://github.com/clash-lang/clash-compiler/pull/891/files)+  * Add `Clash.XException.NFDataX.ensureSpine` [#803](https://github.com/clash-lang/clash-compiler/pull/803)+  * Add `Clash.Class.BitPack.bitCoerceMap` [#798](https://github.com/clash-lang/clash-compiler/pull/798)+  * Add `Clash.Magic.deDup`: instruct Clash to force sharing an operator between multiple branches of a case-expression+  * `InlinePrimitive` can now support multiple backends simultaneously [#425](https://github.com/clash-lang/clash-compiler/issues/425)+  * Add `Clash.XException.hwSeqX`: render declarations of an argument, but don't assign it to a result signal+  * Add `Clash.Signal.Bundle.TaggedEmptyTuple`: allows users to emulate the pre-1.0 behavior of "Bundle ()". See [#1100](https://github.com/clash-lang/clash-compiler/pull/1100)++* New features (Compiler):+  * [#961](https://github.com/clash-lang/clash-compiler/pull/961): Show `-fclash-*` Options in `clash --show-options`++* New internal features:+  * [#918](https://github.com/clash-lang/clash-compiler/pull/935): Add X-Optimization to normalization passes (-fclash-aggressive-x-optimization)+  * [#821](https://github.com/clash-lang/clash-compiler/pull/821): Add `DebugTry`: print name of all tried transformations, even if they didn't succeed+  * [#856](https://github.com/clash-lang/clash-compiler/pull/856): Add `-fclash-debug-transformations`: only print debug info for specific transformations+  * [#911](https://github.com/clash-lang/clash-compiler/pull/911): Add 'RenderVoid' option to blackboxes+  * [#958](https://github.com/clash-lang/clash-compiler/pull/958): Prefix names of inlined functions+  * [#947](https://github.com/clash-lang/clash-compiler/pull/947): Add "Clash.Core.TermLiteral"+  * [#887](https://github.com/clash-lang/clash-compiler/pull/887): Show nicer error messages when failing in TH code+  * [#884](https://github.com/clash-lang/clash-compiler/pull/884): Teach reduceTypeFamily about AppendSymbol and CmpSymbol+  * [#784](https://github.com/clash-lang/clash-compiler/pull/784): Print whether `Id` is global or local in ppr output+  * [#781](https://github.com/clash-lang/clash-compiler/pull/781): Use naming contexts in register names+  * [#1061](https://github.com/clash-lang/clash-compiler/pull/1061): Add 'usedArguments' to BlackBoxHaskell blackboxes++* Fixes issues:+  * [#974](https://github.com/clash-lang/clash-compiler/issues/974): Fix indirect shadowing in `reduceNonRepPrim`+  * [#964](https://github.com/clash-lang/clash-compiler/issues/964): SaturatingNum instance of `Index` now behaves correctly when the size of the index overflows+  an `Int`.+  * [#810](https://github.com/clash-lang/clash-compiler/issues/810): Verilog backend now correctly specifies type of `BitVector 1`+  * [#811](https://github.com/clash-lang/clash-compiler/issues/811): Improve module load behavior in clashi+  * [#439](https://github.com/clash-lang/clash-compiler/issues/439): Template Haskell splices and TopEntity annotations can now be used in clashi+  * [#662](https://github.com/clash-lang/clash-compiler/issues/662): Clash will now constant specialize partially constant constructs+  * [#700](https://github.com/clash-lang/clash-compiler/issues/700): Check work content of expression in cast before warning users. Should eliminate a lot of (superfluous) warnings about "specializing on non work-free cast"s.+  * [#837](https://github.com/clash-lang/clash-compiler/issues/837): Blackboxes will now report clearer error messages if they're given unexpected arguments.+  * [#869](https://github.com/clash-lang/clash-compiler/issues/869): PLL is no longer duplicated in Blinker.hs example+  * [#749](https://github.com/clash-lang/clash-compiler/issues/749): Clash's dependencies now all work with GHC 8.8, allowing `clash-{prelude,lib,ghc}` to be compiled from Hackage soon.+  * [#871](https://github.com/clash-lang/clash-compiler/issues/871): RTree Bundle instance is now properly lazy+  * [#895](https://github.com/clash-lang/clash-compiler/issues/895): VHDL type error when generating `Maybe (Vec 2 (Signed 8), Index 1)`+  * [#880](https://github.com/clash-lang/clash-compiler/issues/880): Custom bit representations can now be used on product types too+  * [#976](https://github.com/clash-lang/clash-compiler/issues/976): Prevent shadowing in Clash's core evaluator+  * [#1007](https://github.com/clash-lang/clash-compiler/issues/1007): Can't translate domain tagType.Errors.IfStuck...+  * [#967](https://github.com/clash-lang/clash-compiler/issues/967): Naming registers disconnects their output+  * [#990](https://github.com/clash-lang/clash-compiler/issues/990): Internal shadowing bug results in incorrect HDL+  * [#945](https://github.com/clash-lang/clash-compiler/issues/945): Rewrite rules for Vec Applicative Functor+  * [#919](https://github.com/clash-lang/clash-compiler/issues/919): Clash generating invalid Verilog after Vec operations #919+  * [#996](https://github.com/clash-lang/clash-compiler/issues/996): Ambiguous clock when using `ClearOnReset` and `resetGen` together+  * [#701](https://github.com/clash-lang/clash-compiler/issues/701): Unexpected behaviour with the `Synthesize` annotation+  * [#694](https://github.com/clash-lang/clash-compiler/issues/694): Custom bit representation error only with VHDL+  * [#347](https://github.com/clash-lang/clash-compiler/issues/347): topEntity synthesis fails due to insufficient type-level normalisation+  * [#626](https://github.com/clash-lang/clash-compiler/issues/626): Missing Clash.Explicit.Prelude definitions+  * [#960](https://github.com/clash-lang/clash-compiler/issues/626): Blackbox Error Caused by Simple map+  * [#1012](https://github.com/clash-lang/clash-compiler/issues/1012): Case-let doesn't look through ticks+  * [#430](https://github.com/clash-lang/clash-compiler/issues/430): Issue warning when not compiled with `executable-dynamic: True`+  * [#374](https://github.com/clash-lang/clash-compiler/issues/1012): Clash.Sized.Fixed: fromInteger and fromRational don't saturate correctly+  * [#836](https://github.com/clash-lang/clash-compiler/issues/836): Generate warning when `toInteger` blackbox drops MSBs+  * [#1019](https://github.com/clash-lang/clash-compiler/issues/1019): Clash breaks on constants defined in terms of `GHC.Natural.gcdNatural`+  * [#1025](https://github.com/clash-lang/clash-compiler/issues/1025): `inlineCleanup`will not produce empty letrecs anymore+  * [#1030](https://github.com/clash-lang/clash-compiler/issues/1030): `bindConstantVar` will bind (workfree) constructs+  * [#1034](https://github.com/clash-lang/clash-compiler/issues/1034): Error (10137): object "pllLock" on lhs must have a variable data type+  * [#1046](https://github.com/clash-lang/clash-compiler/issues/1046): Don't confuse term/type namespaces in 'lookupIdSubst'+  * [#1041](https://github.com/clash-lang/clash-compiler/issues/1041): Nested product types incorrectly decomposed into ports+  * [#1058](https://github.com/clash-lang/clash-compiler/issues/1058): Prevent substitution warning when using type equalities in top entities+  * [#1033](https://github.com/clash-lang/clash-compiler/issues/1033): Fix issue where Clash breaks when using Clock/Reset/Enable in product types in combination with Synthesize annotations+  * [#1075](https://github.com/clash-lang/clash-compiler/issues/1075): Removed superfluous constraints on 'maybeX' and 'maybeIsX'+  * [#1085](https://github.com/clash-lang/clash-compiler/issues/1085): Suggest exporting topentities if they can't be found in a module+  * [#1065](https://github.com/clash-lang/clash-compiler/pull/1065): Report polymorphic topEntities as errors+  * [#1089](https://github.com/clash-lang/clash-compiler/issues/1089): Respect maxBound in Enum instances for BitVector,Index,Signed,Unsigned++* Fixes without issue reports:+  * Fix bug in `rnfX` defined for `Down` ([baef30e](https://github.com/clash-lang/clash-compiler/commit/baef30eae03dc02ba847ffbb8fae7f365c5287c2))+  * Render numbers inside gensym ([bc76f0f](https://github.com/clash-lang/clash-compiler/commit/bc76f0f1934fd6e6ed9c33bcf950dae21e2f7903))+  * Report blackbox name when encountering an error in 'setSym' ([#858](https://github.com/clash-lang/clash-compiler/pull/858))+  * Fix blackbox issues causing Clash to generate invalid HDL ([#865](https://github.com/clash-lang/clash-compiler/pull/865))+  * Treat types with a zero-width custom bit representation like other zero-width constructs ([#874](https://github.com/clash-lang/clash-compiler/pull/874))+  * TH code for auto deriving bit representations now produces nicer error messages ([7190793](https://github.com/clash-lang/clash-compiler/commit/7190793928545f85157f9b8d4b8ec2edb2cd8a26))+  * Adds '--enable-shared-executables' for nix builds; this should make Clash run _much_ faster ([#894](https://github.com/clash-lang/clash-compiler/pull/894))+  * Custom bit representations can now mark fields as zero-width without crashing the compiler ([#898](https://github.com/clash-lang/clash-compiler/pull/898))+  * Throw an error if there's data left to parse after successfully parsing a valid JSON construct ([#904](https://github.com/clash-lang/clash-compiler/pull/904))+  * `Data.gfoldl` is now manually implemented, in turn fixing issues with `gshow` ([#933](https://github.com/clash-lang/clash-compiler/pull/933))+  * Fix a number of issues with blackbox implementations ([#934](https://github.com/clash-lang/clash-compiler/pull/934))+  * Don't inline registers with non-constant clock and reset ([#998](https://github.com/clash-lang/clash-compiler/pull/998))+  * Inline let-binders called [dsN | N <- [1..]] ([#992](https://github.com/clash-lang/clash-compiler/pull/992))+  * ClockGens use their name at the Haskell level [#827](https://github.com/clash-lang/clash-compiler/pull/827)+  * Render numbers inside gensym [#809](https://github.com/clash-lang/clash-compiler/pull/809)+  * Don't overwrite existing binders when specializing [#790](https://github.com/clash-lang/clash-compiler/pull/790)+  * Deshadow in 'caseCase' [#1067](https://github.com/clash-lang/clash-compiler/pull/1067)+  * Deshadow in 'caseLet' and 'nonRepANF' [#1071](https://github.com/clash-lang/clash-compiler/pull/1071)++* Deprecations & removals:+  * Removed support for GHC 8.2 ([#842](https://github.com/clash-lang/clash-compiler/pull/842))+  * Removed support for older cabal versions, only Cabal >=2.2 supported ([#851](https://github.com/clash-lang/clash-compiler/pull/851))+  * Reset and Enable constructors are now only exported from Clash.Signal.Internal+  * [#986](https://github.com/clash-lang/clash-compiler/issues/986) Remove -fclash-allow-zero-width flag+ ## 1.0.0 *September 3rd 2019*+* 10x - 50x faster compile times * New features:   * API changes: check the migration guide at the end of `Clash.Tutorial`-  * All memory elements now have an (implicit) enable line; "Gated" clocks have-    been removed as the clock wasn't actually gated, but implemented as an-    enable line.+  * All memory elements now have an (implicit) enable line; "Gated" clocks have been removed as the clock wasn't actually gated, but implemented as an enable line.   * Circuit domains are now configurable in:     * (old) The clock period-    * (new) Clock edge on which memory elements latch their inputs-      (rising edge or falling edge)-    * (new) Whether the reset port of a memory element is level sensitive-      (asynchronous reset) or edge sensitive (synchronous reset)-    * (new) Whether the reset port of a memory element is active-high or-      active-low (negated reset)-    * (new) Whether memory element power on in a configurable/defined state-      (common on FPGAs) or in an undefined state (ASICs)+    * (new) Clock edge on which memory elements latch their inputs (rising edge or falling edge)+    * (new) Whether the reset port of a memory element is level sensitive asynchronous reset) or edge sensitive (synchronous reset)+    * (new) Whether the reset port of a memory element is active-high or active-low (negated reset)+    * (new) Whether memory element power on in a configurable/defined state (common on FPGAs) or in an undefined state (ASICs)      * See the [blog post](https://clash-lang.org/blog/0005-synthesis-domain/) on this new feature   * Data types can now be given custom bit-representations: http://hackage.haskell.org/package/clash-prelude/docs/Clash-Annotations-BitRepresentation.html@@ -35,404 +169,151 @@     See for example: http://hackage.haskell.org/package/clash-lib/docs/Clash-Primitives-Intel-ClockGen.html  * Fixes issues:-  * [#316](https://github.com/clash-lang/clash-prelude/issues/316)-  * [#319](https://github.com/clash-lang/clash-prelude/issues/319)-  * [#323](https://github.com/clash-lang/clash-prelude/issues/323)-  * [#324](https://github.com/clash-lang/clash-prelude/issues/324)-  * [#329](https://github.com/clash-lang/clash-prelude/issues/329)-  * [#331](https://github.com/clash-lang/clash-prelude/issues/331)-  * [#332](https://github.com/clash-lang/clash-prelude/issues/332)-  * [#335](https://github.com/clash-lang/clash-prelude/issues/335)-  * [#348](https://github.com/clash-lang/clash-prelude/issues/348)-  * [#349](https://github.com/clash-lang/clash-prelude/issues/349)-  * [#350](https://github.com/clash-lang/clash-prelude/issues/350)-  * [#351](https://github.com/clash-lang/clash-prelude/issues/351)-  * [#352](https://github.com/clash-lang/clash-prelude/issues/352)-  * [#353](https://github.com/clash-lang/clash-prelude/issues/353)-  * [#358](https://github.com/clash-lang/clash-prelude/issues/358)-  * [#359](https://github.com/clash-lang/clash-prelude/issues/359)-  * [#363](https://github.com/clash-lang/clash-prelude/issues/363)-  * [#364](https://github.com/clash-lang/clash-prelude/issues/364)-  * [#365](https://github.com/clash-lang/clash-prelude/issues/365)-  * [#371](https://github.com/clash-lang/clash-prelude/issues/371)-  * [#372](https://github.com/clash-lang/clash-prelude/issues/372)-  * [#373](https://github.com/clash-lang/clash-prelude/issues/373)-  * [#378](https://github.com/clash-lang/clash-prelude/issues/378)-  * [#380](https://github.com/clash-lang/clash-prelude/issues/380)-  * [#381](https://github.com/clash-lang/clash-prelude/issues/381)-  * [#382](https://github.com/clash-lang/clash-prelude/issues/382)-  * [#383](https://github.com/clash-lang/clash-prelude/issues/383)-  * [#387](https://github.com/clash-lang/clash-prelude/issues/387)-  * [#393](https://github.com/clash-lang/clash-prelude/issues/393)-  * [#396](https://github.com/clash-lang/clash-prelude/issues/396)-  * [#398](https://github.com/clash-lang/clash-prelude/issues/398)-  * [#399](https://github.com/clash-lang/clash-prelude/issues/399)-  * [#401](https://github.com/clash-lang/clash-prelude/issues/401)-  * [#403](https://github.com/clash-lang/clash-prelude/issues/403)-  * [#407](https://github.com/clash-lang/clash-prelude/issues/407)-  * [#412](https://github.com/clash-lang/clash-prelude/issues/412)-  * [#413](https://github.com/clash-lang/clash-prelude/issues/413)-  * [#420](https://github.com/clash-lang/clash-prelude/issues/420)-  * [#422](https://github.com/clash-lang/clash-prelude/issues/422)-  * [#423](https://github.com/clash-lang/clash-prelude/issues/423)-  * [#424](https://github.com/clash-lang/clash-prelude/issues/424)-  * [#438](https://github.com/clash-lang/clash-prelude/issues/438)-  * [#450](https://github.com/clash-lang/clash-prelude/issues/450)-  * [#452](https://github.com/clash-lang/clash-prelude/issues/452)-  * [#455](https://github.com/clash-lang/clash-prelude/issues/455)-  * [#460](https://github.com/clash-lang/clash-prelude/issues/460)-  * [#461](https://github.com/clash-lang/clash-prelude/issues/461)-  * [#463](https://github.com/clash-lang/clash-prelude/issues/463)-  * [#468](https://github.com/clash-lang/clash-prelude/issues/468)-  * [#475](https://github.com/clash-lang/clash-prelude/issues/475)-  * [#476](https://github.com/clash-lang/clash-prelude/issues/476)-  * [#500](https://github.com/clash-lang/clash-prelude/issues/500)-  * [#507](https://github.com/clash-lang/clash-prelude/issues/507)-  * [#512](https://github.com/clash-lang/clash-prelude/issues/512)-  * [#516](https://github.com/clash-lang/clash-prelude/issues/516)-  * [#517](https://github.com/clash-lang/clash-prelude/issues/517)-  * [#526](https://github.com/clash-lang/clash-prelude/issues/526)-  * [#556](https://github.com/clash-lang/clash-prelude/issues/556)-  * [#560](https://github.com/clash-lang/clash-prelude/issues/560)-  * [#566](https://github.com/clash-lang/clash-prelude/issues/566)-  * [#567](https://github.com/clash-lang/clash-prelude/issues/567)-  * [#569](https://github.com/clash-lang/clash-prelude/issues/569)-  * [#573](https://github.com/clash-lang/clash-prelude/issues/573)-  * [#575](https://github.com/clash-lang/clash-prelude/issues/575)-  * [#581](https://github.com/clash-lang/clash-prelude/issues/581)-  * [#582](https://github.com/clash-lang/clash-prelude/issues/582)-  * [#586](https://github.com/clash-lang/clash-prelude/issues/586)-  * [#588](https://github.com/clash-lang/clash-prelude/issues/588)-  * [#591](https://github.com/clash-lang/clash-prelude/issues/591)-  * [#596](https://github.com/clash-lang/clash-prelude/issues/596)-  * [#601](https://github.com/clash-lang/clash-prelude/issues/601)-  * [#607](https://github.com/clash-lang/clash-prelude/issues/607)-  * [#629](https://github.com/clash-lang/clash-prelude/issues/629)-  * [#637](https://github.com/clash-lang/clash-prelude/issues/637)-  * [#644](https://github.com/clash-lang/clash-prelude/issues/644)-  * [#647](https://github.com/clash-lang/clash-prelude/issues/647)-  * [#661](https://github.com/clash-lang/clash-prelude/issues/661)-  * [#668](https://github.com/clash-lang/clash-prelude/issues/668)-  * [#677](https://github.com/clash-lang/clash-prelude/issues/677)-  * [#678](https://github.com/clash-lang/clash-prelude/issues/678)-  * [#682](https://github.com/clash-lang/clash-prelude/issues/682)-  * [#691](https://github.com/clash-lang/clash-prelude/issues/691)-  * [#703](https://github.com/clash-lang/clash-prelude/issues/703)-  * [#713](https://github.com/clash-lang/clash-prelude/issues/713)-  * [#715](https://github.com/clash-lang/clash-prelude/issues/715)-  * [#727](https://github.com/clash-lang/clash-prelude/issues/727)-  * [#730](https://github.com/clash-lang/clash-prelude/issues/730)-  * [#736](https://github.com/clash-lang/clash-prelude/issues/736)-  * [#738](https://github.com/clash-lang/clash-prelude/issues/738)+  * [#316](https://github.com/clash-lang/clash-compiler/issues/316)+  * [#319](https://github.com/clash-lang/clash-compiler/issues/319)+  * [#323](https://github.com/clash-lang/clash-compiler/issues/323)+  * [#324](https://github.com/clash-lang/clash-compiler/issues/324)+  * [#329](https://github.com/clash-lang/clash-compiler/issues/329)+  * [#331](https://github.com/clash-lang/clash-compiler/issues/331)+  * [#332](https://github.com/clash-lang/clash-compiler/issues/332)+  * [#335](https://github.com/clash-lang/clash-compiler/issues/335)+  * [#348](https://github.com/clash-lang/clash-compiler/issues/348)+  * [#349](https://github.com/clash-lang/clash-compiler/issues/349)+  * [#350](https://github.com/clash-lang/clash-compiler/issues/350)+  * [#351](https://github.com/clash-lang/clash-compiler/issues/351)+  * [#352](https://github.com/clash-lang/clash-compiler/issues/352)+  * [#353](https://github.com/clash-lang/clash-compiler/issues/353)+  * [#358](https://github.com/clash-lang/clash-compiler/issues/358)+  * [#359](https://github.com/clash-lang/clash-compiler/issues/359)+  * [#363](https://github.com/clash-lang/clash-compiler/issues/363)+  * [#364](https://github.com/clash-lang/clash-compiler/issues/364)+  * [#365](https://github.com/clash-lang/clash-compiler/issues/365)+  * [#371](https://github.com/clash-lang/clash-compiler/issues/371)+  * [#372](https://github.com/clash-lang/clash-compiler/issues/372)+  * [#373](https://github.com/clash-lang/clash-compiler/issues/373)+  * [#378](https://github.com/clash-lang/clash-compiler/issues/378)+  * [#380](https://github.com/clash-lang/clash-compiler/issues/380)+  * [#381](https://github.com/clash-lang/clash-compiler/issues/381)+  * [#382](https://github.com/clash-lang/clash-compiler/issues/382)+  * [#383](https://github.com/clash-lang/clash-compiler/issues/383)+  * [#387](https://github.com/clash-lang/clash-compiler/issues/387)+  * [#393](https://github.com/clash-lang/clash-compiler/issues/393)+  * [#396](https://github.com/clash-lang/clash-compiler/issues/396)+  * [#398](https://github.com/clash-lang/clash-compiler/issues/398)+  * [#399](https://github.com/clash-lang/clash-compiler/issues/399)+  * [#401](https://github.com/clash-lang/clash-compiler/issues/401)+  * [#403](https://github.com/clash-lang/clash-compiler/issues/403)+  * [#407](https://github.com/clash-lang/clash-compiler/issues/407)+  * [#412](https://github.com/clash-lang/clash-compiler/issues/412)+  * [#413](https://github.com/clash-lang/clash-compiler/issues/413)+  * [#420](https://github.com/clash-lang/clash-compiler/issues/420)+  * [#422](https://github.com/clash-lang/clash-compiler/issues/422)+  * [#423](https://github.com/clash-lang/clash-compiler/issues/423)+  * [#424](https://github.com/clash-lang/clash-compiler/issues/424)+  * [#438](https://github.com/clash-lang/clash-compiler/issues/438)+  * [#450](https://github.com/clash-lang/clash-compiler/issues/450)+  * [#452](https://github.com/clash-lang/clash-compiler/issues/452)+  * [#455](https://github.com/clash-lang/clash-compiler/issues/455)+  * [#460](https://github.com/clash-lang/clash-compiler/issues/460)+  * [#461](https://github.com/clash-lang/clash-compiler/issues/461)+  * [#463](https://github.com/clash-lang/clash-compiler/issues/463)+  * [#468](https://github.com/clash-lang/clash-compiler/issues/468)+  * [#475](https://github.com/clash-lang/clash-compiler/issues/475)+  * [#476](https://github.com/clash-lang/clash-compiler/issues/476)+  * [#500](https://github.com/clash-lang/clash-compiler/issues/500)+  * [#507](https://github.com/clash-lang/clash-compiler/issues/507)+  * [#512](https://github.com/clash-lang/clash-compiler/issues/512)+  * [#516](https://github.com/clash-lang/clash-compiler/issues/516)+  * [#517](https://github.com/clash-lang/clash-compiler/issues/517)+  * [#526](https://github.com/clash-lang/clash-compiler/issues/526)+  * [#556](https://github.com/clash-lang/clash-compiler/issues/556)+  * [#560](https://github.com/clash-lang/clash-compiler/issues/560)+  * [#566](https://github.com/clash-lang/clash-compiler/issues/566)+  * [#567](https://github.com/clash-lang/clash-compiler/issues/567)+  * [#569](https://github.com/clash-lang/clash-compiler/issues/569)+  * [#573](https://github.com/clash-lang/clash-compiler/issues/573)+  * [#575](https://github.com/clash-lang/clash-compiler/issues/575)+  * [#581](https://github.com/clash-lang/clash-compiler/issues/581)+  * [#582](https://github.com/clash-lang/clash-compiler/issues/582)+  * [#586](https://github.com/clash-lang/clash-compiler/issues/586)+  * [#588](https://github.com/clash-lang/clash-compiler/issues/588)+  * [#591](https://github.com/clash-lang/clash-compiler/issues/591)+  * [#596](https://github.com/clash-lang/clash-compiler/issues/596)+  * [#601](https://github.com/clash-lang/clash-compiler/issues/601)+  * [#607](https://github.com/clash-lang/clash-compiler/issues/607)+  * [#629](https://github.com/clash-lang/clash-compiler/issues/629)+  * [#637](https://github.com/clash-lang/clash-compiler/issues/637)+  * [#644](https://github.com/clash-lang/clash-compiler/issues/644)+  * [#647](https://github.com/clash-lang/clash-compiler/issues/647)+  * [#661](https://github.com/clash-lang/clash-compiler/issues/661)+  * [#668](https://github.com/clash-lang/clash-compiler/issues/668)+  * [#677](https://github.com/clash-lang/clash-compiler/issues/677)+  * [#678](https://github.com/clash-lang/clash-compiler/issues/678)+  * [#682](https://github.com/clash-lang/clash-compiler/issues/682)+  * [#691](https://github.com/clash-lang/clash-compiler/issues/691)+  * [#703](https://github.com/clash-lang/clash-compiler/issues/703)+  * [#713](https://github.com/clash-lang/clash-compiler/issues/713)+  * [#715](https://github.com/clash-lang/clash-compiler/issues/715)+  * [#727](https://github.com/clash-lang/clash-compiler/issues/727)+  * [#730](https://github.com/clash-lang/clash-compiler/issues/730)+  * [#736](https://github.com/clash-lang/clash-compiler/issues/736)+  * [#738](https://github.com/clash-lang/clash-compiler/issues/738) -## 0.99.3 *July 26th 2018*-* Bundle and BitPack instances up to and including 62-tuples-* Handle undefined writes to RAM properly-* Handle undefined clock enables properly+## 0.99.3 *July 28th 2018*+* Fixes bugs:+  * Evaluator recognizes `Bit` literals [#329](https://github.com/clash-lang/clash-compiler/issues/329)+  * Use existential type-variables in context of GADT pattern match+  * Do not create zero-bit temporary variables in generated HDL+  * Use correct arguments in nested primitives [#323](https://github.com/clash-lang/clash-compiler/issues/329)+  * Zero-constructor data type needs 0 bits [#238](https://github.com/clash-lang/clash-compiler/issues/238)+  * Create empty component when result needs 0 bits+  * Evaluator performs BigNat arithmetic +* Features:+  * Bundle and BitPack instances up to and including 62-tuples+  * Handle undefined writes to RAM properly+  * Handle undefined clock enables properly++ ## 0.99.1 *May 12th 2018*+* Allow `~NAME[N]` tag inside `~GENSYM[X]`+* Support HDL record selector generation [#313](https://github.com/clash-lang/clash-compiler/pull/313)+* `InlinePrimitive` support: specify HDL primitives inline with Haskell code * Support for `ghc-typelits-natnormalise-0.6.1` * `Lift` instances for `TopEntity` and `PortName` * `InlinePrimitive` support: specify HDL primitives inline with Haskell code  ## 0.99 *March 31st 2018*-* Major API overhaul: check the migration guide at the end of `Clash.Tutorial` * New features:-  * Explicit clock and reset arguments-  * Rename `CLaSH` to `Clash`-  * Implicit/`Hidden` clock and reset arguments using a combination of+  * Major API overhaul: check the migration guide at the end of `Clash.Tutorial`+  * New features:+    * Explicit clock and reset arguments+    * Rename `CLaSH` to `Clash`+    * Implicit/`Hidden` clock and reset arguments using a combination of     `reflection` and `ImplicitParams`.-  * Large overhaul of `TopEntity`  annotations-  * PLL and other clock sources can now be instantiated using regular functions:+    * Large overhaul of `TopEntity`  annotations+    * PLL and other clock sources can now be instantiated using regular functions:     `Clash.Intel.ClockGen` and `Clash.Xilinx.ClockGen`.-  * DDR registers:-    * Generic/ASIC: `Clash.Explicit.DDR`-    * Intel: `Clash.Intel.DDR`-    * Xilinx: `Clash.Intel.Xilinx`+    * DDR registers:+      * Generic/ASIC: `Clash.Explicit.DDR`+      * Intel: `Clash.Intel.DDR`+      * Xilinx: `Clash.Intel.Xilinx`   * `Bit` is now a `newtype` instead of a `type` synonym and will be mapped to     a HDL scalar instead of an array of one (e.g `std_logic` instead of     `std_logic_vector(0 downto 0)`)+  * Hierarchies with multiple synthesisable boundaries by allowing more than one+    function in scope to have a `Synthesize` annotation.+    * Local caching of functions with a `Synthesize` annotation+  * `Bit` type is mapped to a HDL scalar type (e.g. `std_logic` in VHDL)+  * Improved name preservation+  * Zero-bit values are filtered out of the generated HDL+  * Improved compile-time computation+* Many bug fixes -## 0.11.2-* New features:-  * Add `riseEvery`: Give a pulse every @n@ clock cycles. (Thanks to @thoughtpolice)-  * Add `oscillate`: Oscillate a @'Bool'@ with a given half-period of cycles. (Thanks to @thoughtpolice)-* Fixes bugs:-  * Eagerness bug in `regEn` [#104](https://github.com/clash-lang/clash-prelude/issues/104) (Thanks to @cbiffle)+## Older versions+Check out:+ * https://github.com/clash-lang/clash-compiler/blob/3649a2962415ea8ca2d6f7f5e673b4c14de26b4f/clash-prelude/CHANGELOG.md+ * https://github.com/clash-lang/clash-compiler/blob/3649a2962415ea8ca2d6f7f5e673b4c14de26b4f/clash-lib/CHANGELOG.md+ * https://github.com/clash-lang/clash-compiler/blob/3649a2962415ea8ca2d6f7f5e673b4c14de26b4f/clash-ghc/CHANGELOG.md -## 0.11.1-* Changes:-  * Bundle instance for `()` behaves like a product-type instance [#96](https://github.com/clash-lang/clash-prelude/issues/96)-* Fixes bugs:-  * Ensure that `fold` gets correctly type-applied in `Vec.==` [#202](https://github.com/clash-lang/clash-compiler/issues/202) -## 0.11-* New features:-  * `CLaSH.XException`: a module defining an exception representing uninitialised values. Additionally adds the `ShowX` class which has methods that prints values as "X" where they would normally raise an `XException` exception.-  * Add `BNat` (and supporting functions) to `CLaSH.Promoted.Nat`: base-2 encoded natural numbers.-  * Add `divSNat` and `logBaseSNat` to `CLaSH.Promoted.Nat`: division and logarithm for singleton natural numbers.-  * Add `predUNat` and `subUNat` to `CLaSH.Promoted.Nat`: predecessor and subtraction for unary-encoded natural numbers.-  * Add `dtfold` to `CLaSH.Sized.Vector`: a dependently-typed tree-fold over `Vec`.-  * Add the perfect-depth binary trees module `CLaSH.Sized.RTree`-  * Synthesisable definitions of `countLeadingZeros` and `countTrailingZeros` for: `BitVector`, `Signed`, `Unsigned`, and `Fixed`-  * Add the `(:::)` type alias in `CLaSH.NamedTypes` which allows you to annotate types with documentation-* Changes:-  * `asyncRam`, `blockRam`, `blockRamFile` have a `Maybe (addr,a)` as write input instead of three separate `Bool`, `addr`, and `a` inputs.-  * `asyncFIFOSynchronizer` has a `Maybe a` as write-request instead of a separate `Bool` and `a` input-  * `bundle'` and `unbundle'` are removed; `bundle` now has type `Unbundled' clk a -> Signal' clk a`, `unbundle` now has type `Signal' clk a -> Unbundled' clk a`-  * `subSNat` now has the type `SNat (a+b) -> SNat b -> SNat a` (where it used to be `SNat a -> SNat b -> SNat (a-b)`)-  * Renamed `multUNat` to `mulUNat` to be in sync with `mulSNat` and `mulBNat`.-  * The function argument of `vfold` in `CLaSH.Sized.Vector` is now `(forall l . SNat l -> a -> Vec l b -> Vec (l + 1) b)` (where it used to be `(forall l . a -> Vec l b -> Vec (l + 1) b)`)-  * `Cons` constructor of `Vec` is no longer visible; `(:>)` and `(:<)` are now listed as constructors of `Vec`-  * Simulation speed improvements for numeric types--## 0.10.12-* Fixes bugs:-  * `Vec`s `unbundle` is too strict, i.e. `register (undefined :: Vec 2 Int)` /= `bundle . unbundle . register (undefined :: Vec 2 Int)`--## 0.10.11 *August 3rd 2016*-* New features:-  * Add strict version of: `sample`, `sampleN`, `fromList`, and `simulate`-  * Make `Signal`s `<*>` slightly stricter:-    * Feedback loops still work with this new implementation-    * No more space-leaks when used in combination with the strict version of `sample`, `sampleN`, and `simulate`-  * Add `NFData` instances for the numeric types-* Speed up arithmetic operations of `Signed`, `Unsigned` and `BitVector`-* Fixes bugs:-  * CLaSH compiler sees internals of numeric types in their `Lift` functions--## 0.10.10 *July 15th 2016*-* Fixes bugs:-  * `shrink` functions for numeric types throw exceptions [#153](https://github.com/clash-lang/clash-compiler/issues/153)-  * CLaSH compiler sees internals of numeric types in their Show functions--## 0.10.9 *June 9th 2016*-* Fixes bugs:-  * `Eq` instance of `Vec` sometimes not synthesisable--## 0.10.8 *June 7th 2016*-* New features:-  * Instances of `Data` for numeric types.-  * Instances of `Read` for {Index, Signed, Unsigned, Fixed}-  * Instances of `BitPack` for 3-8 tuples--## 0.10.7 *April 7th 2016*-* Support doctest-0.11.0--## 0.10.6 *February 10th 2016*-* Fixes bugs:-  * `CLaSH.Prelude.DataFlow.parNDF` is not lazy enough--## 0.10.5 *January 13th 2016*-* New features:-  * Add `readNew` to `CLaSH.Prelude.BlockRam`: create a read-after-write blockRAM from a read-before-write blockRAM.-  * `popCount` functions for `BitVector`, `Signed`, and `Unsigned` are now synthesisable.-  * Add `parNDF` to `CLaSH.Prelude.DataFlow`: compose _N_ dataflow circuits in parallel.-  * Add and instance `Vec n a` for `LockStep` in `CLaSH.Prelude.DataFlow`: have _N_ dataflow circuits operate in lock-step.--## 0.10.4 *December 11th 2015*-* New features:-  * Add `pureDF` to `CLaSH.Prelude.DataFlow`: lift combinational circuits to `DataFlow` circuits.-  * Add `fifoDF` to `CLaSH.Prelude.DataFlow`: a simple FIFO buffer adhering to the `DataFlow` protocol.-  * `loopDF` no longer uses the `lockStep` and `stepLock` automatically, and now includes a FIFO buffer on the feedback path.-  * Add `loopDF_nobuf` to `CLaSH.Prelude.DataFlow`: a version of `loopDF` with no FIFO buffer on the feedback path.-  * Add `boolToBV` to `CLaSH.CLass.BitPack`: convert `Bool`eans to `n`-bit `BitVector`s.-  * `ClockSource` in `CLaSH.Annotations.TopEntity` can now have multiple clock inputs [#33](https://github.com/clash-lang/clash-prelude/issues/33)-* Bug fixes:-  * `asyncRomFile` reads file multiple times.--## 0.10.3 *October 24th 2015*-* Disable CPR analysis (See https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c):-  * GHC < 7.11: In all modules using `-fcpr-off`-  * GHC >= 7.11: In `CLaSH.Signal.Internal` and `CLaSH.Prelude.RAM` using `-fno-cpr-anal`--## 0.10.2 *October 21st 2015*-* New features:-  * `ExtendingNum`, `BitPack`, and `Resize` instance for `Index`-  * Add `bv2i`: convert `BitVector n` to `Index (2^n)`-  * Export type-level operations from [ghc-typelits-extra](http://hackage.haskell.org/package/ghc-typelits-extra)--## 0.10.1 *October 16th 2015*-* New features:-  * The `f` in `dfold p f`, now has an `SNat l` instead of a `Proxy l` as its first argument.-  * Add `bv2v` and `v2bv` functions that convert between `Vec n Bit` and `BitVector n`.-  * Add `smap`: apply a function to every element of a vector and the element's position (as an 'SNat' value) in the vector.--## 0.10 *October 3rd 2015*-* New features:-  * The Vec constructor `:>` is now an explicitly bidirectional pattern synonym (the actual constructor has been renamed to Cons).-    As a result, pattern matching on `:>` is now synthesisable by the CLaSH compiler.-  * The function `<:` is replaced by the the explicitly bidirectional pattern synonym `:<`.-    This allows you to pattern match on: "all but the last element of a vector" and "the last element" of the vector.-    Because it is a bidirectional pattern, `:<` can also be used as an expression that appends an element to the tail of a vector.-  * Add a `transpose` function in `CLaSH.Sized.Vector`.-  * Add `stencil1d` and `stensil2d` stencil computation functions in `CLaSH.Sized.Vector`.-  * Add `permute`, `backpermute`, `scatter`, and `gather` permutation functions in `CLaSH.Sized.Vector`.-  * Add specialised permutation functions `interleave`, `rotateLeft`, and `rotateRight` in `CLaSH.Sized.Vector`.-  * `sscanl` and `sscanr` in `CLaSH.Sized.Vector` are renamed to `postscanl` and postscanr` to be more in line with existing Haskell packages such as `vector` and `accelerate`.-  * The `Foldable` and `Traversable` instances of `Vec` now only works for non-empty vectors.-  * Where possible, members of the `Foldable` instance of `Vec` are described in terms of `fold`, which builds a tree (of depth `log(n)`) of computations, instead of `foldr` which had depth `n` computations.-    This reduces the critical path length in your circuits when using these functions.-  * `maxIndex` and `length` in `CLaSH.Sized.Vector` return an `Int` instead of an `Integer`.-  * Add functions that involve an index into a vector to the `CLaSH.Sized.Vector` module: `indices`, `indicesI`, `imap`, `izipWith`, `ifoldr`, `ifoldl`, `findIndex`, `elemIndex`.-  * `CLaSH.Sized.Vector`'s `fold`, `dfold`, `vfold`, and `toList` are now synthesisable by the CLaSH compiler.--## 0.9.3 *September 21st 2015*-* Fixes bugs:-  * Cannot build against singletons-0.2-  * Numerous documentation fixes--## 0.9.2 *August 2nd 2015*-* Disable strictness analysis in `CLaSH.Signal.Internal`, this allows turning on strictness analysis in the GHC front-end of the CLaSH compiler.--## 0.9.1 *June 26th 2015*-* Updated documentation on data-file support on Altera/Quartus--## 0.9 *June 25th 2015*-* New features:-  * Add operations on singleton natural numbers: `addSNat`, `subSNat`, `mulSNat`, and `powSNat`.-  * Add asynchronous RAM functions in `CLaSH.Prelude.RAM`, which have an asynchronous/combinational read port.-  * Add ROM functions in modules `CLaSH.Prelude.ROM` and `CLaSH.Prelude.ROM.File`, where the latter module contains functions that instantiate a ROM from the content specified in an external data-file.-  * Add BlockRam functions, in the `CLaSH.Prelude.BlockRam.File` module, whose content can be initialised with the content specified in an external data-file.-  * `assert` now takes an extra `String` argument so you can distinguish one `assert` from the others.-  Additionally, `assert'` is added which takes an additional `SClock` argument.-  This is needed, because `assert` now reports the clock cycle, and clock domain, when an assertion fails.-  * `defClkAltera` and `defClkXilinx` are replaced by, `altpll` and `alteraPll` for Altera clock sources, and `clockWizard` for Xilinx clock sources.-  These names correspond to the names of the generator utilities in Quartus and ISE/Vivado.-  * Add [Safe](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/safe_haskell.html) versions of the prelude modules: `CLaSH.Prelude.Safe` and `CLaSH.Prelude.Explicit.Safe`-  * Add synchronizers in the `CLaSH.Prelude.Synchronizer` module--## 0.8 *June 3rd 2015*-* New features:-  * Make the (Bit)Vector argument the _last_ argument for the following functions: `slice`, `setSlice`, `replaceBit`, `replace`. The signatures for the above functions are now:--    ```-    slice      :: BitPack a => SNat m -> SNat n -> a -> BitVector (m + 1 - n)-    setSlice   :: BitPack a => SNat m -> SNat n -> BitVector (m + 1 - n) -> a -> a-    replaceBit :: Integral i => i -> Bit -> a -> a-    replace    :: Integral i => i -> a -> Vec n a -> Vec n a-    ```--    This allows for easier chaining, e.g.:--    ```-    replaceBit 0 1 $-    repleceBit 4 0 $-    replaceBit 6 1 bv-    ```-  * Until version 0.7.5, given `x :: Vec 8 Bit` and `y :: BitVector 8`, it used to be `last x == msb y`.-    This is quite confusing when printing converted values.-    Until version 0.7.5 we would get:--    ```-    > 0x0F :: BitVector 8-    0000_1111-    > unpack 0x0F :: Vec 8 Bit-    <1,1,1,1,0,0,0,0>-    ```--    As of version 0.8, we have `head x == msb y`:--    ```-    > 0x0F :: BitVector 8-    0000_1111-    > unpack 0x0F :: Vec 8 Bit-    <0,0,0,0,1,1,1,1>-    ```--    So converting for `Vec`tors of `Bit`s to `BitVector`s is no longer _index_-preserving, but it is _order_-preserving.-  * Add [QuickCheck](http://hackage.haskell.org/package/QuickCheck) `Arbitary` and `CoArbitary` instances for all data types-  * Add [lens](http://hackage.haskell.org/package/lens) `Ixed` instances for `BitVector`, `Signed`, `Unsigned`, and `Vec`--## 0.7.5 **May 7th 2015**-* New features:-  * Moore machine combinators--## 0.7.4 **May 5th 2015*-* New features:-  * Add `TopEntity` annotations--## 0.7.3 *April 22nd 2015*-* New features:-  * Add the vector functions: `zip3`, `unzip3`, and `zipWith3`-  * Use version 0.2 of the [`ghc-typelits-natnormalise` package](http://hackage.haskell.org/package/ghc-typelits-natnormalise)--## 0.7.2 *April 20th 2015*-* New features:-  * Support for GHC 7.10 => only works with GHC 7.10 and higher-  * Use http://hackage.haskell.org/package/ghc-typelits-natnormalise typechecker plugin for better type-level natural number handling--## 0.7.1 *March 25th 2015*-* Fixes bugs:-  * Fix laziness bug in Vector.(!!) and Vector.replace--## 0.7 *March 13th 2015*-* New features:-  * Switch types of `bundle` and `bundle'`, and `unbundle` and `unbundle'`.-  * Rename all explicitly clocked versions of Signal functions, to the primed-    name of the implicitly clocked Signal functions. E.g. `cregister` is now-    called `register'` (where the implicitly clocked function is callled `register`)-  * Add new instances for `DSignal`-  * Add experimental `antiDelay` function for `DSignal`-  * Generalize lifted functions over Signals (e.g. (.==.))--* Fixes bugs:-  * Faster versions of Vector.(!!) and Vector.replace--## 0.6.0.1 *November 17th 2014*-* Fixes bugs:-  * Add missing 'CLaSH.Sized.BitVector' module to .cabal file.--## 0.6 *November 17th 2014*--* New features:-  * Add `Fractional` instance for `Fixed` [#9](https://github.com/christiaanb/clash-prelude/issues/9)-  * Make indexing/subscript of `Vec` ascending [#4](https://github.com/christiaanb/clash-prelude/issues/4)-  * Add separate `BitVector` type, which has a descending index.-  * Add bit indexing operators, including the index/subscript operator `(!)`.-  * Add bit reduction operators: `reduceOr`, `reduceAnd`, `reduceOr`.-  * Rename `BitVector` class to `BitPack` with `pack` and `unpack` class methods.-  * Rename `Pack` class to `Bundle` with `bundle` and `unbundle` class methods.-  * Strip all `Vec` functions from their `v` prefix, i.e. `vmap` -> `map`.-  * Rename `Vec` indexing operator from `(!)` to `(!!)`.-  * Combine `Add` and `Mult` class into `ExtendingNum` class.-  * Add extend and truncate methods to the `Resize` class.-  * Add `SaturatingNum` class with saturating numeric operators.-  * Add multitude of lifted `Signal` operators, i.e. `(.==.) :: Eq a => Signal a -> Signal a -> Signal Bool`-  * Add `CLaSH.Signal.Delayed` with functions and data types for delay-annotated signals to support safe synchronisation.-  * Add `CLASH.Prelude.DataFlow` with functions and data types to create self-synchronising circuits based on data-flow principles.--* Fixes bugs:-  * Remove deprecated 'Arrow' instance for and related functions for `Comp` [#5](https://github.com/christiaanb/clash-prelude/issues/5)--## 0.5.1 *June 5th 2014*--* New features:-  * Add `Default` instance for `Vec` [#2](https://github.com/christiaanb/clash-prelude/issues/2)-  * Instantiation for `blockRam` [#3](https://github.com/christiaanb/clash-prelude/issues/2)--* Fixes bugs:-  * Fixed error on documentation of fLit in Fixed.hs [#6](https://github.com/christiaanb/clash-prelude/issues/6)-  * Non-translatable `Enum` function interfere with `sassert` compilation [#7](https://github.com/christiaanb/clash-prelude/issues/7)-  * Substituted the word 'list' into 'vector' in some places in the documentation. [#8](https://github.com/christiaanb/clash-prelude/issues/8)-  * mark vselectI INLINEABLE [#10](https://github.com/christiaanb/clash-prelude/issues/10)--## 0.5 *April 3rd 2014*-  * Add explicitly clocked synchronous signals for multi-clock circuits--## 0.4.1 *March 27th 2014*-  * Add saturation to fixed-point operators-  * Finalize most documentation--## 0.4 *March 20th 2014*-  * Add fixed-point integers-  * Extend documentation-  * 'bit' and 'testBit' functions give run-time errors on out-of-bound positions--## 0.3 *March 14th 2014*-  * Add Documentation-  * Easy SNat literals for 0..1024, e.g. d4 = snat :: SNat 4-  * Fix blockRamPow2--## 0.2 *March 5th 2014*-  * Initial release

@@ -1,4 +1,7 @@ {-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType #-}+#endif  {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} @@ -6,12 +9,53 @@  module BenchBitVector where -import Clash.Sized.Internal.BitVector+import Data.Bits+import Clash.Sized.BitVector import Clash.Class.Num+import Clash.Prelude.BitIndex import GHC.TypeLits                   (type (*))-import Criterion                      (Benchmark, env, bench, nf)+import Criterion                      (Benchmark, env, bench, nf, bgroup) import Language.Haskell.TH.Syntax     (lift) +import BenchCommon++bitVectorBench :: Benchmark+bitVectorBench = bgroup "BitVector"+  [ fromIntegerBench+  , addBench+  , addBenchL+  , negateBench+  , negateBenchL+  , subBench+  , subBenchL+  , multBench+  , multBenchL+  , plusBench+  , minusBench+  , timesBench+  , boundedAddBench+  , boundedSubBench+  , boundedMulBench+  , msbBench+  , msbBenchL+  , appendBench+  , appendBenchL+  , splitBench+  , splitBenchL+  , xorBench+  , xorBenchL+  , andBench+  , andBenchL+  , orBench+  , orBenchL+  , complementBench+  , complementBenchL+  ]++smallValueI :: Integer+smallValueI = $(lift (2^(16::Int)-10 :: Integer))+{-# INLINE smallValueI #-}+ smallValue1 :: BitVector WORD_SIZE_IN_BITS smallValue1 = $(lift (2^(16::Int)-10 :: BitVector WORD_SIZE_IN_BITS)) {-# INLINE smallValue1 #-}@@ -21,105 +65,184 @@ {-# INLINE smallValue2 #-}  largeValue1 :: BitVector (3*WORD_SIZE_IN_BITS)-largeValue1 =  2^(2*WORD_SIZE_IN_BITS :: Int)-10 :: BitVector (3*WORD_SIZE_IN_BITS)+largeValue1 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-10 :: BitVector (3*WORD_SIZE_IN_BITS))) {-# INLINE largeValue1 #-}  largeValue2 :: BitVector (3*WORD_SIZE_IN_BITS)-largeValue2 =  2^(2*WORD_SIZE_IN_BITS :: Int)-100 :: BitVector (3*WORD_SIZE_IN_BITS)+largeValue2 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-100 :: BitVector (3*WORD_SIZE_IN_BITS))) {-# INLINE largeValue2 #-} +fromIntegerBench :: Benchmark+fromIntegerBench = env setup $ \m ->+  bench "fromInteger WORD_SIZE_IN_BITS" $+  nf (fromInteger :: Integer -> BitVector WORD_SIZE_IN_BITS) m+  where+    setup = return smallValueI+ addBench :: Benchmark addBench = env setup $ \m ->-  bench "+# WORD_SIZE_IN_BITS" $ nf (uncurry (+#)) m+  bench "+ WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m   where     setup = return (smallValue1,smallValue2) +addBenchL :: Benchmark+addBenchL = env setup $ \m ->+  bench "+ 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m+  where+    setup = return (largeValue1,largeValue2)+ negateBench :: Benchmark negateBench = env setup $ \m ->-  bench "negate# WORD_SIZE_IN_BITS" $ nf negate# m+  bench "negate WORD_SIZE_IN_BITS" $ nf negate m   where     setup = return smallValue1 +negateBenchL :: Benchmark+negateBenchL = env setup $ \m ->+  bench "negate 3*WORD_SIZE_IN_BITS" $ nf negate m+  where+    setup = return largeValue1+ subBench :: Benchmark subBench = env setup $ \m ->-  bench "-# WORD_SIZE_IN_BITS" $ nf (uncurry (-#)) m+  bench "- WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m   where     setup = return (smallValue1,smallValue2) +subBenchL :: Benchmark+subBenchL = env setup $ \m ->+  bench "- 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m+  where+    setup = return (largeValue1,largeValue2)+ multBench :: Benchmark multBench = env setup $ \m ->-  bench "*# WORD_SIZE_IN_BITS" $ nf (uncurry (*#)) m+  bench "* WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m   where     setup = return (smallValue1,smallValue2) +multBenchL :: Benchmark+multBenchL = env setup $ \m ->+  bench "* 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m+  where+    setup = return (largeValue1,largeValue2)+ plusBench :: Benchmark plusBench = env setup $ \m ->-  bench "plus# WORD_SIZE_IN_BITS" $ nf (uncurry (plus#)) m+  bench "plus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 add add) m   where     setup = return (smallValue1,smallValue2)  minusBench :: Benchmark minusBench = env setup $ \m ->-  bench "minus# WORD_SIZE_IN_BITS" $ nf (uncurry (minus#)) m+  bench "minus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 sub sub) m   where     setup = return (smallValue1,smallValue2)  timesBench :: Benchmark timesBench = env setup $ \m ->-  bench "times# WORD_SIZE_IN_BITS" $ nf (uncurry (times#)) m+  bench "times WORD_SIZE_IN_BITS" $ nf (apSwapAp2 mul mul) m   where     setup = return (smallValue1,smallValue2)  boundedAddBench :: Benchmark boundedAddBench = env setup $ \m ->-  bench "boundedAdd WORD_SIZE_IN_BITS" $ nf (uncurry (boundedAdd)) m+  bench "boundedAdd WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedAdd) m   where     setup = return (smallValue1,smallValue2)  boundedSubBench :: Benchmark boundedSubBench = env setup $ \m ->-  bench "boundedSub WORD_SIZE_IN_BITS" $ nf (uncurry (boundedSub)) m+  bench "boundedSub WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedSub) m   where     setup = return (smallValue1,smallValue2)  boundedMulBench :: Benchmark boundedMulBench = env setup $ \m ->-  bench "boundedMul WORD_SIZE_IN_BITS" $ nf (uncurry (boundedMul)) m+  bench "boundedMul WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedMul) m   where     setup = return (smallValue1,smallValue2)  msbBench :: Benchmark msbBench = env setup $ \m ->-  bench "msb# WORD_SIZE_IN_BITS" $ nf msb# m+  bench "msb# WORD_SIZE_IN_BITS" $ nf msb m   where     setup = return smallValue1  msbBenchL :: Benchmark msbBenchL = env setup $ \m ->-  bench "msb# (3*WORD_SIZE_IN_BITS)" $ nf msb# m+  bench "msb# (3*WORD_SIZE_IN_BITS)" $ nf msb m   where     setup = return largeValue1  appendBench :: Benchmark appendBench = env setup $ \m ->-  bench "++# WORD_SIZE_IN_BITS" $ nf (uncurry (++#)) m+  bench "++# WORD_SIZE_IN_BITS" $ nf (apSwapAp2 (++#) (++#)) m   where     setup = return (smallValue1,smallValue2)  appendBenchL :: Benchmark appendBenchL = env setup $ \m ->-  bench "++# (3*WORD_SIZE_IN_BITS)" $ nf (uncurry (++#)) m+  bench "++# (3*WORD_SIZE_IN_BITS)" $ nf (apSwapAp2 (++#) (++#)) m   where     setup = return (largeValue1,largeValue2)  splitBench :: Benchmark splitBench = env setup $ \m ->-  bench "split# WORD_SIZE_IN_BITS" $ nf (split# :: BitVector WORD_SIZE_IN_BITS -> (BitVector 18, BitVector 46)) m+  bench "split# WORD_SIZE_IN_BITS" $ nf (split :: BitVector WORD_SIZE_IN_BITS -> (BitVector 18, BitVector 46)) m   where     setup = return smallValue1  splitBenchL :: Benchmark splitBenchL = env setup $ \m ->-  bench "split# (3*WORD_SIZE_IN_BITS)" $ nf (split# :: BitVector (3*WORD_SIZE_IN_BITS) -> (BitVector 18, BitVector 174)) m+  bench "split# (3*WORD_SIZE_IN_BITS)" $ nf (split :: BitVector (3*WORD_SIZE_IN_BITS) -> (BitVector 18, BitVector 174)) m+  where+    setup = return largeValue1++xorBench :: Benchmark+xorBench = env setup $ \m ->+  bench "xor WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (smallValue1,smallValue2)++xorBenchL :: Benchmark+xorBenchL = env setup $ \m ->+  bench "xor 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (largeValue1,largeValue2)++andBench :: Benchmark+andBench = env setup $ \m ->+  bench ".&. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (smallValue1,smallValue2)++andBenchL :: Benchmark+andBenchL = env setup $ \m ->+  bench ".&. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (largeValue1,largeValue2)++orBench :: Benchmark+orBench = env setup $ \m ->+  bench ".|. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (smallValue1,smallValue2)++orBenchL :: Benchmark+orBenchL = env setup $ \m ->+  bench ".|. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (largeValue1,largeValue2)++complementBench :: Benchmark+complementBench = env setup $ \m ->+  bench "complement WORD_SIZE_IN_BITS" $ nf complement m+  where+    setup = return smallValue1++complementBenchL :: Benchmark+complementBenchL = env setup $ \m ->+  bench "complement 3*WORD_SIZE_IN_BITS" $ nf complement m   where     setup = return largeValue1

@@ -0,0 +1,9 @@+module BenchCommon where++apSwapAp :: (a -> a -> a) -> (a,a) -> a+apSwapAp f (a,b) = f (f a b) (f b a)+{-# INLINE apSwapAp #-}++apSwapAp2 :: (a -> a -> b) -> (b -> b -> c) -> (a,a) -> c+apSwapAp2 f g (a,b) = g (f a b) (f b a)+{-# INLINE apSwapAp2 #-}

@@ -4,13 +4,22 @@  #define WORD_SIZE_IN_BITS 64 -module BenchFixed where+module BenchFixed (fixedBench) where  import Clash.Class.Num import Clash.Sized.Fixed import Clash.Sized.Unsigned-import Criterion                   (Benchmark, env, bench, nf)+import Criterion                   (Benchmark, env, bench, nf, bgroup) import Language.Haskell.TH.Syntax  (lift)++fixedBench :: Benchmark+fixedBench = bgroup "Fixed"+  [ fromRationalBench+  , addBench+  , subBench+  , multBench+  , multBench_wrap+  ]  smallValueR_pos :: Rational smallValueR_pos = $(lift (5126.889117 :: Rational))

@@ -0,0 +1,95 @@+{-# LANGUAGE MagicHash, TypeApplications #-}+module BenchRAM (ramBench) where++import Criterion (Benchmark, env, bench, nf, bgroup)++import Clash.Explicit.BlockRam+import Clash.Explicit.RAM+import Clash.Explicit.ROM+import Clash.Explicit.Signal+import Clash.Prelude.ROM+import Clash.Promoted.Nat.Literals+import qualified Clash.Sized.Vector as V++ramBench :: Benchmark+ramBench = bgroup "RAMs"+  [ asyncRamBench+  , asyncRomBench+  , blockRamBench+  , blockRamROBench+  , romBench+  ]++asyncRamBench :: Benchmark+asyncRamBench = env setup $ \m ->+  bench "asyncRam#" $+  nf (take 98 . drop 2 . simulate_lazy+        (\rw -> let (r,w) = unbundle rw+                in  asyncRam# @System+                      clockGen+                      clockGen+                      enableGen+                      d1024+                      r+                      (pure True)+                      w+                      w+                   )) m+  where+    setup   = pure (zip [556,557..856] [557,558..857])++asyncRomBench :: Benchmark+asyncRomBench = env setup $ \m ->+  bench "asyncRom#" $+  nf (take 98 . drop 2 . fmap (asyncRom# ramInit)) m+  where+    ramInit = V.replicate d1024 (1 :: Int)+    setup   = pure ([557,558..857])++blockRamBench :: Benchmark+blockRamBench = env setup $ \m ->+  bench "blockRam# (100% writes)" $+  nf (take 98 . drop 2 . simulate_lazy+        (\w -> blockRam# @System+                    clockGen+                    enableGen+                    ramInit+                    w+                    (pure True)+                    w+                    w+                   )) m+  where+    ramInit = V.replicate d1024 (1 :: Int)+    setup   = pure ([557,558..857])++blockRamROBench :: Benchmark+blockRamROBench = env setup $ \m ->+  bench "blockRam# (0% writes)" $+  nf (take 98 . drop 2 . simulate_lazy+        (\w -> blockRam# @System+                    clockGen+                    enableGen+                    ramInit+                    w+                    (pure False)+                    w+                    w+                   )) m+  where+    ramInit = V.replicate d1024 (1 :: Int)+    setup   = pure ([557,558..857])++romBench :: Benchmark+romBench = env setup $ \m ->+  bench "rom#" $+  nf (take 98 . drop 2 . simulate_lazy+        (\r -> rom# @System+                    clockGen+                    enableGen+                    ramInit+                    r+                   )) m+  where+    ramInit = V.replicate d1024 (1 :: Int)+    setup   = pure ([557,558..857])

@@ -1,94 +1,226 @@ {-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType #-}+#endif  {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-}  #define WORD_SIZE_IN_BITS 64 -module BenchSigned where+module BenchSigned (signedBench) where +import Data.Bits+import Clash.Class.Num+import Clash.Class.BitPack import Clash.Sized.BitVector-import Clash.Sized.Internal.Signed-import Criterion                   (Benchmark, env, bench, nf)+import Clash.Sized.Signed+import Criterion                   (Benchmark, env, bench, nf, bgroup) import Language.Haskell.TH.Syntax  (lift)+import GHC.TypeLits                (type (*)) -smallValueI_pos :: Integer-smallValueI_pos = $(lift (2^(16::Int)-10 :: Integer))-{-# INLINE smallValueI_pos #-}+import BenchCommon -smallValue_pos1 :: Signed WORD_SIZE_IN_BITS-smallValue_pos1 = $(lift (2^(16::Int)-100 :: Signed WORD_SIZE_IN_BITS))-{-# INLINE smallValue_pos1 #-}+signedBench :: Benchmark+signedBench = bgroup "Signed"+  [ fromIntegerBench+  , addBench+  , addBenchL+  , negateBench+  , negateBenchL+  , subBench+  , subBenchL+  , multBench+  , multBenchL+  , plusBench+  , minusBench+  , timesBench+  , boundedAddBench+  , boundedSubBench+  , boundedMulBench+  , packBench+  , unpackBench+  , xorBench+  , xorBenchL+  , andBench+  , andBenchL+  , orBench+  , orBenchL+  , complementBench+  , complementBenchL+  ] -smallValue_pos2 :: Signed WORD_SIZE_IN_BITS-smallValue_pos2 = $(lift (2^(16::Int)-100 :: Signed WORD_SIZE_IN_BITS))-{-# INLINE smallValue_pos2 #-}+smallValueI :: Integer+smallValueI = $(lift (2^(16::Int)-10 :: Integer))+{-# INLINE smallValueI #-} +smallValue1 :: Signed WORD_SIZE_IN_BITS+smallValue1 = $(lift (2^(16::Int)-10 :: Signed WORD_SIZE_IN_BITS))+{-# INLINE smallValue1 #-}++smallValue2 :: Signed WORD_SIZE_IN_BITS+smallValue2 = $(lift (2^(16::Int)-100 :: Signed WORD_SIZE_IN_BITS))+{-# INLINE smallValue2 #-}+ smallValueBV :: BitVector WORD_SIZE_IN_BITS smallValueBV = $(lift (2^(16::Int)-10 :: BitVector WORD_SIZE_IN_BITS)) {-# INLINE smallValueBV #-} +largeValue1 :: Signed (3*WORD_SIZE_IN_BITS)+largeValue1 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-10 :: Signed (3*WORD_SIZE_IN_BITS)))+{-# INLINE largeValue1 #-}++largeValue2 :: Signed (3*WORD_SIZE_IN_BITS)+largeValue2 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-100 :: Signed (3*WORD_SIZE_IN_BITS)))+{-# INLINE largeValue2 #-}++fromIntegerBench :: Benchmark+fromIntegerBench = env setup $ \m ->+  bench "fromInteger WORD_SIZE_IN_BITS" $+  nf (fromInteger :: Integer -> Signed WORD_SIZE_IN_BITS) m+  where+    setup = return smallValueI+ addBench :: Benchmark addBench = env setup $ \m ->-  bench "+# WORD_SIZE_IN_BITS" $ nf (uncurry (+#)) m+  bench "+ WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2) +addBenchL :: Benchmark+addBenchL = env setup $ \m ->+  bench "+ 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m+  where+    setup = return (largeValue1,largeValue2)+ negateBench :: Benchmark negateBench = env setup $ \m ->-  bench "negate# WORD_SIZE_IN_BITS" $ nf negate# m+  bench "negate WORD_SIZE_IN_BITS" $ nf negate m   where-    setup = return smallValue_pos1+    setup = return smallValue1 -absBench :: Benchmark-absBench = env setup $ \m ->-  bench "abs# WORD_SIZE_IN_BITS" $ nf abs# m+negateBenchL :: Benchmark+negateBenchL = env setup $ \m ->+  bench "negate 3*WORD_SIZE_IN_BITS" $ nf negate m   where-    setup = return smallValue_pos1+    setup = return largeValue1  subBench :: Benchmark subBench = env setup $ \m ->-  bench "-# WORD_SIZE_IN_BITS" $ nf (uncurry (-#)) m+  bench "- WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2) +subBenchL :: Benchmark+subBenchL = env setup $ \m ->+  bench "- 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m+  where+    setup = return (largeValue1,largeValue2)+ multBench :: Benchmark multBench = env setup $ \m ->-  bench "*# WORD_SIZE_IN_BITS" $ nf (uncurry (*#)) m+  bench "* WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2) +multBenchL :: Benchmark+multBenchL = env setup $ \m ->+  bench "* 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m+  where+    setup = return (largeValue1,largeValue2)+ plusBench :: Benchmark plusBench = env setup $ \m ->-  bench "plus# WORD_SIZE_IN_BITS" $ nf (uncurry (plus#)) m+  bench "plus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 add add) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2)  minusBench :: Benchmark minusBench = env setup $ \m ->-  bench "minus# WORD_SIZE_IN_BITS" $ nf (uncurry (minus#)) m+  bench "minus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 sub sub) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2)  timesBench :: Benchmark timesBench = env setup $ \m ->-  bench "times# WORD_SIZE_IN_BITS" $ nf (uncurry (times#)) m+  bench "times WORD_SIZE_IN_BITS" $ nf (apSwapAp2 mul mul) m   where-    setup = return (smallValue_pos1,smallValue_pos2)+    setup = return (smallValue1,smallValue2) -fromIntegerBench :: Benchmark-fromIntegerBench = env setup $ \m ->-  bench "fromInteger# WORD_SIZE_IN_BITS" $ nf (fromInteger# :: Integer -> Signed WORD_SIZE_IN_BITS) m+boundedAddBench :: Benchmark+boundedAddBench = env setup $ \m ->+  bench "boundedAdd WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedAdd) m   where-    setup = return smallValueI_pos+    setup = return (smallValue1,smallValue2) +boundedSubBench :: Benchmark+boundedSubBench = env setup $ \m ->+  bench "boundedSub WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedSub) m+  where+    setup = return (smallValue1,smallValue2)++boundedMulBench :: Benchmark+boundedMulBench = env setup $ \m ->+  bench "boundedMul WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedMul) m+  where+    setup = return (smallValue1,smallValue2)+ packBench :: Benchmark packBench = env setup $ \m ->-  bench "pack# WORD_SIZE_IN_BITS" $ nf pack# m+  bench "pack WORD_SIZE_IN_BITS" $ nf pack m   where-    setup = return smallValue_pos1+    setup = return smallValue1  unpackBench :: Benchmark unpackBench = env setup $ \m ->-  bench "unpack# WORD_SIZE_IN_BITS" $ nf unpack# m+  bench "unpack WORD_SIZE_IN_BITS" $+  nf (unpack :: BitVector WORD_SIZE_IN_BITS -> Signed WORD_SIZE_IN_BITS) m   where     setup = return smallValueBV++xorBench :: Benchmark+xorBench = env setup $ \m ->+  bench "xor WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (smallValue1,smallValue2)++xorBenchL :: Benchmark+xorBenchL = env setup $ \m ->+  bench "xor 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (largeValue1,largeValue2)++andBench :: Benchmark+andBench = env setup $ \m ->+  bench ".&. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (smallValue1,smallValue2)++andBenchL :: Benchmark+andBenchL = env setup $ \m ->+  bench ".&. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (largeValue1,largeValue2)++orBench :: Benchmark+orBench = env setup $ \m ->+  bench ".|. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (smallValue1,smallValue2)++orBenchL :: Benchmark+orBenchL = env setup $ \m ->+  bench ".|. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (largeValue1,largeValue2)++complementBench :: Benchmark+complementBench = env setup $ \m ->+  bench "complement WORD_SIZE_IN_BITS" $ nf complement m+  where+    setup = return smallValue1++complementBenchL :: Benchmark+complementBenchL = env setup $ \m ->+  bench "complement 3*WORD_SIZE_IN_BITS" $ nf complement m+  where+    setup = return largeValue1

@@ -0,0 +1,226 @@+{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType #-}+#endif++{-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-}++#define WORD_SIZE_IN_BITS 64++module BenchUnsigned (unsignedBench) where++import Data.Bits+import Clash.Class.Num+import Clash.Class.BitPack+import Clash.Sized.BitVector+import Clash.Sized.Unsigned+import Criterion                   (Benchmark, env, bench, nf, bgroup)+import Language.Haskell.TH.Syntax  (lift)+import GHC.TypeLits                (type (*))++import BenchCommon++unsignedBench :: Benchmark+unsignedBench = bgroup "Unsigned"+  [ fromIntegerBench+  , addBench+  , addBenchL+  , negateBench+  , negateBenchL+  , subBench+  , subBenchL+  , multBench+  , multBenchL+  , plusBench+  , minusBench+  , timesBench+  , boundedAddBench+  , boundedSubBench+  , boundedMulBench+  , packBench+  , unpackBench+  , xorBench+  , xorBenchL+  , andBench+  , andBenchL+  , orBench+  , orBenchL+  , complementBench+  , complementBenchL+  ]++smallValueI :: Integer+smallValueI = $(lift (2^(16::Int)-10 :: Integer))+{-# INLINE smallValueI #-}++smallValue1 :: Unsigned WORD_SIZE_IN_BITS+smallValue1 = $(lift (2^(16::Int)-10 :: Unsigned WORD_SIZE_IN_BITS))+{-# INLINE smallValue1 #-}++smallValue2 :: Unsigned WORD_SIZE_IN_BITS+smallValue2 = $(lift (2^(16::Int)-100 :: Unsigned WORD_SIZE_IN_BITS))+{-# INLINE smallValue2 #-}++smallValueBV :: BitVector WORD_SIZE_IN_BITS+smallValueBV = $(lift (2^(16::Int)-10 :: BitVector WORD_SIZE_IN_BITS))+{-# INLINE smallValueBV #-}++largeValue1 :: Unsigned (3*WORD_SIZE_IN_BITS)+largeValue1 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-10 :: Unsigned (3*WORD_SIZE_IN_BITS)))+{-# INLINE largeValue1 #-}++largeValue2 :: Unsigned (3*WORD_SIZE_IN_BITS)+largeValue2 = $(lift (2^(2*WORD_SIZE_IN_BITS :: Int)-100 :: Unsigned (3*WORD_SIZE_IN_BITS)))+{-# INLINE largeValue2 #-}++fromIntegerBench :: Benchmark+fromIntegerBench = env setup $ \m ->+  bench "fromInteger WORD_SIZE_IN_BITS" $+  nf (fromInteger :: Integer -> Unsigned WORD_SIZE_IN_BITS) m+  where+    setup = return smallValueI++addBench :: Benchmark+addBench = env setup $ \m ->+  bench "+ WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m+  where+    setup = return (smallValue1,smallValue2)++addBenchL :: Benchmark+addBenchL = env setup $ \m ->+  bench "+ 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (+)) m+  where+    setup = return (largeValue1,largeValue2)++negateBench :: Benchmark+negateBench = env setup $ \m ->+  bench "negate WORD_SIZE_IN_BITS" $ nf negate m+  where+    setup = return smallValue1++negateBenchL :: Benchmark+negateBenchL = env setup $ \m ->+  bench "negate 3*WORD_SIZE_IN_BITS" $ nf negate m+  where+    setup = return largeValue1++subBench :: Benchmark+subBench = env setup $ \m ->+  bench "- WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m+  where+    setup = return (smallValue1,smallValue2)++subBenchL :: Benchmark+subBenchL = env setup $ \m ->+  bench "- 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (-)) m+  where+    setup = return (largeValue1,largeValue2)++multBench :: Benchmark+multBench = env setup $ \m ->+  bench "* WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m+  where+    setup = return (smallValue1,smallValue2)++multBenchL :: Benchmark+multBenchL = env setup $ \m ->+  bench "* 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (*)) m+  where+    setup = return (largeValue1,largeValue2)++plusBench :: Benchmark+plusBench = env setup $ \m ->+  bench "plus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 add add) m+  where+    setup = return (smallValue1,smallValue2)++minusBench :: Benchmark+minusBench = env setup $ \m ->+  bench "minus WORD_SIZE_IN_BITS" $ nf (apSwapAp2 sub sub) m+  where+    setup = return (smallValue1,smallValue2)++timesBench :: Benchmark+timesBench = env setup $ \m ->+  bench "times WORD_SIZE_IN_BITS" $ nf (apSwapAp2 mul mul) m+  where+    setup = return (smallValue1,smallValue2)++boundedAddBench :: Benchmark+boundedAddBench = env setup $ \m ->+  bench "boundedAdd WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedAdd) m+  where+    setup = return (smallValue1,smallValue2)++boundedSubBench :: Benchmark+boundedSubBench = env setup $ \m ->+  bench "boundedSub WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedSub) m+  where+    setup = return (smallValue1,smallValue2)++boundedMulBench :: Benchmark+boundedMulBench = env setup $ \m ->+  bench "boundedMul WORD_SIZE_IN_BITS" $ nf (apSwapAp boundedMul) m+  where+    setup = return (smallValue1,smallValue2)++packBench :: Benchmark+packBench = env setup $ \m ->+  bench "pack WORD_SIZE_IN_BITS" $ nf pack m+  where+    setup = return smallValue1++unpackBench :: Benchmark+unpackBench = env setup $ \m ->+  bench "unpack WORD_SIZE_IN_BITS" $+  nf (unpack :: BitVector WORD_SIZE_IN_BITS -> Unsigned WORD_SIZE_IN_BITS) m+  where+    setup = return smallValueBV++xorBench :: Benchmark+xorBench = env setup $ \m ->+  bench "xor WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (smallValue1,smallValue2)++xorBenchL :: Benchmark+xorBenchL = env setup $ \m ->+  bench "xor 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp xor) m+  where+    setup = return (largeValue1,largeValue2)++andBench :: Benchmark+andBench = env setup $ \m ->+  bench ".&. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (smallValue1,smallValue2)++andBenchL :: Benchmark+andBenchL = env setup $ \m ->+  bench ".&. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.&.)) m+  where+    setup = return (largeValue1,largeValue2)++orBench :: Benchmark+orBench = env setup $ \m ->+  bench ".|. WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (smallValue1,smallValue2)++orBenchL :: Benchmark+orBenchL = env setup $ \m ->+  bench ".|. 3*WORD_SIZE_IN_BITS" $ nf (apSwapAp (.|.)) m+  where+    setup = return (largeValue1,largeValue2)++complementBench :: Benchmark+complementBench = env setup $ \m ->+  bench "complement WORD_SIZE_IN_BITS" $ nf complement m+  where+    setup = return smallValue1++complementBenchL :: Benchmark+complementBenchL = env setup $ \m ->+  bench "complement 3*WORD_SIZE_IN_BITS" $ nf complement m+  where+    setup = return largeValue1

@@ -2,50 +2,18 @@  import Criterion.Main -import qualified BenchBitVector as BV-import qualified BenchFixed     as F-import qualified BenchSigned    as S+import BenchRAM+import BenchBitVector+import BenchFixed+import BenchSigned+import BenchUnsigned  main :: IO () main =   defaultMain-  [-    bgroup "BitVector"-        [ BV.addBench-        , BV.negateBench-        , BV.subBench-        , BV.multBench-        , BV.plusBench-        , BV.minusBench-        , BV.timesBench-        , BV.boundedAddBench-        , BV.boundedSubBench-        , BV.boundedMulBench-        , BV.msbBench-        , BV.msbBenchL-        , BV.appendBench-        , BV.appendBenchL-        , BV.splitBench-        , BV.splitBenchL-        ]-  , bgroup "Signed"-        [ S.fromIntegerBench-        , S.addBench-        , S.negateBench-        , S.absBench-        , S.subBench-        , S.multBench-        , S.plusBench-        , S.minusBench-        , S.timesBench-        , S.packBench-        , S.unpackBench-        ]-  , bgroup "Fixed"-        [ F.fromRationalBench-        , F.addBench-        , F.subBench-        , F.multBench-        , F.multBench_wrap-        ]+  [ ramBench+  , bitVectorBench+  , fixedBench+  , signedBench+  , unsignedBench   ]

@@ -1,5 +1,6 @@+Cabal-version:        2.2 Name:                 clash-prelude-Version:              1.0.1+Version:              1.2.0 Synopsis:             CAES Language for Synchronous Hardware - Prelude library Description:   Clash is a functional hardware description language that borrows both its@@ -41,9 +42,9 @@   A preliminary version of a tutorial can be found in "Clash.Tutorial", for a   general overview of the library you should however check out "Clash.Prelude".   Some circuit examples can be found in "Clash.Examples".-Homepage:             http://www.clash-lang.org/-bug-reports:          http://github.com/clash-lang/clash-compiler/issues-License:              BSD2+Homepage:             https://clash-lang.org/+bug-reports:          https://github.com/clash-lang/clash-compiler/issues+License:              BSD-2-Clause License-file:         LICENSE Author:               The Clash Authors Maintainer:           QBayLogic B.V. <devops@qbaylogic.com>@@ -59,13 +60,25 @@  extra-doc-files:      doc/*.svg -Cabal-version:        >=1.18-Tested-with:          GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1- source-repository head   type: git-  location: https://github.com/clash-lang/clash-prelude.git+  location: https://github.com/clash-lang/clash-compiler.git+  subdir: clash-prelude +flag large-tuples+  description:+    Generate instances for classes such as `NFDataX` and `BitPack` for tuples+    up to and including 62 elements - the GHC imposed maximum. This greatly+    increases compile times for `clash-prelude` and therefore mostly impacts the+    Clash developers themselves. Hence its default is set to disabled on+    development versions and enabled on releases.+  -- I have no idea to pass cabal flags to nix, so the comment below,+  -- "-- large-tuples", is there to enable a call to 'sed' that replaces+  -- True with False. This is done to prevent OOM on CircleCI.+  -- large-tuples+  default: True+  manual: True+ flag super-strict   description:     Use `deepseqX` (instead of `seqX`) in register-like constructs. This can@@ -75,6 +88,13 @@   default: False   manual: True +flag strict-mapSignal+  description:+    Use `seqX` in 'mapSignal#'. This can help to eliminate space leaks in long+    running simulations.+  default: False+  manual: True+ flag multiple-hidden   description:     Allow multiple hidden clocks, resets, and enables to be used. This is an@@ -102,22 +122,56 @@   default: True   manual: True +common common-options+  default-language:   Haskell2010+  default-extensions: BangPatterns+                      BinaryLiterals+                      DataKinds+                      DefaultSignatures+                      DeriveDataTypeable+                      DeriveFoldable+                      DeriveFunctor+                      DeriveGeneric+                      DeriveLift+                      DeriveTraversable+                      DerivingStrategies+                      InstanceSigs+                      KindSignatures+                      MagicHash+                      ScopedTypeVariables+                      StandaloneDeriving+                      TupleSections+                      TypeApplications+                      TypeOperators+                      ViewPatterns++  if impl(ghc >= 8.6)+      default-extensions: NoStarIsType+ Library+  import:             common-options   HS-Source-Dirs:     src -  default-language:   Haskell2010   ghc-options:        -Wall -fexpose-all-unfoldings -fno-worker-wrapper   CPP-Options:        -DCABAL +  if flag(large-tuples)+    CPP-Options: -DLARGE_TUPLES+   if flag(super-strict)     CPP-Options: -DCLASH_SUPER_STRICT +  if flag(strict-mapSignal)+    CPP-Options: -DCLASH_STRICT_MAPSIGNAL+   if flag(multiple-hidden)     CPP-Options: -DCLASH_MULTIPLE_HIDDEN    if flag(multiple-hidden)     Exposed-modules:  Clash.Prelude.Synchronizer +  Autogen-Modules:    Paths_clash_prelude+   Exposed-modules:    Clash.Annotations.TopEntity                       Clash.Annotations.Primitive                       Clash.Annotations.BitRepresentation@@ -125,7 +179,9 @@                       Clash.Annotations.BitRepresentation.Internal                       Clash.Annotations.BitRepresentation.Util                       Clash.Annotations.SynthesisAttributes+                      Clash.Annotations.TH +                      Clash.Class.AutoReg                       Clash.Class.BitPack                       Clash.Class.Exp                       Clash.Class.HasDomain@@ -134,6 +190,7 @@                       Clash.Class.HasDomain.CodeGen                       Clash.Class.HasDomain.Common                       Clash.Class.Num+                      Clash.Class.Parity                       Clash.Class.Resize                        Clash.Clocks@@ -149,6 +206,7 @@                       Clash.Explicit.ROM.File                       Clash.Explicit.Prelude                       Clash.Explicit.Prelude.Safe+                      Clash.Explicit.SimIO                       Clash.Explicit.Signal                       Clash.Explicit.Signal.Delayed                       Clash.Explicit.Synchronizer@@ -209,6 +267,7 @@                       Clash.Sized.Internal.Unsigned                        Clash.XException+                      Clash.XException.TH                        Clash.Xilinx.ClockGen                       Clash.Xilinx.DDR@@ -216,39 +275,27 @@                       Clash.Tutorial                       Clash.Examples -  other-modules:      Clash.Class.BitPack.Internal+  other-modules:+                      Clash.Class.AutoReg.Instances+                      Clash.Class.AutoReg.Internal+                      Clash.Class.BitPack.Internal                       Clash.CPP                       Clash.Signal.Bundle.Internal                       Language.Haskell.TH.Compat                       Paths_clash_prelude    other-extensions:   CPP-                      BangPatterns                       ConstraintKinds-                      DataKinds-                      DefaultSignatures-                      DeriveDataTypeable-                      DeriveTraversable-                      DeriveLift                       FlexibleContexts                       FlexibleInstances                       GADTs                       GeneralizedNewtypeDeriving-                      InstanceSigs-                      KindSignatures-                      MagicHash                       MultiParamTypeClasses                       PatternSynonyms-                      Rank2Types-                      ScopedTypeVariables-                      StandaloneDeriving+                      RankNTypes                       TemplateHaskell-                      TupleSections-                      TypeApplications                       TypeFamilies-                      TypeOperators                       UndecidableInstances-                      ViewPatterns    Build-depends:      array                     >= 0.5.1.0 && < 0.6,                       base                      >= 4.10    && < 5,@@ -262,19 +309,22 @@                       integer-gmp               >= 0.5.1.0 && < 1.1,                       deepseq                   >= 1.4.1.0 && < 1.5,                       ghc-prim                  >= 0.5.1.0 && < 0.6,-                      ghc-typelits-extra        >= 0.3.1   && < 0.4,-                      ghc-typelits-knownnat     >= 0.6     && < 0.8,-                      ghc-typelits-natnormalise >= 0.6     && < 0.8,+                      ghc-typelits-extra        >= 0.3.3   && < 0.4,+                      ghc-typelits-knownnat     >= 0.7.2   && < 0.8,+                      ghc-typelits-natnormalise >= 0.7.1   && < 0.8,                       hashable                  >= 1.2.1.0  && < 1.4,                       half                      >= 0.2.2.3 && < 1.0,-                      lens                      >= 4.9     && < 4.19,+                      lens                      >= 4.10    && < 4.20,+                      recursion-schemes         >= 5.1     && < 5.2,                       QuickCheck                >= 2.7     && < 2.14,                       reflection                >= 2       && < 2.2,                       singletons                >= 1.0     && < 3.0,                       template-haskell          >= 2.12.0.0 && < 2.16,+                      th-abstraction            >= 0.2.10 && < 0.4.0,                       th-lift                   >= 0.7.0    && < 0.9,                       th-orphans                >= 0.13.1   && < 1.0,                       text                      >= 0.11.3.1 && < 1.3,+                      text-show                 >= 3.8     && < 3.9,                       time                      >= 1.8     && < 1.10,                       transformers              >= 0.5.2.0 && < 0.6,                       type-errors               >= 0.2.0.0 && < 0.3,@@ -299,8 +349,8 @@       doctest >= 0.16.1  test-suite unittests+  import:           common-options   type:             exitcode-stdio-1.0-  default-language: Haskell2010   main-is:          unittests.hs   ghc-options:      -Wall   hs-source-dirs:   tests@@ -315,15 +365,24 @@        base,       hint          >= 0.7      && < 0.10,+      quickcheck-classes-base >= 0.6 && < 1.0,       tasty         >= 1.2      && < 1.3,-      tasty-hunit+      tasty-hunit,+      tasty-quickcheck,+      template-haskell -  Other-Modules: Clash.Tests.BitPack+  Other-Modules:+                 Clash.Tests.AutoReg+                 Clash.Tests.BitPack                  Clash.Tests.BitVector                  Clash.Tests.DerivingDataRepr                  Clash.Tests.DerivingDataReprTypes                  Clash.Tests.Signal+                 Clash.Tests.Signed+                 Clash.Tests.SizedNum                  Clash.Tests.NFDataX+                 Clash.Tests.TopEntityGeneration+                 Clash.Tests.Unsigned   benchmark benchmark-clash-prelude@@ -344,5 +403,8 @@       template-haskell    Other-Modules:    BenchBitVector+                    BenchCommon                     BenchFixed+                    BenchRAM                     BenchSigned+                    BenchUnsigned

@@ -8,12 +8,9 @@  -} -{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveLift         #-}-{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TemplateHaskell #-}  {-# OPTIONS_GHC -Wno-orphans #-} @@ -43,6 +40,7 @@ type Value    = Integer type Size     = Int +-- | BitMask used to mask fields type FieldAnn = BitMask  -- | Lift values inside of 'TH.Q' to a Template Haskell expression@@ -105,6 +103,9 @@ -- underlying @Color@ field of @Just@ by passing /[0b11]/ to ConstrRepr. This -- indicates that the first field is encoded in the first and second bit of the -- whole datatype (0b11).+--+-- __NB__: BitPack for a custom encoding can be derived using+-- 'Clash.Annotations.BitRepresentation.Deriving.deriveBitPack'. data DataReprAnn =   DataReprAnn     -- Type this annotation is for:

@@ -13,20 +13,13 @@     e.g. one-hot, for a data type.  -}-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DataKinds          #-}-{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveLift         #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE MagicHash          #-}-{-# LANGUAGE MultiWayIf         #-}-{-# LANGUAGE QuasiQuotes        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell    #-}-{-# LANGUAGE ViewPatterns       #-}-+{-# LANGUAGE TemplateHaskell #-} -- See: https://ghc.haskell.org/trac/ghc/ticket/14959. TODO: Consider putting -- the offending function (bitsToInteger') in a separate module. {-# OPTIONS_GHC -O0 #-}@@ -201,7 +194,7 @@   bitSizeInstances <- reifyInstances ''BitSize [typ]   case bitSizeInstances of     [] ->-      error $ unwords [+      fail $ unwords [           "Could not find custom bit representation nor BitSize instance"         , "for", show typ ++ "." ] #if MIN_VERSION_template_haskell(2,15,0)@@ -213,7 +206,7 @@     [_impl] ->       [| fromIntegral $ natVal (Proxy :: Proxy (BitSize $(return typ))) |]     unexp ->-      error $ "Unexpected result from reifyInstances: " ++ show unexp+      fail $ "Unexpected result from reifyInstances: " ++ show unexp  -- | Generate bitmask from a given bit, with a certain size bitmask@@ -394,7 +387,7 @@           ($dataSize + constrSize)           $(listE constrReprs) |]     _ ->-      error $ "Could not derive dataRepr for: " ++ show info+      fail $ "Could not derive dataRepr for: " ++ show info      where       (ConT tyConstrName, typeArgs) = collectTypeArgs typ@@ -572,16 +565,17 @@ packedMaybeDerivator (DataReprAnn _ size _) typ =   case maybeCon of     ConT nm ->-      if nm == ''Maybe then+      if nm == ''Maybe then do         let err = unwords [ "Could not derive packed maybe for:", show typ                           , ";", "Does its subtype have any space left to store"-                          , "the constructor in?" ] in-        lift =<< (fromMaybe $ error err) <$> (packedMaybe (size - 1) maybeTyp)+                          , "the constructor in?" ]+        packedM <- packedMaybe (size - 1) maybeTyp+        (fromMaybe (fail err) . fmap lift) packedM       else-        error $ unwords [ "You can only pass Maybe types to packedMaybeDerivator,"+        fail $ unwords [ "You can only pass Maybe types to packedMaybeDerivator,"                         , "not", show nm]     unexpected ->-      error $ "packedMaybeDerivator: unexpected constructor: " ++ show unexpected+      fail $ "packedMaybeDerivator: unexpected constructor: " ++ show unexpected   where     (maybeCon, head -> maybeTyp) = collectTypeArgs typ @@ -739,7 +733,7 @@     rest  = group tail'  bitToExpr' :: (Int, Bit) -> Q Exp -- BitVector n-bitToExpr' (0, _) = error $ "Unexpected group length: 0"+bitToExpr' (0, _) = fail $ "Unexpected group length: 0" bitToExpr' (numTyLit' -> n, Util.H) =   [| complement (resize (pack low) :: BitVector $n) |] bitToExpr' (numTyLit' -> n, Util.L) =@@ -748,7 +742,7 @@   [| undefined# :: BitVector $n |]  bitsToExpr :: [Bit] -> Q Exp -- BitVector n-bitsToExpr [] = error $ "Unexpected empty bit list"+bitsToExpr [] = fail $ "Unexpected empty bit list" bitsToExpr bits =   foldl1     (\v1 v2 -> [| $v1 ++# $v2 |])@@ -763,7 +757,7 @@   -> [(Int, Int)]   -> Q Exp select' _vec [] =-  error $ "Unexpected empty list of intervals"+  fail $ "Unexpected empty list of intervals" select' vec ranges =   foldl1 (\v1 v2 -> [| $v1 ++# $v2 |]) $ map (return . select'') ranges     where@@ -793,7 +787,7 @@   -- ^ Select bits   -> Q Exp select _fields (Lit []) =-  error $ "Unexpected empty literal."+  fail $ "Unexpected empty literal." select _fields (Lit lits) = do   let size = length lits   vec <- bitsToExpr lits@@ -894,15 +888,38 @@ -- the generated instance might conflict with existing implementations (for -- example, an instance for /Maybe a/ exists, yielding conflicts for any -- alternative implementations).+--+--+-- Usage:+--+-- @+-- data Color = R | G | B+-- {-# ANN module (DataReprAnn+--                   $(liftQ [t|Color|])+--                   2+--                   [ ConstrRepr 'R 0b11 0b00 []+--                   , ConstrRepr 'G 0b11 0b01 []+--                   , ConstrRepr 'B 0b11 0b10 []+--                   ]) #-}+-- deriveBitPack [t| Color |]+--+-- data MaybeColor = JustColor Color+--                 | NothingColor deriving (Generic,BitPack)+--+-- @+--+-- __NB__: Because of the way template haskell works the order here matters,+-- if you try to derive MaybeColor before deriveBitPack Color it will complain+-- about missing an instance BitSize Color. deriveBitPack :: Q Type -> Q [Dec] deriveBitPack typQ = do   anns <- collectDataReprs   typ  <- typQ -  let ann = case filter (\(DataReprAnn t _ _) -> t == typ) anns of-              [a] -> a-              []  -> error $ "No custom bit annotation found."-              _   -> error $ "Overlapping bit annotations found."+  ann <- case filter (\(DataReprAnn t _ _) -> t == typ) anns of+              [a] -> return a+              []  -> fail "No custom bit annotation found."+              _   -> fail "Overlapping bit annotations found."    packFunc   <- buildPack ann   unpackFunc <- buildUnpack ann@@ -923,6 +940,6 @@                ]   alreadyIsInstance <- isInstance ''BitPack [typ]   if alreadyIsInstance then-    error $ show typ ++ " already has a BitPack instance."+    fail $ show typ ++ " already has a BitPack instance."   else     return bpInst

@@ -4,18 +4,18 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RankNTypes         #-}-{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}  module Clash.Annotations.BitRepresentation.Internal   ( buildCustomReprs   , dataReprAnnToDataRepr'   , constrReprToConstrRepr'   , getConstrRepr+  , uncheckedGetConstrRepr   , getDataRepr   , thTypeToType'   , ConstrRepr'(..)@@ -27,12 +27,17 @@ import           Clash.Annotations.BitRepresentation   (BitMask, Value, Size, FieldAnn, DataReprAnn(..), ConstrRepr(..)) import           Control.DeepSeq                          (NFData)+import           Data.Coerce                              (coerce) import           Data.Hashable                            (Hashable) import qualified Data.Map                                 as Map+import           Data.Maybe                               (fromMaybe) import qualified Data.Text                                as Text import           Data.Typeable                            (Typeable) import qualified Language.Haskell.TH.Syntax               as TH import           GHC.Generics                             (Generic)+import           GHC.Stack                                (HasCallStack)+import qualified TextShow                                 as TS+import qualified TextShow.Generic                         as TS   -- | Simple version of template haskell type. Used internally to match on.@@ -45,31 +50,40 @@   -- ^ Numeral literal (used in BitVector 10, for example)     deriving (Generic, NFData, Eq, Typeable, Hashable, Ord, Show) +-- Replace with+--+--   deriving TS.TextShow via TS.FromGeneric (Type')+--+-- after dropping support for GHC 8.4+instance TS.TextShow Type' where+  showt = TS.showt . coerce @_ @(TS.FromGeneric (Type'))+  showb = TS.showb . coerce @_ @(TS.FromGeneric (Type'))+ -- | Internal version of DataRepr-data DataRepr' =-  DataRepr'-    -- Qualified name of type (recursive):-    Type'-    -- Size of data type:-    Size-    -- Constructors:-    [ConstrRepr']-      deriving (Show, Generic, NFData, Eq, Typeable, Hashable, Ord)+data DataRepr' = DataRepr'+  { drType :: Type'+  -- ^ Simple representation of data type+  , drSize :: Size+  -- ^ Size of data type+  , drConstrs :: [ConstrRepr']+  -- ^ Constructors+  }+  deriving (Show, Generic, NFData, Eq, Typeable, Hashable, Ord)  -- | Internal version of ConstrRepr-data ConstrRepr' =-  ConstrRepr'-    -- Qualified name of constructor:-    Text.Text-    -- Syntactical position in the custom representations definition:-    Int-    -- Mask needed to determine constructor:-    BitMask-    -- Value after applying mask:-    Value-    -- Indicates where fields are stored:-    [FieldAnn]-      deriving (Show, Generic, NFData, Eq, Typeable, Ord, Hashable)+data ConstrRepr' = ConstrRepr'+  { crName :: Text.Text+  -- ^ Qualified name of constructor+  , crPosition :: Int+  -- ^ Syntactical position in the custom representations definition+  , crMask :: BitMask+  -- ^ Mask needed to determine constructor+  , crValue :: Value+  -- ^ Value after applying mask+  , crFieldAnns :: [FieldAnn]+  -- ^ Indicates where fields are stored+  }+  deriving (Show, Generic, NFData, Eq, Typeable, Ord, Hashable)  constrReprToConstrRepr' :: Int -> ConstrRepr -> ConstrRepr' constrReprToConstrRepr' n (ConstrRepr name mask value fieldanns) =@@ -107,12 +121,23 @@ getConstrRepr :: Text.Text -> CustomReprs -> Maybe ConstrRepr' getConstrRepr name (_, reprs) = Map.lookup name reprs +-- | Unchecked version of getConstrRepr+uncheckedGetConstrRepr+  :: HasCallStack+  => Text.Text+  -> CustomReprs+  -> ConstrRepr'+uncheckedGetConstrRepr name (_, reprs) =+  fromMaybe+    (error ("Could not find custom representation for" ++ Text.unpack name))+    (Map.lookup name reprs)+ -- | Add CustomRepr to existing index-buildCustomRepr :: CustomReprs -> DataRepr' -> CustomReprs-buildCustomRepr (dMap, cMap) d@(DataRepr' name _size constrReprs) =+addCustomRepr :: CustomReprs -> DataRepr' -> CustomReprs+addCustomRepr (dMap, cMap) d@(DataRepr' name _size constrReprs) =   let insertConstr c@(ConstrRepr' name' _ _ _ _) cMap' = Map.insert name' c cMap' in   (Map.insert name d dMap, foldr insertConstr cMap constrReprs)  -- | Create indices based on names of constructors and data types buildCustomReprs :: [DataRepr'] -> CustomReprs-buildCustomReprs = foldl buildCustomRepr (Map.empty, Map.empty)+buildCustomReprs = foldl addCustomRepr (Map.empty, Map.empty)

@@ -8,12 +8,8 @@ templates. -} -{-# LANGUAGE DeriveAnyClass        #-}-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE DeriveTraversable     #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskellQuotes #-}  {-# LANGUAGE Safe #-}@@ -154,7 +150,7 @@   = SystemVerilog   | Verilog   | VHDL-  deriving (Eq, Show, Read, Data, Generic, NFData, Hashable)+  deriving (Eq, Show, Read, Data, Generic, NFData, Hashable, Enum, Bounded)  -- | The 'Primitive' constructor instructs the clash compiler to look for primitive -- HDL templates in the indicated directory. 'InlinePrimitive' is equivalent but@@ -197,7 +193,7 @@ -- import qualified Paths_myfancyip -- import           System.IO.Unsafe ----- {\-\# ANN module (Primitive VHDL (unsafePerformIO Paths_myfancyip.getDataDir \<\/\> "path" \<\/\> "to")) \#-\}+-- {\-\# ANN module (Primitive [VHDL] (unsafePerformIO Paths_myfancyip.getDataDir \<\/\> "path" \<\/\> "to")) \#-\} -- \#endif -- @ --@@ -218,10 +214,10 @@ -- import           Data.String.Interpolate      (i) -- import           Data.String.Interpolate.Util (unindent) ----- {\-\# ANN example (InlinePrimitive VHDL $ unindent [i|+-- {\-\# ANN example (InlinePrimitive [VHDL] $ unindent [i| --   [ { \"BlackBox\" : --       { "name" : "InlinePrimitive.example"---       , "kind": "Declaration"+--       , "kind": \"Declaration\" --       , "template" : --   "-- begin InlinePrimitive example: --   ~GENSYM[example][0] : block@@ -237,10 +233,10 @@ -- example = fmap succ -- @ data Primitive-  = Primitive HDL FilePath-  -- ^ Description of a primitive for a given 'HDL' in a file at 'FilePath'-  | InlinePrimitive HDL String-  -- ^ Description of a primitive for a given 'HDL' as an inline 'String'+  = Primitive [HDL] FilePath+  -- ^ Description of a primitive for a given 'HDL's in a file at 'FilePath'+  | InlinePrimitive [HDL] String+  -- ^ Description of a primitive for a given 'HDL's as an inline 'String'   deriving (Show, Read, Data, Generic, NFData, Hashable)  -- | Guard primitive functions. This will help Clash generate better error

@@ -9,9 +9,8 @@   (<https://github.com/clash-lang/clash-compiler/issues>). -} {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE PolyKinds     #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+ {-# LANGUAGE Safe #-}  module Clash.Annotations.SynthesisAttributes

@@ -0,0 +1,520 @@+{-|++This module can automatically generate TopEntity definitions from 'Clash.NamedTypes'+annotations. Annotations involving data/type families must be inspected for correctness.+Not all cases can be handled with automatic generation due to the difficulty of type manipulation+in template Haskell. In particular annotations _inside_ the following is unlikely to work:++- Data/type family referencing other data/type families.+- Annotations inside recursive data types+- Clock constraints other than a single HiddenClockResetEnable. (You can still+  use arbitrary explicit clock/reset/enables!)++See "Clash.Tests.TopEntityGeneration" for more examples.++@+import Clash.Annotations.TH++data Named+  = Named+  { name1 :: "named1" ::: BitVector 3+  , name2 :: "named2" ::: BitVector 5+  }++topEntity :: "tup1" ::: Signal System (Int, Bool)+          -> "tup2" ::: (Signal System Int, Signal System Bool)+          -> "tup3" ::: Signal System ("int":::Int, "bool":::Bool)+          -> "tup4" ::: ("int":::Signal System Int, "bool":::Signal System Bool)+          -> "custom" ::: Signal System Named+          -> "outTup" ::: Signal System ("outint":::Int, "outbool":::Bool)+topEntity = undefined+makeTopEntity 'topEntity+-- ===>+--  {-# ANN topEntity Synthesize "topEntity3"+--     [ PortName "tup1"+--     , PortName "tup2"+--     , PortProduct "tup3" [PortName "int",PortName "bool"]+--     , PortProduct "tup4" [PortName "int",PortName "bool"]+--     , PortProduct "custom" [PortName "named1",PortName "named2"]+--     ]+--     (PortProduct "outTup" [PortName "outint",PortName "outbool"])+--     #-}+@++-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+-- Required to 'makeBaseFunctor' of 'Language.Haskell.TH.Syntax.Type'++{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Clash.Annotations.TH+  ( -- * To create a Synthesize annotation pragma+    makeTopEntity+  , makeTopEntityWithName+  , makeTopEntityWithName'+    -- * To create a TopEntity value+  , buildTopEntity+  , maybeBuildTopEntity+  , getNameBinding+  )+where++import           Data.Foldable                  ( fold)+import qualified Data.Set                      as Set+import qualified Data.Map                      as Map+#if !(MIN_VERSION_base(4,11,0))+import           Data.Semigroup                as Semigroup+#endif+import           Language.Haskell.TH++import           Data.Functor.Foldable          ( para )+import           Data.Functor.Foldable.TH+import           Control.Lens                   ( (%~), (&), (.~)+                                                , _1, _2, _3, view+                                                )+import           Control.Monad                  (mfilter, liftM2)+import           Control.Monad.Trans.Reader     (ReaderT(..), asks, local)+import           Control.Monad.Trans.Class      (lift)+import           Language.Haskell.TH.Instances  ( )+import           Language.Haskell.TH.Datatype++import           Clash.Annotations.TopEntity    ( PortName(..)+                                                , TopEntity(..)+                                                )+import           Clash.NamedTypes               ((:::))+import           Clash.Signal                   ( HiddenClockResetEnable+                                                , HiddenClock, HiddenReset, HiddenEnable+                                                , Signal)+import           Clash.Signal.Delayed           (DSignal)++$(makeBaseFunctor ''Type)++-- | A datatype to track failing naming in a subtree.+data Naming a = Complete a | HasFail String | BackTrack (Set.Set Name)+  deriving Functor++instance Semigroup a => Semigroup (Naming a) where+  Complete a <> Complete b     = Complete $ a <> b+  BackTrack n1 <> BackTrack n2 = BackTrack $ n1 <> n2+  BackTrack n <> _             = BackTrack n+  _ <> BackTrack n             = BackTrack n+  HasFail e1 <> HasFail e2     = HasFail $ e1 ++ "\n" ++ e2+  _ <> HasFail e               = HasFail e+  HasFail e <> _               = HasFail e++instance (Semigroup a, Monoid a) => Monoid (Naming a) where+  mempty = Complete mempty+#if !(MIN_VERSION_base(4,11,0))+  mappend = (Semigroup.<>)+#endif++-- | Track seen 'Name's, and track current 'Info' for error reporting.+type ErrorContext = String+type TrackData = (Set.Set Name, ErrorContext)+type Tracked m a = ReaderT TrackData m a++-- * Utility functions++-- | Matches a type `a -> b`+pattern ArrowTy :: Type -> Type -> Type+pattern ArrowTy a b = AppT (AppT ArrowT a) b++-- | Greedily split on top level 'AppT' to recover basic type+-- application as a list of 'Type'.+unapp :: Type -> [Type]+unapp (AppT l r) = unapp l ++ [r]+unapp t = [t]++-- | Greedily split on top level outer arrows, splitting a function 'Type' into+-- it's arguments. (Result type discarded)+unarrow :: Type -> [Type]+unarrow (ArrowTy x y) = x : unarrow y+unarrow _ = []++-- | Collapse a list of 'PortNames' into a single 'PortName'+collapseNames :: [PortName] -> [PortName]+collapseNames [] = []+collapseNames [x] = [x]+collapseNames xs = [PortProduct "" xs]++-- | Failure message with a prefix to add some context for end users.+failMsg :: String -> String+failMsg s = "TopEntity generation error: " ++ s++-- | Retrieve current error context+errorContext :: Tracked Q String+errorContext = asks snd++-- | Failure message with prefix in a 'Tracked' context+failMsgWithContext :: String -> Tracked Q String+failMsgWithContext s = (++) (failMsg s) <$> errorContext++-- | Track a new seen 'Name' and update 'Info' for error handling+visit :: (Show b) => Name -> b -> Tracked m a -> Tracked m a+visit name a = local (\t -> t & _1 %~ Set.insert name+                              & _2 .~ show a)++-- | Grab the 'Name's of type variables in a datatype+datatypeVars' :: DatatypeInfo -> [Name]+#if MIN_VERSION_th_abstraction(0,3,0)+datatypeVars' d = tvName <$> datatypeVars d+#else+datatypeVars' d = name <$> datatypeVars d+ where+  name (VarT n) = n+  name (SigT n _) = name n+  name e = error $ "Unexpected datatype variable name of type " ++ show e+#endif++-- | Run a 'Name' through the template haskell machinery, getting a+-- 'DatatypeInfo' if the 'Name' specified a datatype. The result is processed by+-- a given function or a default 'a' is returned in the style of 'maybe'.+tryReifyDatatype :: a -> (DatatypeInfo -> a) -> Name -> Tracked Q a+tryReifyDatatype a f name = lift (recover (pure a) $ f <$> reifyDatatype name)++-- * Type tree folding / unfolding++-- | Flag constructors with partially named fields as failing.+portsFromTypes+  :: [Type]+  -> Tracked Q (Naming [PortName])+portsFromTypes xs = do+  (mconcat <$> mapM f xs)+  >>= \case+    Complete names | length names > 0 && length names /= length xs ->+      HasFail <$> failMsgWithContext "Partially named constructor arguments!\n"+    x -> return x+ where+  f = fmap (fmap collapseNames) . gatherNames++-- | Flag sum types as failing if they have any constructors with names.+handleNamesInSum+  :: [ConstructorInfo]+  -> Tracked Q (Naming [PortName])+handleNamesInSum xs =+  (fold <$> mapM portsFromTypes (constructorFields <$> xs)) >>= \case+    Complete [] -> return $ Complete []+    x ->+      mappend x . HasFail <$> failMsgWithContext "Annotated sum types not supported!\n"++-- | Build a list of 'PortName's from a Template Haskell 'Con' and a free+-- variable mapping+constructorToPorts :: Con -> Map.Map Name Type -> Tracked Q (Naming [PortName])+constructorToPorts c m = do+  let xs = applySubstitution m (ctys c)+  portsFromTypes xs+ where+  ctys (NormalC _ (fmap snd -> tys)) = tys+  ctys (RecC _ (fmap (view _3) -> tys)) = tys+  ctys (InfixC _ _ (snd -> ty)) = [ty]+  ctys (ForallC _ _ c') = ctys c'+  ctys (GadtC _ (fmap snd -> tys) _) = tys+  ctys (RecGadtC _ (fmap (view _3) -> tys) _) = tys++-- | Build a list of 'PortName's from a Template Haskell 'Name'+datatypeNameToPorts+  :: Name+  -> Tracked Q (Naming [PortName])+datatypeNameToPorts name = do+  constructors <- tryReifyDatatype [] datatypeCons name++  names <- case constructors of+    []  -> return $ Complete []+    [x] -> portsFromTypes (constructorFields x)+    xs  -> handleNamesInSum xs++  case names of+    BackTrack ns | Set.member name ns -> do+      lift $ reportWarning $ "Make sure HDL port names are correct:\n"+                           ++ "Backtracked when constructing " ++ pprint name+                           ++ "\n(Type appears recursive)"+      return $ case (Set.delete name ns) of+        e | e == Set.empty -> Complete []+        xs -> BackTrack xs+    _ -> return names++-- | Recursively walking a 'Type' tree and building a list of 'PortName's.+typeTreeToPorts+  :: TypeF (Type, Tracked Q (Naming [PortName]))+  -- ^ Case under scrutiny, paramorphism style+  -> Tracked Q (Naming [PortName])+typeTreeToPorts (AppTF (AppT (ConT split) (LitT (StrTyLit name)), _) (_,c))+  -- Is there a '<String> ::: <something>' annotation?+  | split == ''(:::)+  -- We found our split. If:+  -- - We only have no names from children: use split name as PortName+  -- - We have children reporting names: use split name as name to PortProduct+  = c >>= \case+    Complete [] -> return $ Complete [PortName name]+    Complete xs -> return $ Complete [PortProduct name xs]+    x           -> return x++typeTreeToPorts (ConTF name) = do+  -- Only attempt to resolve a subtree for names we haven't seen before+  seen <- asks fst+  if Set.member name seen+  then return $ BackTrack $ Set.singleton name+  else visit name name $ do+    info <- lift $ reify name+    case info of+      -- Either `name` is an unannotated primitive+      PrimTyConI _ _ _ -> return $ Complete []+      -- ... or a type synonym+      TyConI (TySynD _ _ t) -> gatherNames t+      -- ... or something "datatype" like+      _ -> datatypeNameToPorts name++typeTreeToPorts f@(AppTF (a,a') (b,b')) = do+  -- Gather types applied to a head type+  case unapp (AppT a b) of+    -- Return the inner type for signals+    (ConT x : _ : _ : []) | x == ''Clash.Signal.Signal -> b'+    (ConT x : _ : _ : _ : []) | x == ''Clash.Signal.Delayed.DSignal -> b'++    -- Other handled type applications are+    -- 1. Type synonyms+    -- 2. Closed type families+    -- 3. Open type and data families+    -- 4. Regular data types+    (ConT x : xs) -> do+      info <- lift $ reify x+      case info of+        -- 1. Type synonym case is just inserting the relevant port tree+        (TyConI (TySynD _ synvars def)) -> do+          gatherNames $ applyContext xs (tvName <$> synvars) def++        -- 2. Match argument lengths, substitute types, and then insert the port+        -- tree+        FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bds _ _) eqs) _+          | length bds == length xs ->+            case filter ((==) xs . applyFamilyBindings xs info . tySynArgs) eqs of+#if MIN_VERSION_template_haskell(2,15,0)+              [TySynEqn _ _ r] ->+#else+              [TySynEqn _ r]   ->+#endif+                gatherNames (applyFamilyBindings xs info r)++              -- We didn't find a (single) matching instance so give up. Is this+              -- impossible?+              _ -> return $ Complete []++        -- 3. Match argument lengths then:+        --   - Substitute port tree for type family+        --   - Try to get a unique constructor for data families and build+        --     port tree from the constructor+        _ | familyArity info == Just (length xs) -> do+          (lift $ reifyInstances x xs) >>= \case+#if MIN_VERSION_template_haskell(2,15,0)+            [TySynInstD (TySynEqn _ _ r)] ->+#else+            [TySynInstD _ (TySynEqn _ r)] ->+#endif+                gatherNames (applyFamilyBindings xs info r)++            [NewtypeInstD _ _ _ _ c _] -> constructorToPorts c (familyTyMap xs info)+            [DataInstD    _ _ _ _ cs _] -> do+              case cs of+                [c] -> constructorToPorts c (familyTyMap xs info)+                _ -> return $ Complete []+            y -> fail $ failMsg "Encountered unexpected type during family application!"+                      ++ pprint y++        -- 4. Check if head really is a datatype, apply free variables,+        --    and attempt to get a unique constructor+        _ -> do+          dataTy <- tryReifyDatatype Nothing Just x++          let -- Apply tail types to head datatype free type variables+              hasAllArgs   = \vs -> length xs == length (datatypeVars vs)+              constructors = applyDatatypeContext xs <$> mfilter hasAllArgs dataTy++              -- Attempt to get a unique constructor+              getSingleConstructor cs = do [c] <- cs; return c+              constructor = getSingleConstructor constructors++          -- If any steps failed, return the PortNames according to the head type.+          maybe a' (visit x (ppr x) . portsFromTypes . constructorFields) constructor++    -- If head is a tuple or list then we take all the names+    (ListT:_)    -> fold <$> mapM snd f+    (TupleT _:_) -> fold <$> mapM snd f++    -- We're not applying to a head 'ConT' so lets try best effort of getting names+    -- from all applied types+    _ -> do+      lift $ reportWarning $ "Make sure HDL port names are correct:\n"+                           ++ "Type application with non ConT head:\n:("+                           ++ pprint (AppT a b)+      f' <- mapM snd f+      return $ fold f'+ where+  tyMap ctx holes = Map.fromList $ zip holes ctx+  familyTyMap ctx (familyBindings -> Just holes) = tyMap ctx (tvName <$> holes)+  familyTyMap _ _  = error "familyTyMap called with non family argument!"+  applyContext ctx holes = applySubstitution (tyMap ctx holes)+  applyDatatypeContext ctx d = applyContext ctx (datatypeVars' d) <$> datatypeCons d+  applyFamilyBindings ctx (familyBindings -> Just holes) t+    = applyContext ctx (tvName <$> holes) t+  applyFamilyBindings _ _ _ = error "familyTyMap called with non family argument!"++#if MIN_VERSION_template_haskell(2,15,0)+  tySynArgs (TySynEqn _ args _) = tail (unapp args)+#else+  tySynArgs (TySynEqn args _) = args+#endif++  familyBindings (FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ xs _ _) _) _) = Just xs+  familyBindings (FamilyI (OpenTypeFamilyD (TypeFamilyHead _ xs _ _)) _) = Just xs+  familyBindings (FamilyI (DataFamilyD _ xs _) _) = Just xs+  familyBindings _ = Nothing+  familyArity = fmap length . familyBindings++typeTreeToPorts f = do+  -- Just collect names+  f' <- mapM snd f+  return $ fold f'++-- | Gather naming tree attached to a 'Type' and its inner 'Type's+gatherNames+  :: Type+  -- ^ Type to investigate+  -> Tracked Q (Naming [PortName])+gatherNames =+  para typeTreeToPorts++-- | Build a possible failing 'PortName' tree and unwrap the 'Naming' result.+buildPorts+  :: Type+  -- ^ Type to investigate+  -> Q [PortName]+buildPorts x = do+  flip runReaderT (Set.empty, "") $ gatherNames x+    >>= \case+      Complete xs -> return xs+      HasFail err -> fail err+      BackTrack n -> fail $ failMsg "Encountered recursive type at entry! " ++ show n++-- | Get the result 'PortName' from a function type+toReturnName :: Type -> Q PortName+toReturnName (ArrowTy _ b) = toReturnName b+toReturnName b             =+  buildPorts b+  >>= \case+     [] -> fail $ failMsg "No return name specified!"+     [x] -> return x+     xs -> return $ PortProduct "" xs++-- | Get the argument 'PortName's from a function type+toArgNames :: Type -> Q [PortName]+toArgNames ty = traverse build (unarrow ty)+ where+  build x = buildPorts x >>= check x+  check x []  = fail $ failMsg "Unnamed argument " ++ pprint x+  check _ [a] = return a+  check _ xs  = return $ PortProduct "" xs++data ClockType = None | SingleClockResetEnable | Other+  deriving Eq++-- | Strip constraints from a type.+--+-- Fail if:+-- - There are free type variables.+-- - There are multiple hidden clocks+handleConstraints :: Type -> ClockType -> Q (Type, ClockType)+handleConstraints (ForallT [] [] x) clk = handleConstraints x clk+handleConstraints (ForallT xs@(_:_) _ _) _ =+  fail $ failMsg "Free type variables!\n"+       ++ pprint xs+handleConstraints (ForallT _ c x) clk = handleConstraints x hiddenClocks+ where+  hiddenClocks = foldl findHiddenClocks clk c+  findHiddenClocks a (AppT (ConT b) _)+    | b == ''Clash.Signal.HiddenClockResetEnable && a == None+      = SingleClockResetEnable+    | b == ''Clash.Signal.HiddenClockResetEnable && a /= None+      = Other+    | b == ''Clash.Signal.HiddenClock+      || b == ''Clash.Signal.HiddenReset+      || b == ''Clash.Signal.HiddenEnable+      = Other+  findHiddenClocks a _ = a+handleConstraints x clk = return (x, clk)++clockToPorts :: ClockType -> Q [PortName]+clockToPorts None = return []+clockToPorts (SingleClockResetEnable) =+  return [PortProduct "" [ PortName "clk" , PortName "rst" , PortName "en" ]]+clockToPorts Other =+  fail $ failMsg "TH generation for multiple hidden clocks and"+       ++ " HiddenClock/HiddenReset/HiddenEnable currently unsupported!"++-- *++-- | Return a typed expression for a 'TopEntity' of a given @('Name', 'Type')@.+buildTopEntity :: Maybe String -> (Name, Type) -> TExpQ TopEntity+buildTopEntity topName (name, ty) = do+    (ty', clock) <- handleConstraints ty None++    ins   <- liftM2 (<>) (clockToPorts clock) (toArgNames ty')+    out   <- toReturnName ty'++    let outName = case topName of+          Just name' -> name'          -- user specified name+          Nothing    -> nameBase name  -- auto-generated from Haskell name++    [|| Synthesize+        { t_name   = outName+        , t_inputs = ins+        , t_output = out+        } ||]++-- | Return a typed 'Maybe TopEntity' expression given a 'Name'.+-- This will return an 'TExp' of 'Nothing' if 'TopEntity' generation failed.+maybeBuildTopEntity :: Maybe String -> Name -> Q (TExp (Maybe TopEntity))+maybeBuildTopEntity topName name = do+  recover ([|| Nothing ||]) $ do+    let expr = getNameBinding name >>= buildTopEntity topName+    [|| Just ($$expr) ||]++-- | Turn the 'Name' of a value to a @('Name', 'Type')@+getNameBinding :: Name -> Q (Name, Type)+getNameBinding n = reify n >>= \case+  VarI name ty _ -> return (name, ty)+  _ -> fail "getNameBinding: Invalid Name, must be a top-level binding!"++-- | Wrap a 'TopEntity' expression in an annotation pragma+makeTopEntityWithName' :: Name -> Maybe String -> DecQ+makeTopEntityWithName' n topName = do+  (name,ty) <- getNameBinding n+  topEntity <- buildTopEntity topName (name,ty)+  let prag t = PragmaD (AnnP (valueAnnotation name) t)+  return $ prag $ unType topEntity++-- | Automatically create a @'TopEntity'@ for a given @'Name'@, using the given+-- @'String'@ to specify the name of the generated RTL entity.+--+-- The function arguments and return values of the function specified by the+-- given @'Name'@ must be annotated with @'(:::)'@. This annotation provides the+-- given name of the port.+makeTopEntityWithName :: Name -> String -> DecsQ+makeTopEntityWithName nam top = pure <$> makeTopEntityWithName' nam (Just top)++-- | Automatically create a @'TopEntity'@ for a given @'Name'@. The name of the+-- generated RTL entity will be the name of the function that has been+-- specified; e.g. @'makeTopEntity' 'foobar@ will generate a @foobar@ module.+--+-- The function arguments and return values of the function specified by the+-- given @'Name'@ must be annotated with @'(:::)'@. This annotation provides the+-- given name of the port.+makeTopEntity :: Name -> DecsQ+makeTopEntity nam = pure <$> makeTopEntityWithName' nam Nothing

@@ -197,10 +197,6 @@  -} -{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveLift         #-}- {-# LANGUAGE TemplateHaskellQuotes #-}  {-# LANGUAGE Safe #-}@@ -253,7 +249,7 @@   -- g = ...   -- @   | TestBench TH.Name-  deriving (Data,Show,Generic)+  deriving (Eq,Data,Show,Generic)  instance Lift TopEntity where   lift (Synthesize name inputs output) =@@ -355,7 +351,7 @@   -- 2. The prefix for any unnamed ports below the 'PortProduct'   --   -- You can use an empty String ,\"\" , in case you want an auto-generated name.-  deriving (Data,Show,Generic,Lift)+  deriving (Eq,Data,Show,Generic,Lift)  -- | Default 'Synthesize' annotation which has no specified names for the input -- and output ports.

@@ -4,16 +4,43 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP#-}+{-# LANGUAGE CPP #-}+ {-# OPTIONS_HADDOCK hide #-}  #ifndef MAX_TUPLE_SIZE+#ifdef LARGE_TUPLES #define MAX_TUPLE_SIZE 62+#else+#define MAX_TUPLE_SIZE 12 #endif+#endif  module Clash.CPP  ( maxTupleSize++ -- ** Cabal flags+ , fSuperStrict+ , fStrictMapSignal  ) where  maxTupleSize :: Num a => a maxTupleSize = MAX_TUPLE_SIZE++-- | Whether clash-prelude was compiled with -fsuper-strict+fSuperStrict :: Bool+#ifdef CLASH_SUPER_STRICT+fSuperStrict = True+#else+fSuperStrict = False+#endif+{-# INLINE fSuperStrict #-}++-- | Whether clash-prelude was compiled with -fstrict-mapSignal+fStrictMapSignal :: Bool+#ifdef CLASH_STRICT_MAPSIGNAL+fStrictMapSignal = True+#else+fStrictMapSignal = False+#endif+{-# INLINE fStrictMapSignal #-}

@@ -0,0 +1,13 @@+{-|+  Copyright   :  (C) 2019, Google Inc.+  License     :  BSD2 (see the file LICENSE)+  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>+-}++module Clash.Class.AutoReg+  ( AutoReg (autoReg)+  , deriveAutoReg+  ) where++import Clash.Class.AutoReg.Internal+import Clash.Class.AutoReg.Instances ()

@@ -0,0 +1,30 @@+{-|+  Copyright   :  (C) 2019, Google Inc.+  License     :  BSD2 (see the file LICENSE)+  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Clash.Class.AutoReg.Instances where++import           Clash.Class.AutoReg.Internal+import           Clash.CPP                           (maxTupleSize)++#if MIN_VERSION_base(4,12,0)+import           Data.Complex (Complex)+import           Data.Ord (Down)+#endif++import           Data.Ratio (Ratio)++#if MIN_VERSION_base(4,12,0)+deriveAutoReg ''Complex+deriveAutoReg ''Down+#endif++deriveAutoReg ''Ratio++deriveAutoRegTuples [2..maxTupleSize]

@@ -0,0 +1,466 @@+{-|+  Copyright   :  (C) 2019, Google Inc.+  License     :  BSD2 (see the file LICENSE)+  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- needed for constraint on the Fixed instance+#if __GLASGOW_HASKELL__ < 806+{-# OPTIONS_GHC -Wwarn=unused-pattern-binds #-}+#endif++module Clash.Class.AutoReg.Internal+  ( AutoReg (..)+  , deriveAutoReg+  , deriveAutoRegTuples+  )+  where++import           Data.List                    (nub,zipWith4)+import           Data.Maybe                   (fromMaybe,isJust)++import           GHC.Stack                    (HasCallStack)+import           GHC.TypeNats                 (KnownNat,Nat,type (+))+import           Clash.Explicit.Signal+import           Clash.Promoted.Nat+import           Clash.Magic+import           Clash.XException             (NFDataX, deepErrorX)++import           Clash.Sized.BitVector+import           Clash.Sized.Fixed+import           Clash.Sized.Index+import           Clash.Sized.RTree+import           Clash.Sized.Signed+import           Clash.Sized.Unsigned+import           Clash.Sized.Vector           (Vec, lazyV, smap)++import           Data.Int+import           Data.Word+import           Foreign.C.Types              (CUShort)+import           Numeric.Half                 (Half)++import           Language.Haskell.TH.Datatype+import           Language.Haskell.TH.Syntax+import           Language.Haskell.TH.Lib+import           Language.Haskell.TH.Ppr++import           Control.Lens.Internal.TH     (bndrName, conAppsT)++-- $setup+-- >>> import Data.Maybe+-- >>> import Clash.Class.BitPack (pack)+-- >>> :set -fplugin GHC.TypeLits.Normalise+-- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver++-- | 'autoReg' is a "smart" version of 'register'. It does two things:+--+--   1. It splits product types over their fields. For example, given a 3-tuple,+--   the corresponding HDL will end up with three instances of a register (or+--   more if the three fields can be split up similarly).+--+--   2. Given a data type where a constructor indicates (parts) of the data will+--   (not) be updated a given cycle, it will split the data in two parts. The+--   first part will contain the "always interesting" parts (the constructor+--   bits). The second holds the "potentially uninteresting" data (the rest).+--   Both parts will be stored in separate registers. The register holding the+--   "potentially uninteresting" part will only be enabled if the constructor+--   bits indicate they're interesting.+--+--   The most important example of this is "Maybe". Consider "Maybe Byte)";+--   when viewed as bits, a 'Nothing' would look like:+--+--     >>> pack @(Maybe (Signed 16)) Nothing+--     0_...._...._...._....+--+--   and 'Just'+--+--     >>> pack @(Maybe (Signed 16)) (Just 3)+--     1_0000_0000_0000_0011+--+--   In the first case, Nothing, we don't particularly care about updating the+--   register holding the "Signed 16" field, as they'll be unknown anyway. We+--   can therefore deassert its enable line.+--+-- Making Clash lay it out like this increases the chances of synthesis tools+-- clock gating the registers, saving energy.+--+-- This version of 'autoReg' will split the given data type up recursively. For+-- example, given "a :: Maybe (Maybe Int, Maybe Int)", a total of five registers+-- will be rendered. Both the "interesting" and "uninteresting" enable lines of+-- the inner Maybe types will be controlled by the outer one, in addition to+-- the inner parts controlling their "uninteresting" parts as described in (2).+--+-- The default implementation is just 'register'. If you don't need or want+-- the special features of "AutoReg", you can use that by writing an empty instance.+--+-- > data MyDataType = ...+-- > instance AutoReg MyDataType+--+-- If you have a product type you can use 'deriveAutoReg' to derive an instance.+--+-- "Clash.Prelude" exports an implicit version of this: 'Clash.Prelude.autoReg'+class NFDataX a => AutoReg a where+  autoReg+    :: (HasCallStack, KnownDomain dom)+    => Clock dom -> Reset dom -> Enable dom+    -> a  -- ^ Reset value+    -> Signal dom a+    -> Signal dom a+  autoReg = register++instance AutoReg ()+instance AutoReg Bool++instance AutoReg Double+instance AutoReg Float+instance AutoReg CUShort+instance AutoReg Half++instance AutoReg Char++instance AutoReg Integer+instance AutoReg Int+instance AutoReg Int8+instance AutoReg Int16+instance AutoReg Int32+instance AutoReg Int64+instance AutoReg Word+instance AutoReg Word8+instance AutoReg Word16+instance AutoReg Word32+instance AutoReg Word64++instance AutoReg Bit+instance AutoReg (BitVector n)+instance AutoReg (Signed n)+instance AutoReg (Unsigned n)+instance AutoReg (Index n)+instance NFDataX (rep (int + frac)) => AutoReg (Fixed rep int frac)++instance AutoReg a => AutoReg (Maybe a) where+  autoReg clk rst en initVal input =+    createMaybe <$> tagR <*> valR+   where+     tag = isJust <$> input+     tagInit = isJust initVal+     tagR = register clk rst en tagInit tag++     val = fromMaybe (deepErrorX "autoReg'.val") <$> input+     valInit = fromMaybe (deepErrorX "autoReg'.valInit") initVal++     valR = autoReg clk rst (enable en tag) valInit val++     createMaybe t v = case t of+       True -> Just v+       False -> Nothing++instance (KnownNat n, AutoReg a) => AutoReg (Vec n a) where+  autoReg+    :: forall dom. (HasCallStack, KnownDomain dom)+    => Clock dom -> Reset dom -> Enable dom+    -> Vec n a -- ^ Reset value+    -> Signal dom (Vec n a)+    -> Signal dom (Vec n a)+  autoReg clk rst en initVal xs =+    bundle $ smap go (lazyV initVal) <*> unbundle xs+   where+    go :: forall (i :: Nat). SNat i -> a  -> Signal dom a -> Signal dom a+    go SNat = suffixNameFromNatP @i . autoReg clk rst en++instance (KnownNat d, AutoReg a) => AutoReg (RTree d a) where+  autoReg clk rst en initVal xs =+    bundle $ (autoReg clk rst en) <$> lazyT initVal <*> unbundle xs+++-- | Decompose an applied type into its individual components. For example, this:+--+-- @+-- Either Int Char+-- @+--+-- would be unfolded to this:+--+-- @+-- ('ConT' ''Either, ['ConT' ''Int, 'ConT' ''Char])+-- @+--+-- This function ignores explicit parentheses and visible kind applications.+--+-- NOTE: Copied from "Control.Lens.Internal.TH".+-- TODO: Remove this function. Can be removed once we can upgrade to lens 4.18.+-- TODO: This is currently difficult due to issue with nix.+unfoldType :: Type -> (Type, [Type])+unfoldType = go []+  where+    go :: [Type] -> Type -> (Type, [Type])+    go acc (ForallT _ _ ty) = go acc ty+    go acc (AppT ty1 ty2)   = go (ty2:acc) ty1+    go acc (SigT ty _)      = go acc ty+#if MIN_VERSION_template_haskell(2,11,0)+    go acc (ParensT ty)     = go acc ty+#endif+#if MIN_VERSION_template_haskell(2,15,0)+    go acc (AppKindT ty _)  = go acc ty+#endif+    go acc ty               = (ty, acc)++-- | Automatically derives an 'AutoReg' instance for a product type+--+-- Usage:+--+-- > data Pair a b = MkPair { getA :: a, getB :: b } deriving (Generic, NFDataX)+-- > data Tup3 a b c = MkTup3 { getAB :: Pair a b, getC :: c } deriving (Generic, NFDataX)+-- > deriveAutoReg ''Pair+-- > deriveAutoReg ''Tup3+--+-- __NB__: Because of the way template haskell works the order here matters,+-- if you try to @deriveAutoReg ''Tup3@ before @Pair@ it will complain+-- about missing an @instance AutoReg (Pair a b)@.+deriveAutoReg :: Name -> DecsQ+deriveAutoReg tyNm = do+  tyInfo <- reifyDatatype tyNm+  case datatypeCons tyInfo of+    [] -> fail "Can't deriveAutoReg for empty types"+    [conInfo] -> deriveAutoRegProduct tyInfo conInfo+    _ -> fail "Can't deriveAutoReg for sum types"++++{-+For a type like:+   data Product a b .. = MkProduct { getA :: a, getB :: b, .. }+This generates the following instance:++instance (AutoReg a, AutoReg b, ..) => AutoReg (Product a b ..) where+  autoReg clk rst en initVal input =+    MkProduct <$> sig0 <*> sig1 ...+    where+      field0 = (\(MkProduct x _ ...) -> x) <$> input+      field1 = (\(MkProduct _ x ...) -> x) <$> input+      ...+      MkProduct initVal0 initVal1 ... = initVal+      sig0 = suffixNameP @"getA" autoReg clk rst en initVal0 field0+      sig1 = suffixNameP @"getB" autoReg clk rst en initVal1 field1+      ...+-}+deriveAutoRegProduct :: DatatypeInfo -> ConstructorInfo -> DecsQ+deriveAutoRegProduct tyInfo conInfo = go (constructorName conInfo) fieldInfos+ where+  tyNm = datatypeName tyInfo+  tyVarBndrs = datatypeVars tyInfo++#if MIN_VERSION_th_abstraction(0,3,0)+  toTyVar = VarT . bndrName+#else+  toTyVar t = case t of+    VarT _ -> t+    SigT t' _ -> toTyVar t'+    _ -> error "deriveAutoRegProduct.toTv"+#endif++  tyVars = map toTyVar tyVarBndrs+  ty = conAppsT tyNm tyVars++  fieldInfos =+    zip fieldNames (constructorFields conInfo)+   where+    fieldNames =+      case constructorVariant conInfo of+        RecordConstructor nms -> map Just nms+        _ -> repeat Nothing++  go :: Name -> [(Maybe Name,Type)] -> Q [Dec]+  go dcNm fields = do+    args <- mapM newName ["clk", "rst", "en", "initVal", "input"]+    let+      [clkE, rstE, enE, initValE, inputE] = map varE args+      argsP = map varP args+      fieldNames = map fst fields++      field :: Name -> Int -> DecQ+      field nm nr =+        valD (varP nm) (normalB [| $fieldSel <$> $inputE |]) []+       where+        fieldSel = do+          xNm <- newName "x"+          let fieldP = [ if nr == n then varP xNm else wildP+                       | (n,_) <- zip [0..] fields]+          lamE [conP dcNm fieldP] (varE xNm)   -- "\(Dc _ _ .. x _ ..) -> x"++    parts <- generateNames "field" fields+    fieldDecls <- sequence $ zipWith field parts [0..]+    sigs <- generateNames "sig" fields+    initVals <- generateNames "initVal" fields+    let initPat = conP dcNm (map varP initVals)+    initDecl <- valD initPat (normalB initValE) []++    let+      genAutoRegDecl :: PatQ -> ExpQ -> ExpQ -> Maybe Name -> DecsQ+      genAutoRegDecl s v i nameM =+        [d| $s = $nameMe autoReg $clkE $rstE $enE $i $v |]+       where+        nameMe = case nameM of+          Nothing -> [| id |]+          Just nm -> let nmSym = litT $ strTyLit (nameBase nm)+                     in [| suffixNameP @($nmSym) |]++    partDecls <- concat <$> (sequence $ zipWith4 genAutoRegDecl+                                                 (varP <$> sigs)+                                                 (varE <$> parts)+                                                 (varE <$> initVals)+                                                 (fieldNames)+                            )+    let+        decls :: [DecQ]+        decls = map pure (initDecl : fieldDecls ++ partDecls)+        tyConE = conE dcNm+        body =+          case map varE sigs of+            (sig0:rest) -> foldl+                             (\acc sigN -> [| $acc <*> $sigN |])+                             [| $tyConE <$> $sig0 |]+                             rest+            [] -> [| $tyConE |]++    autoRegDec <- funD 'autoReg [clause argsP (normalB body) decls]+    ctx <- calculateRequiredContext conInfo+    return [InstanceD Nothing ctx (AppT (ConT ''AutoReg) ty) [autoRegDec]]++-- Calculate the required constraint to call autoReg on all the fields of a+-- given constructor+calculateRequiredContext :: ConstructorInfo -> Q Cxt+calculateRequiredContext conInfo = do+  let fieldTys = constructorFields conInfo+  wantedInstances <- mapM (\ty -> constraintsWantedFor ''AutoReg [ty]) (nub fieldTys)+  return $ nub (concat wantedInstances)++constraintsWantedFor :: Name -> [Type] -> Q Cxt+constraintsWantedFor clsNm tys+  | show clsNm == "GHC.TypeNats.KnownNat" = do+  -- KnownNat is special, you can't just lookup instances with reifyInstances.+  -- So we just pass KnownNat constraints.+  -- This will most likely require UndecidableInstances.+    return [conAppsT clsNm tys]++constraintsWantedFor clsNm [ty] = case ty of+  VarT _ -> return [AppT (ConT clsNm) ty]+  ConT _ -> return []+  _ -> do+    insts <- reifyInstances clsNm [ty]+    case insts of+      [InstanceD _ cxtInst (AppT autoRegCls instTy) _]+        | autoRegCls == ConT clsNm -> do+          let substs = findTyVarSubsts instTy ty+              cxt2 = map (applyTyVarSubsts substs) cxtInst+              okCxt = filter isOk cxt2+              recurseCxt = filter needRecurse cxt2+          recursed <- mapM recurse recurseCxt+          return (okCxt ++ concat recursed)+      []      -> fail $ "Missing instance " ++ show clsNm ++ " (" ++ pprint ty ++ ")"+      (_:_:_) -> fail $ "There are multiple " ++ show clsNm ++ " instances for "+                     ++ pprint ty ++ ":\n" ++ pprint insts+      _ -> fail $ "Got unexpected instance: " ++ pprint insts+ where+  isOk :: Type -> Bool+  isOk (unfoldType -> (_cls,tys)) =+    case tys of+      [VarT _] -> True+      [_] -> False+      _ -> True -- see [NOTE: MultiParamTypeClasses]+  needRecurse :: Type -> Bool+  needRecurse (unfoldType -> (cls,tys)) =+    case tys of+      [VarT _] -> False+      [ConT _] -> False  -- we can just drop constraints like: "AutoReg Bool => ..."+      [AppT _ _] -> True+      [_] -> error ( "Error while deriveAutoReg: don't know how to handle: "+                  ++ pprint cls ++ " (" ++ pprint tys ++ ")" )+      _ -> False  -- see [NOTE: MultiParamTypeClasses]++  recurse :: Type -> Q Cxt+  recurse (unfoldType -> (ConT cls,tys)) = constraintsWantedFor cls tys+  recurse t =+    fail ("Expected a class applied to some arguments but got " ++ pprint t)++constraintsWantedFor clsNm tys =+  return [conAppsT clsNm tys] -- see [NOTE: MultiParamTypeClasses]++-- [NOTE: MultiParamTypeClasses]+-- The constraint calculation code doesn't handle MultiParamTypeClasses+-- "properly", but it will try to pass them on, so the resulting instance should+-- still compile with UndecidableInstances enabled.+++-- | Find tyVar substitutions between a general type and a second possibly less+-- general type. For example:+--+-- @+-- findTyVarSubsts "Either a b" "Either c [Bool]"+--   == "[(a,c), (b,[Bool])]"+-- @+findTyVarSubsts :: Type -> Type -> [(Name,Type)]+findTyVarSubsts = go+ where+  go ty1 ty2 = case (ty1,ty2) of+    (VarT nm1       , VarT nm2) | nm1 == nm2 -> []+    (VarT nm        , t)                     -> [(nm,t)]+    (ConT _         , ConT _)                -> []+    (AppT x1 y1     , AppT x2 y2)            -> go x1 x2 ++ go y1 y2+    (SigT t1 k1     , SigT t2 k2)            -> go t1 t2 ++ go k1 k2+    (InfixT x1 _ y1 , InfixT x2 _ y2)        -> go x1 x2 ++ go y1 y2+    (UInfixT x1 _ y1, UInfixT x2 _ y2)       -> go x1 x2 ++ go y1 y2+    (ParensT x1     , ParensT x2)            -> go x1 x2++#if __GLASGOW_HASKELL__ >= 808+    (AppKindT t1 k1     , AppKindT t2 k2)      -> go t1 t2 ++ go k1 k2+    (ImplicitParamT _ x1, ImplicitParamT _ x2) -> go x1 x2+#endif++    (PromotedT _          , PromotedT _          ) -> []+    (TupleT _             , TupleT _             ) -> []+    (UnboxedTupleT _      , UnboxedTupleT _      ) -> []+    (UnboxedSumT _        , UnboxedSumT _        ) -> []+    (ArrowT               , ArrowT               ) -> []+    (EqualityT            , EqualityT            ) -> []+    (ListT                , ListT                ) -> []+    (PromotedTupleT _     , PromotedTupleT _     ) -> []+    (PromotedNilT         , PromotedNilT         ) -> []+    (PromotedConsT        , PromotedConsT        ) -> []+    (StarT                , StarT                ) -> []+    (ConstraintT          , ConstraintT          ) -> []+    (LitT _               , LitT _               ) -> []+    (WildCardT            , WildCardT            ) -> []+    _ -> error $ unlines [ "findTyVarSubsts: Unexpected types"+                         , "ty1:", pprint ty1,"ty2:", pprint ty2]++applyTyVarSubsts :: [(Name,Type)] -> Type -> Type+applyTyVarSubsts substs ty = go ty+  where+    go ty' = case ty' of+      VarT n -> case lookup n substs of+                  Nothing -> ty'+                  Just m  -> m+      ConT _ -> ty'+      AppT ty1 ty2 -> AppT (go ty1) (go ty2)+      _ -> error $ "TODO applyTyVarSubsts: " ++ show ty'+++-- | Generate a list of fresh Name's:+-- prefix0_.., prefix1_.., prefix2_.., ..+generateNames :: String -> [a] -> Q [Name]+generateNames prefix xs =+  sequence (zipWith (\n _ -> newName $ prefix ++ show @Int n) [0..] xs)++deriveAutoRegTuples :: [Int] -> DecsQ+deriveAutoRegTuples xs = concat <$> mapM deriveAutoRegTuple xs++deriveAutoRegTuple :: Int -> DecsQ+deriveAutoRegTuple n+  | n < 2 = fail $ "deriveAutoRegTuple doesn't work for " ++ show n ++ "-tuples"+  | otherwise = deriveAutoReg tupN+  where+    tupN = mkName $ "(" ++ replicate (n-1) ',' ++ ")"

@@ -5,18 +5,11 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE DefaultSignatures    #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE MagicHash            #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TemplateHaskell      #-}-{-# LANGUAGE TypeApplications     #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns         #-}  {-# LANGUAGE Trustworthy #-} @@ -30,6 +23,7 @@ module Clash.Class.BitPack   ( BitPack (..)   , bitCoerce+  , bitCoerceMap   , boolToBV   , boolToBit   , bitToBool@@ -70,7 +64,7 @@ -}  -- | Convert to and from a 'BitVector'-class BitPack a where+class KnownNat (BitSize a) => BitPack a where   -- | Number of 'Clash.Sized.BitVector.Bit's needed to represents elements   -- of type @a@   --@@ -149,11 +143,27 @@ -- 59 -- >>> pack (59 :: Unsigned 6) -- 11_1011-bitCoerce :: (BitPack a, BitPack b, BitSize a ~ BitSize b)-          => a-          -> b+bitCoerce+  :: (BitPack a, BitPack b, BitSize a ~ BitSize b)+  => a+  -> b bitCoerce = unpack . pack +-- | Map a value by first coercing to another type through its bit representation.+--+-- >>> pack (-5 :: Signed 32)+-- 1111_1111_1111_1111_1111_1111_1111_1011+-- >>> bitCoerceMap @(Vec 4 (BitVector 8)) (replace 1 0) (-5 :: Signed 32)+-- -16711685+-- >>> pack (-16711685 :: Signed 32)+-- 1111_1111_0000_0000_1111_1111_1111_1011+bitCoerceMap+  :: forall a b . (BitPack a, BitPack b, BitSize a ~ BitSize b)+  => (a -> a)+  -> b+  -> b+bitCoerceMap f = bitCoerce . f . bitCoerce+ instance BitPack Bool where   type BitSize Bool = 1   pack   = let go b = if b then 1 else 0 in packXWith go@@ -189,12 +199,10 @@   pack   = packXWith fromIntegral   unpack = checkUnpackUndef fromIntegral -#if WORD_SIZE_IN_BITS >= 64 instance BitPack Int64 where   type BitSize Int64 = 64   pack   = packXWith fromIntegral   unpack = checkUnpackUndef fromIntegral-#endif  instance BitPack Word where   type BitSize Word = WORD_SIZE_IN_BITS@@ -216,12 +224,10 @@   pack   = packXWith fromIntegral   unpack = checkUnpackUndef fromIntegral -#if WORD_SIZE_IN_BITS >= 64 instance BitPack Word64 where   type BitSize Word64 = 64   pack   = packXWith fromIntegral   unpack = checkUnpackUndef fromIntegral-#endif  instance BitPack Float where   type BitSize Float = 32@@ -264,7 +270,7 @@   pack   _ = minBound   unpack _ = () -instance (KnownNat (BitSize a), KnownNat (BitSize b), BitPack a, BitPack b) =>+instance (BitPack a, BitPack b) =>     BitPack (a,b) where   type BitSize (a,b) = BitSize a + BitSize b   pack = let go (a,b) = pack a ++# pack b in packXWith go@@ -371,23 +377,14 @@  -- Instances derived using Generic instance ( BitPack a-         , KnownNat (BitSize a)          , BitPack b-         , KnownNat (BitSize b)          ) => BitPack (Either a b) -instance ( BitPack a-         , KnownNat (BitSize a)-         ) => BitPack (Maybe a)+instance BitPack a => BitPack (Maybe a)  #if MIN_VERSION_base(4,12,0)-instance ( BitPack a-         , KnownNat (BitSize a)-         ) => BitPack (Complex a)--instance ( BitPack a-         , KnownNat (BitSize a)-         ) => BitPack (Down a)+instance BitPack a => BitPack (Complex a)+instance BitPack a => BitPack (Down a) #endif  -- | Zero-extend a 'Bool'ean value to a 'BitVector' of the appropriate size.

@@ -3,7 +3,7 @@ License    :  BSD2 (see the file LICENSE) Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -}-{-# LANGUAGE CPP             #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}  module Clash.Class.BitPack.Internal (deriveBitPackTuples) where

@@ -4,15 +4,8 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP           #-}-{-# LANGUAGE DataKinds     #-}-{-# LANGUAGE MagicHash     #-}-{-# LANGUAGE TypeFamilies  #-}-{-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE NoStarIsType  #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}  {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} 

@@ -1,6 +1,11 @@ module Clash.Class.HasDomain   ( WithSpecificDomain   , WithSingleDomain++  , HasDomain+  , TryDomain+  , TryDomainResult(..)+  , DomEq   ) where  -- Compilation is split across modules to maximize GHC parallelism

@@ -4,8 +4,6 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE ViewPatterns #-}- module Clash.Class.HasDomain.CodeGen   ( mkTryDomainTuples   , mkHasDomainTuples

@@ -4,10 +4,8 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds          #-}-{-# LANGUAGE PolyKinds          #-}-{-# LANGUAGE TypeFamilies       #-}-{-# LANGUAGE TypeOperators      #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}  module Clash.Class.HasDomain.Common   ( Unlines

@@ -4,15 +4,14 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP                  #-}-{-# LANGUAGE ConstraintKinds      #-}-{-# LANGUAGE PolyKinds            #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TemplateHaskell      #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif

@@ -4,16 +4,15 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE TemplateHaskell       #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif

@@ -4,9 +4,8 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds             #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Safe #-} 

@@ -0,0 +1,114 @@+{-|+Copyright  :  (C) 2019, QBayLogic+License    :  BSD2 (see the file LICENSE)+Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.Extra.Solver #-}+{-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-}+{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_HADDOCK show-extensions #-}++#include "MachDeps.h"++module Clash.Class.Parity+  ( Parity (..) )+where++import Prelude hiding                 (even, odd)++import Data.Int+import Data.Word+import Foreign.C.Types                (CUShort)+import GHC.TypeLits                   (KnownNat)++import Clash.Class.BitPack            (pack)+import Clash.Sized.Internal.BitVector (BitVector, high, low, lsb#)+import Clash.Promoted.Nat             (SNat(..), snatToNum)++{- $setup+>>> import Clash.Prelude+-}++-- | Determine whether value is odd or even+class Parity a where+  -- | Check if value is even+  --+  -- >>> even (4 :: Unsigned 4)+  -- True+  even :: a -> Bool+  even = not . odd++  -- | Check if value is odd+  --+  -- >>> odd (4 :: Unsigned 4)+  -- False+  odd :: a -> Bool+  odd = not . even+  {-# MINIMAL even | odd #-}++instance Parity Integer+  where+    even a = a `mod` 2 == 0+    odd a = a `mod` 2 == 1++instance KnownNat n => Parity (BitVector n) where+  even a =+    case snatToNum @Integer (SNat @n) of+      0 -> True+      _ -> (==low) $ lsb# a+  odd a =+    case snatToNum @Integer (SNat @n) of+      0 -> False+      _ -> (==high) $ lsb# a++instance Parity Bool where+  even = even . pack+  odd = odd . pack++instance Parity CUShort where+  even = even . pack+  odd = odd . pack++instance Parity Word where+  even = even . pack+  odd = odd . pack++instance Parity Word8 where+  even = even . pack+  odd = odd . pack++instance Parity Word16 where+  even = even . pack+  odd = odd . pack++instance Parity Word32 where+  even = even . pack+  odd = odd . pack++instance Parity Word64 where+  even = even . pack+  odd = odd . pack++instance Parity Int where+  even = even . pack+  odd = odd . pack++instance Parity Int8 where+  even = even . pack+  odd = odd . pack++instance Parity Int16 where+  even = even . pack+  odd = odd . pack++instance Parity Int32 where+  even = even . pack+  odd = odd . pack++instance Parity Int64 where+  even = even . pack+  odd = odd . pack

@@ -4,10 +4,6 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds      #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeOperators  #-}- {-# LANGUAGE Safe #-}  {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}@@ -15,10 +11,11 @@  module Clash.Class.Resize where +import Data.Kind (Type) import GHC.TypeLits (Nat, KnownNat, type (+))  -- | Coerce a value to be represented by a different number of bits-class Resize (f :: Nat -> *) where+class Resize (f :: Nat -> Type) where   -- | A sign-preserving resize operation   --   -- * For signed datatypes: Increasing the size of the number replicates the

@@ -7,22 +7,25 @@ Generic clock related utilities. -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE InstanceSigs        #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} -module Clash.Clocks (Clocks, clocks) where+module Clash.Clocks (Clocks(..)) where +import Data.Kind (Constraint)+ import Clash.Signal.Internal import Clash.Clocks.Deriving (deriveClocksInstances)  class Clocks t where+  type ClocksCxt t :: Constraint+   clocks-    :: Clock domIn+    :: (KnownDomain domIn, ClocksCxt t)+    => Clock domIn     -> Reset domIn     -> t 

@@ -5,9 +5,9 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE TemplateHaskell   #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE ViewPatterns      #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}  module Clash.Clocks.Deriving (deriveClocksInstances) where @@ -21,9 +21,18 @@ derive' :: Int -> Q Dec derive' n = do   -- (Clock d0, Clock d1, )-  instType  <- foldM (\a n' -> AppT a <$> clkType n') (TupleT $ n + 1) [1..n]-  instType' <- (AppT (ConT $ mkName "Clocks") . AppT instType) <$> lockType+  instType0 <- foldM (\a n' -> AppT a <$> clkType n') (TupleT $ n + 1) [1..n]+  instType1 <- AppT instType0 <$> lockType+  let instHead = AppT (ConT $ mkName "Clocks") instType1 +  cxtRHS <- foldM (\a n' -> AppT a <$> knownDomainCxt n') (TupleT n) [1..n]+#if MIN_VERSION_template_haskell(2,15,0)+  let cxtLHS = AppT (ConT $ mkName "ClocksCxt") instType1+  let cxtTy  = TySynInstD (TySynEqn Nothing cxtLHS cxtRHS)+#else+  let cxtTy  = TySynInstD (mkName "ClocksCxt") (TySynEqn [instType1] cxtRHS)+#endif+   -- Function definition of 'clocks'   let clk = mkName "clk"   let rst = mkName "rst"@@ -35,13 +44,17 @@   let funcBody  = NormalB instTuple   let instFunc  = FunD (mkName "clocks") [Clause [VarP clk, VarP rst] funcBody []] -  return $ InstanceD Nothing [] instType' [instFunc, noInline]+  return $ InstanceD Nothing [] instHead [cxtTy, instFunc, noInline]    where     -- | Generate type @Clock dom@ with fresh @dom@ variable     clkType n' =       let c = varT $ mkName ("c" ++ show n') in       [t| Clock $c |]++    knownDomainCxt n' =+      let c = varT $ mkName ("c" ++ show n') in+      [t| KnownDomain $c |]      -- | Generate type @Signal dom 'Bool@ with fresh @dom@ variable     lockType =

@@ -2,12 +2,17 @@ Copyright : © 2015-2016, Christiaan Baaij,               2017     , Google Inc.               2019     , Myrtle Software Ltd-Licence   : Creative Commons 4.0 (CC BY 4.0) (http://creativecommons.org/licenses/by/4.0/)+Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/) -} -{-# LANGUAGE NoImplicitPrelude, CPP, TemplateHaskell, DataKinds, BinaryLiterals,-             FlexibleContexts, GADTs, TypeOperators, TypeApplications,-             RecordWildCards, DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+ {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}@@ -157,10 +162,7 @@     s = register 1 (mux enable (rotateL <$> s <*> 1) s)  crcT-  :: ( Bits a-     , KnownNat (BitSize a)-     , BitPack a-     )+  :: (Bits a, BitPack a)   => a   -> Bit   -> a@@ -551,6 +553,7 @@ {- $uart @ {\-\# LANGUAGE RecordWildCards \#-\}+ module UART (uart) where  import Clash.Prelude

@@ -19,6 +19,7 @@  @ {\-\# LANGUAGE RecordWildCards, TupleSections, DeriveAnyClass \#-\}+ module CPU where  import Clash.Explicit.Prelude@@ -373,14 +374,7 @@  -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE KindSignatures      #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE GADTs #-}  {-# LANGUAGE Trustworthy #-} @@ -406,7 +400,7 @@ where  import           Data.Maybe             (isJust)-import qualified Data.Vector  as V+import qualified Data.Sequence          as Seq import           GHC.Stack              (HasCallStack, withFrozenCallStack) import           GHC.TypeLits           (KnownNat, type (^), type (<=)) import           Prelude                hiding (length, replicate)@@ -424,7 +418,7 @@ import           Clash.Sized.Vector     (Vec, replicate, toList, iterateI) import qualified Clash.Sized.Vector     as CV import           Clash.XException-  (maybeIsX, seqX, NFDataX, deepErrorX, defaultSeqX, errorX)+  (maybeIsX, seqX, NFDataX, deepErrorX, defaultSeqX, fromJustX)  {- $setup >>> import Clash.Explicit.Prelude as C@@ -692,10 +686,6 @@  -} -fromJustX :: HasCallStack => Maybe a -> a-fromJustX Nothing  = errorX "fromJustX: Nothing"-fromJustX (Just x) = x- -- | Create a blockRAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle@@ -997,7 +987,7 @@   -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle blockRam# (Clock _) gen content rd wen =   go-    (V.fromList (toList content))+    (Seq.fromList (toList content))     (withFrozenCallStack (deepErrorX "blockRam: intial value undefined"))     (fromEnable gen)     rd@@ -1005,16 +995,16 @@  where   go !ram o ret@(~(re :- res)) rt@(~(r :- rs)) et@(~(e :- en)) wt@(~(w :- wr)) dt@(~(d :- din)) =     let ram' = d `defaultSeqX` upd ram e (fromEnum w) d-        o'   = if re then ram V.! r else o+        o'   = if re then ram `Seq.index` r else o     in  o `seqX` o :- (ret `seq` rt `seq` et `seq` wt `seq` dt `seq` go ram' o' res rs en wr din)    upd ram we waddr d = case maybeIsX we of     Nothing -> case maybeIsX waddr of-      Nothing -> V.map (const (seq waddr d)) ram-      Just wa -> ram V.// [(wa,d)]+      Nothing -> fmap (const (seq waddr d)) ram+      Just wa -> Seq.update wa d ram     Just True -> case maybeIsX waddr of-      Nothing -> V.map (const (seq waddr d)) ram-      Just wa -> ram V.// [(wa,d)]+      Nothing -> fmap (const (seq waddr d)) ram+      Just wa -> Seq.update wa d ram     _ -> ram {-# ANN blockRam# hasBlackBox #-} {-# NOINLINE blockRam# #-}

@@ -71,13 +71,7 @@  -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE GADTs #-}  {-# LANGUAGE Unsafe #-} @@ -99,8 +93,8 @@ where  import Data.Char             (digitToInt)-import Data.Maybe            (fromJust, isJust, listToMaybe)-import qualified Data.Vector as V+import Data.Maybe            (isJust, listToMaybe)+import qualified Data.Sequence as Seq import GHC.Stack             (HasCallStack, withFrozenCallStack) import GHC.TypeLits          (KnownNat) import Numeric               (readInt)@@ -112,7 +106,7 @@   (Clock(..), Signal (..), Enable, KnownDomain, fromEnable, (.&&.)) import Clash.Signal.Bundle   (unbundle) import Clash.Sized.Unsigned  (Unsigned)-import Clash.XException      (errorX, maybeIsX, seqX)+import Clash.XException      (errorX, maybeIsX, seqX, fromJustX)   -- | Create a blockRAM with space for 2^@n@ elements@@ -205,7 +199,7 @@   -- clock cycle blockRamFile = \clk gen sz file rd wrM ->   let en       = isJust <$> wrM-      (wr,din) = unbundle (fromJust <$> wrM)+      (wr,din) = unbundle (fromJustX <$> wrM)   in  withFrozenCallStack       (blockRamFile# clk gen sz file (fromEnum <$> rd) en (fromEnum <$> wr) din) {-# INLINE blockRamFile #-}@@ -242,7 +236,7 @@   where     -- clock enable     go-      :: V.Vector (BitVector m)+      :: Seq.Seq (BitVector m)       -> BitVector m       -> Signal dom Bool       -> Signal dom Int@@ -252,22 +246,22 @@       -> Signal dom (BitVector m)     go !ram o (re :- res) (r :- rs) (e :- en) (w :- wr) (d :- din) =       let ram' = upd ram e (fromEnum w) d-          o'   = if re then ram V.! r else o+          o'   = if re then ram `Seq.index` r else o       in  o `seqX` o :- go ram' o' res rs en wr din      upd ram we waddr d = case maybeIsX we of       Nothing -> case maybeIsX waddr of-        Nothing -> V.map (const (seq waddr d)) ram-        Just wa -> ram V.// [(wa,d)]+        Nothing -> fmap (const (seq waddr d)) ram+        Just wa -> Seq.update wa d ram       Just True -> case maybeIsX waddr of-        Nothing -> V.map (const (seq waddr d)) ram-        Just wa -> ram V.// [(wa,d)]+        Nothing -> fmap (const (seq waddr d)) ram+        Just wa -> Seq.update wa d ram       _ -> ram      content = unsafePerformIO (initMem file) -    ramI :: V.Vector (BitVector m)-    ramI = V.fromList content+    ramI :: Seq.Seq (BitVector m)+    ramI = Seq.fromList content {-# NOINLINE blockRamFile# #-}  -- | __NB:__ Not synthesizable

@@ -18,18 +18,9 @@ or "Clash.Xilinx.DDR". -} -{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}-{-# LANGUAGE ViewPatterns        #-}-#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE NoStarIsType #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}  module Clash.Explicit.DDR   ( ddrIn

@@ -9,9 +9,7 @@ defined in "Clash.Prelude". -} -{-# LANGUAGE DataKinds         #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeOperators     #-}  {-# LANGUAGE Unsafe #-} @@ -57,6 +55,8 @@   , windowD   , isRising   , isFalling+  , riseEvery+  , oscillate     -- * Testbench functions   , assert   , stimuliGenerator@@ -108,6 +108,7 @@   , Lift (..)     -- ** Type classes     -- *** Clash+  , module Clash.Class.AutoReg   , module Clash.Class.BitPack   , module Clash.Class.Exp   , module Clash.Class.Num@@ -118,7 +119,6 @@   , module Data.Default.Class     -- ** Exceptions   , module Clash.XException-  , undefined     -- ** Named types   , module Clash.NamedTypes     -- ** Magic@@ -138,6 +138,7 @@ import Clash.HaskellPrelude  import Clash.Annotations.TopEntity+import Clash.Class.AutoReg import Clash.Class.BitPack import Clash.Class.Exp import Clash.Class.Num

@@ -11,11 +11,8 @@ defined in "Clash.Prelude". -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE NoImplicitPrelude   #-}-{-# LANGUAGE TypeOperators       #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}  {-# LANGUAGE Safe #-} @@ -93,7 +90,6 @@   , module Data.Bits       -- ** Exceptions   , module Clash.XException-  , undefined     -- ** Named types   , module Clash.NamedTypes     -- ** Haskell Prelude@@ -105,7 +101,6 @@ import Control.Applicative import Data.Bits import GHC.Generics (Generic, Generic1)-import GHC.Stack import GHC.TypeLits import GHC.TypeLits.Extra import Clash.HaskellPrelude@@ -253,5 +248,3 @@       else (s+1, i)     -- hold current output {-# INLINEABLE oscillate #-} -undefined :: HasCallStack => a-undefined = errorX "undefined"

@@ -8,15 +8,9 @@ RAM primitives with a combinational read port. -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Trustworthy #-} @@ -35,17 +29,17 @@   ) where -import Data.Maybe            (fromJust, isJust)+import Data.Maybe            (isJust) import GHC.Stack             (HasCallStack, withFrozenCallStack) import GHC.TypeLits          (KnownNat)-import qualified Data.Vector as V+import qualified Data.Sequence as Seq  import Clash.Explicit.Signal   (unbundle, unsafeSynchronizer, KnownDomain, enable) import Clash.Promoted.Nat    (SNat (..), snatToNum, pow2SNat) import Clash.Signal.Internal (Clock (..), Signal (..), Enable, fromEnable) import Clash.Sized.Unsigned  (Unsigned)-import Clash.XException      (errorX, maybeIsX)+import Clash.XException      (errorX, maybeIsX, fromJustX)  -- | Create a RAM with space for 2^@n@ elements --@@ -109,7 +103,7 @@    -- ^ Value of the @RAM@ at address @r@ asyncRam = \wclk rclk gen sz rd wrM ->   let en       = isJust <$> wrM-      (wr,din) = unbundle (fromJust <$> wrM)+      (wr,din) = unbundle (fromJustX <$> wrM)   in  withFrozenCallStack       (asyncRam# wclk rclk gen sz (fromEnum <$> rd) en (fromEnum <$> wr) din) {-# INLINE asyncRam #-}@@ -141,25 +135,25 @@     unsafeSynchronizer wclk rclk dout   where     rd'  = unsafeSynchronizer rclk wclk rd-    ramI = V.replicate+    ramI = Seq.replicate               (snatToNum sz)               (withFrozenCallStack (errorX "asyncRam#: initial value undefined"))     en' = fromEnable (enable en we)     dout = go ramI rd' en' wr din -    go :: V.Vector a -> Signal wdom Int -> Signal wdom Bool+    go :: Seq.Seq a -> Signal wdom Int -> Signal wdom Bool        -> Signal wdom Int -> Signal wdom a -> Signal wdom a     go !ram (r :- rs) (e :- es) (w :- ws) (d :- ds) =       let ram' = upd ram e (fromEnum w) d-          o    = ram V.! r+          o    = ram `Seq.index` r       in  o :- go ram' rs es ws ds      upd ram we' waddr d = case maybeIsX we' of       Nothing -> case maybeIsX waddr of-        Nothing -> V.map (const (seq waddr d)) ram-        Just wa -> ram V.// [(wa,d)]+        Nothing -> fmap (const (seq waddr d)) ram+        Just wa -> Seq.update wa d ram       Just True -> case maybeIsX waddr of-        Nothing -> V.map (const (seq waddr d)) ram-        Just wa -> ram V.// [(wa,d)]+        Nothing -> fmap (const (seq waddr d)) ram+        Just wa -> Seq.update wa d ram       _ -> ram {-# NOINLINE asyncRam# #-}

@@ -8,12 +8,8 @@ ROMs -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}  {-# LANGUAGE Trustworthy #-} @@ -108,16 +104,16 @@   -- ^ Read address @rd@   -> Signal dom a   -- ^ The value of the ROM at address @rd@ from the previous clock cycle-rom# _ en content rd =+rom# _ en content =   go     (withFrozenCallStack (deepErrorX "rom: initial value undefined"))     (fromEnable en)-    ((arr !) <$> rd)  where   szI = length content   arr = listArray (0,szI-1) (toList content) -  go o (e :- es) as@(~(x :- xs)) =+  go o (e :- es) rd@(~(r :- rs)) =+    let o1 = if e then arr ! r else o     -- See [Note: register strictness annotations]-    o `seqX` o :- (as `seq` if e then go x es xs else go o es xs)+    in  o `seqX` o :- (rd `seq` go o1 es rs) {-# NOINLINE rom# #-}

@@ -69,12 +69,7 @@ @ -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE FlexibleContexts #-}  {-# LANGUAGE Unsafe #-} 

@@ -129,28 +129,26 @@  -} -{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE ExplicitNamespaces    #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE ViewPatterns          #-}+{-# LANGUAGE RankNTypes #-}  {-# LANGUAGE Trustworthy #-}  {-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -Wno-orphans #-}  {-# OPTIONS_HADDOCK show-extensions #-}  module Clash.Explicit.Signal   ( -- * Synchronous signal     Signal+  , BiSignalIn+  , BiSignalOut+  , BiSignalDefault(..)     -- * Domain   , Domain   , KnownDomain(..)@@ -189,7 +187,7 @@   , initBehavior   , resetPolarity     -- ** Enabling-  , Enable(..)+  , Enable   , toEnable   , fromEnable   , enableGen@@ -202,7 +200,7 @@   , unsafeSynchronizer   , veryUnsafeSynchronizer     -- * Reset-  , Reset(..)+  , Reset   , unsafeToReset   , unsafeFromReset   , unsafeToHighPolarity@@ -221,6 +219,7 @@   , register   , regMaybe   , regEn+  , mux     -- * Simulation and testbench functions   , clockGen   , resetGen@@ -231,6 +230,8 @@   , (.&&.), (.||.)     -- * Product/Signal isomorphism   , Bundle(..)+  , EmptyTuple(..)+  , TaggedEmptyTuple(..)     -- * Simulation functions (not synthesizable)   , simulate   , simulateB@@ -242,6 +243,8 @@     -- * List \<-\> Signal conversion (not synthesizable)   , sample   , sampleN+  , sampleWithReset+  , sampleWithResetN   , fromList   , fromListWithReset     -- ** lazy versions@@ -255,21 +258,29 @@   , (.==.), (./=.)     -- ** 'Ord'-like   , (.<.), (.<=.), (.>=.), (.>.)+    -- * Bisignal functions+  , veryUnsafeToBiSignalIn+  , readFromBiSignal+  , writeToBiSignal+  , mergeBiSignalOuts   ) where -import           Data.Maybe                     (isJust, fromJust)+import           Data.Maybe                     (isJust) import           GHC.TypeLits                   (type (+), type (<=))  import           Clash.Annotations.Primitive    (hasBlackBox) import           Clash.Class.Num                (satSucc, SaturationMode(SatBound)) import           Clash.Promoted.Nat             (SNat(..), snatToNum)-import           Clash.Signal.Bundle            (Bundle (..))+import           Clash.Signal.Bundle+  (Bundle (..), EmptyTuple(..), TaggedEmptyTuple(..), vecBundle#)+import           Clash.Signal.BiSignal import           Clash.Signal.Internal import           Clash.Signal.Internal.Ambiguous   (knownVDomain, clockPeriod, activeEdge, resetKind, initBehavior, resetPolarity) import           Clash.Sized.Index              (Index)-import           Clash.XException               (NFDataX, deepErrorX)+import qualified Clash.Sized.Vector+import           Clash.XException               (NFDataX, deepErrorX, fromJustX)  {- $setup >>> :set -XDataKinds -XTypeApplications -XFlexibleInstances -XMultiParamTypeClasses -XTypeFamilies@@ -601,7 +612,7 @@   -> Signal dom (Maybe a)   -> Signal dom a delayMaybe clk gen dflt i =-  delayEn clk gen dflt (isJust <$> i) (fromJust <$> i)+  delayEn clk gen dflt (isJust <$> i) (fromJustX <$> i) {-# INLINE delayMaybe #-}  -- | Version of 'delay' that only updates when its third argument is asserted.@@ -686,7 +697,7 @@   -> Signal dom (Maybe a)   -> Signal dom a regMaybe clk rst en initial iM =-  register clk rst (enable en (fmap isJust iM)) initial (fmap fromJust iM)+  register clk rst (enable en (fmap isJust iM)) initial (fmap fromJustX iM) {-# INLINE regMaybe #-}  -- | Version of 'register' that only updates its content when its fourth@@ -898,3 +909,53 @@       (SAsynchronous, SSynchronous) ->         delay clkB enableGen True $           delay clkB enableGen True rstA1++-- | Get a list of samples from a 'Signal', while asserting the reset line+-- for /n/ clock cycles. 'sampleWithReset' does not return the first /n/ cycles,+-- i.e., when the reset is asserted.+--+-- __NB__: This function is not synthesizable+sampleWithReset+  :: forall dom a m+   . ( KnownDomain dom+     , NFDataX a+     , 1 <= m )+  => SNat m+  -- ^ Number of cycles to assert the reset+  -> (KnownDomain dom+      => Clock dom+      -> Reset dom+      -> Enable dom+      -> Signal dom a)+  -- ^ 'Signal' to sample+  -> [a]+sampleWithReset nReset f0 =+  let f1 = f0 clockGen (resetGenN @dom nReset) enableGen in+  drop (snatToNum nReset) (sample f1)+{-# NOINLINE sampleWithReset #-}++-- | Get a fine list of /m/ samples from a 'Signal', while asserting the reset line+-- for /n/ clock cycles. 'sampleWithReset' does not return the first /n/ cycles,+-- i.e., while the reset is asserted.+--+-- __NB__: This function is not synthesizable+sampleWithResetN+  :: forall dom a m+   . ( KnownDomain dom+     , NFDataX a+     , 1 <= m )+  => SNat m+  -- ^ Number of cycles to assert the reset+  -> Int+  -- ^ Number of samples to produce+  -> (KnownDomain dom+      => Clock dom+      -> Reset dom+      -> Enable dom+      -> Signal dom a)+  -- ^ 'Signal' to sample+  -> [a]+sampleWithResetN nReset nSamples f =+  take nSamples (sampleWithReset nReset f)++{-# RULES "sequenceAVecSignal" Clash.Sized.Vector.traverse# (\x -> x) = vecBundle# #-}

@@ -6,14 +6,16 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE GADTs                      #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif+ {-# LANGUAGE Trustworthy #-}  {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}@@ -24,6 +26,9 @@     -- * Delay-annotated synchronous signals   , delayed   , delayedI+  , delayN+  , delayI+  , delayedFold   , feedback     -- * Signal \<-\> DSignal conversion   , fromSignal@@ -39,18 +44,21 @@ where  import Data.Coerce                (coerce)-import GHC.TypeLits               (KnownNat, type (+))+import Data.Kind                  (Type)+import Data.Proxy                 (Proxy (..))+import Data.Singletons.Prelude    (Apply, TyFun, type (@@))+import GHC.TypeLits               (KnownNat, Nat, type (+), type (^), type (*)) import Prelude                    hiding (head, length, repeat)  import Clash.Sized.Vector-  (Vec, head, length, repeat, shiftInAt0, singleton)+  (Vec, dtfold, head, length, repeat, shiftInAt0, singleton) import Clash.Signal.Delayed.Internal   (DSignal(..), dfromList, dfromList_lazy, fromSignal, toSignal,    unsafeFromSignal, antiDelay, feedback)  import Clash.Explicit.Signal-  (KnownDomain, Clock, Reset, Signal, Enable, register,  bundle, unbundle)-+  (KnownDomain, Clock, Domain, Reset, Signal, Enable, register, delay, bundle, unbundle)+import Clash.Promoted.Nat         (SNat (..), snatToInteger) import Clash.XException           (NFDataX)  {- $setup@@ -59,6 +67,9 @@ >>> import Clash.Explicit.Prelude >>> let delay3 clk rst en = delayed clk rst en (-1 :> -1 :> -1 :> Nil) >>> let delay2 clk rst en = (delayedI clk rst en :: Int -> DSignal System n Int -> DSignal System (n + 2) Int)+>>> let delayN2 = delayN d2+>>> let delayI2 = delayI :: KnownDomain dom => Int -> Enable dom -> Clock dom -> DSignal dom n Int -> DSignal dom (n + 2) Int+>>> let countingSignals = Clash.Prelude.repeat (dfromList [0..]) :: Vec 4 (DSignal dom 0 Int) >>> :{ let mac :: Clock System         -> Reset System@@ -81,7 +92,8 @@ -- -- @ -- delay3---   :: Clock dom+--   :: KnownDomain dom+--   => Clock dom --   -> Reset dom --   -> Enable dom --   -> 'DSignal' dom n Int@@ -117,7 +129,8 @@ -- -- @ -- delay2---   :: Clock dom+--   :: KnownDomain dom+--   => Clock dom --   -> Reset dom --   -> Enable dom --   -> Int@@ -152,3 +165,110 @@   -> DSignal dom n a   -> DSignal dom (n + d) a delayedI clk rst en dflt = delayed clk rst en (repeat dflt)++-- | Delay a 'DSignal' for @d@ cycles, the value at time 0..d-1 is /a/.+--+-- @+-- delayN2+--   :: 'KnownDomain' dom+--   => Int+--   -> 'Enable' dom+--   -> 'Clock' dom+--   -> 'DSignal' dom n Int+--   -> 'DSignal' dom (n + 2) Int+-- delayN2 = 'delayN' d2+-- @+--+-- >>> printX $ sampleN 6 (toSignal (delayN2 (-1) enableGen systemClockGen (dfromList [1..])))+-- [-1,-1,1,2,3,4]+delayN+  :: forall dom a d n+   . ( KnownDomain dom+     , NFDataX a )+  => SNat d+  -> a+  -- ^ Initial value+  -> Enable dom+  -> Clock dom+  -> DSignal dom n a+  -> DSignal dom (n+d) a+delayN d dflt ena clk = coerce . go (snatToInteger d) . coerce @_ @(Signal dom a)+  where+    go 0 = id+    go i = delay clk ena dflt . go (i-1)++-- | Delay a 'DSignal' for @d@ cycles, where @d@ is derived from the context.+-- The value at time 0..d-1 is a default value.+--+-- @+-- delayI2+--   :: 'KnownDomain' dom+--   => Int+--   -> 'Enable' dom+--   -> 'Clock' dom+--   -> 'DSignal' dom n Int+--   -> 'DSignal' dom (n + 2) Int+-- delayI2 = 'delayI'+-- @+--+-- >>> sampleN 6 (toSignal (delayI2 (-1) enableGen systemClockGen (dfromList [1..])))+-- [-1,-1,1,2,3,4]+--+-- You can also use type application to do the same:+-- >>> sampleN 6 (toSignal (delayI @2 (-1) enableGen systemClockGen (dfromList [1..])))+-- [-1,-1,1,2,3,4]+delayI+  :: forall d n a dom+   . ( NFDataX a+     , KnownDomain dom+     , KnownNat d )+  => a+  -- ^ Initial value+  -> Enable dom+  -> Clock dom+  -> DSignal dom n a+  -> DSignal dom (n+d) a+delayI dflt = delayN (SNat :: SNat d) dflt++data DelayedFold (dom :: Domain) (n :: Nat) (delay :: Nat) (a :: Type) (f :: TyFun Nat Type) :: Type+type instance Apply (DelayedFold dom n delay a) k = DSignal dom (n + (delay*k)) a++-- | Tree fold over a 'Vec' of 'DSignal's with a combinatorial function,+-- and delaying @delay@ cycles after each application.+-- Values at times 0..(delay*k)-1 are set to a default.+--+-- @+-- countingSignals :: Vec 4 (DSignal dom 0 Int)+-- countingSignals = repeat (dfromList [0..])+-- @+--+-- >>> printX $ sampleN 6 (toSignal (delayedFold  d1 (-1) (+) enableGen systemClockGen countingSignals))+-- [-1,-2,0,4,8,12]+--+-- >>> printX $ sampleN 8 (toSignal (delayedFold d2 (-1) (*) enableGen systemClockGen countingSignals))+-- [-1,-1,1,1,0,1,16,81]+delayedFold+  :: forall dom  n delay k a+   . ( NFDataX a+     , KnownDomain dom+     , KnownNat delay+     , KnownNat k )+  => SNat delay+  -- ^ Delay applied after each step+  -> a+  -- ^ Initial value+  -> (a -> a -> a)+  -- ^ Fold operation to apply+  -> Enable dom+  -> Clock dom+  -> Vec (2^k) (DSignal dom n a)+  -- ^ Vector input of size 2^k+  -> DSignal dom (n + (delay * k)) a+  -- ^ Output Signal delayed by (delay * k)+delayedFold _ dflt op ena clk = dtfold (Proxy :: Proxy (DelayedFold dom n delay a)) id go+  where+    go :: SNat l+       -> DelayedFold dom n delay a @@ l+       -> DelayedFold dom n delay a @@ l+       -> DelayedFold dom n delay a @@ (l+1)+    go SNat x y = delayI dflt ena clk (op <$> x <*> y)

@@ -0,0 +1,333 @@+{-|+  Copyright   :  (C) 2019, Google Inc+  License     :  BSD2 (see the file LICENSE)+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>++  I\/O actions that are translatable to HDL+-}++{-# LANGUAGE BangPatterns, MagicHash, TypeOperators, ScopedTypeVariables, FlexibleContexts #-}+{-# LANGUAGE DataKinds, GADTs, TypeApplications #-}++module Clash.Explicit.SimIO+  ( -- * I\/O environment for simulation+    mealyIO+  , SimIO+  -- * Display on stdout+  , display+  -- * End of simulation+  , finish+  -- * Mutable values+  , Reg+  , reg+  , readReg+  , writeReg+  -- * File I\/O+  , File+  , openFile+  , closeFile+  -- ** Reading and writing characters+  , getChar+  , putChar+  -- ** Reading strings+  , getLine+  -- ** Detecting the end of input+  , isEOF+    -- ** Buffering operations+  , flush+    -- ** Repositioning handles+  , seek+  , rewind+  , tell+  )+where++import Control.Monad (when)+import Data.Coerce+import Data.IORef+import GHC.TypeLits+import Prelude hiding (getChar, putChar, getLine)+import qualified System.IO as IO+import System.IO.Unsafe++import Clash.Annotations.Primitive (hasBlackBox)+import Clash.Promoted.Nat+import Clash.Signal.Internal+import Clash.Sized.Unsigned+import Clash.Sized.Vector (Vec (..))+import Clash.XException (seqX)++-- | Simulation-level I\/O environment; synthesizable to HDL I\/O, which in+-- itself is unlikely to be synthesisable to a digital circuit.+--+-- See 'mealyIO' as to its use.+newtype SimIO a = SimIO {unSimIO :: IO a}++instance Functor SimIO where+  fmap = fmapSimIO#++fmapSimIO# :: (a -> b) -> SimIO a -> SimIO b+fmapSimIO# f (SimIO m) = SimIO (fmap f m)+{-# NOINLINE fmapSimIO# #-}++instance Applicative SimIO where+  pure  = pureSimIO#+  (<*>) = apSimIO#++pureSimIO# :: a -> SimIO a+pureSimIO# a = SimIO (pure a)+{-# NOINLINE pureSimIO# #-}++apSimIO# :: SimIO (a -> b) -> SimIO a -> SimIO b+apSimIO# (SimIO f) (SimIO m) = SimIO (f <*> m)+{-# NOINLINE apSimIO# #-}++instance Monad SimIO where+  return = pureSimIO#+  (>>=)  = bindSimIO#++bindSimIO# :: SimIO a -> (a -> SimIO b) -> SimIO b+bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` coerce k x))+{-# NOINLINE bindSimIO# #-}++-- | Display a string on /stdout/+display+  :: String+  -- ^ String you want to display+  -> SimIO ()+display s = SimIO (putStrLn s)+{-# NOINLINE display #-}+{-# ANN display hasBlackBox #-}++-- | Finish the simulation with an exit code+finish+  :: Integer+  -- ^ The exit code you want to return at the end of the simulation+  -> SimIO a+finish i = return (error (show i))+{-# NOINLINE finish #-}+{-# ANN finish hasBlackBox #-}++-- | Mutable reference+newtype Reg a = Reg (IORef a)++-- | Create a new mutable reference with the given starting value+reg+  :: a+  -- ^ The starting value+  -> SimIO (Reg a)+reg a = SimIO (Reg <$> newIORef a)+{-# NOINLINE reg #-}+{-# ANN reg hasBlackBox #-}++-- | Read value from a mutable reference+readReg :: Reg a -> SimIO a+readReg (Reg a) = SimIO (readIORef a)+{-# NOINLINE readReg #-}+{-# ANN readReg hasBlackBox #-}++-- | Write new value to the mutable reference+writeReg+  :: Reg a+  -- ^ The mutable reference+  -> a+  -- ^ The new value+  -> SimIO ()+writeReg (Reg r) a = SimIO (writeIORef r a)+{-# NOINLINE writeReg #-}+{-# ANN writeReg hasBlackBox #-}++-- | File handle+newtype File = File IO.Handle++-- | Open a file+openFile+  :: FilePath+  -- ^ File to open+  -> String+  -- ^ File mode:+  --+  -- * "r": Open for reading+  -- * "w": Create for writing+  -- * "a": Append+  -- * "r+": Open for update (reading and writing)+  -- * "w+": Create for update+  -- * "a+": Append, open or create for update at end-of-file+  -> SimIO File+openFile fp "r"   = coerce (IO.openFile fp IO.ReadMode)+openFile fp "w"   = coerce (IO.openFile fp IO.WriteMode)+openFile fp "a"   = coerce (IO.openFile fp IO.AppendMode)+openFile fp "rb"  = coerce (IO.openBinaryFile fp IO.ReadMode)+openFile fp "wb"  = coerce (IO.openBinaryFile fp IO.WriteMode)+openFile fp "ab"  = coerce (IO.openBinaryFile fp IO.AppendMode)+openFile fp "r+"  = coerce (IO.openFile fp IO.ReadWriteMode)+openFile fp "w+"  = coerce (IO.openFile fp IO.WriteMode)+openFile fp "a+"  = coerce (IO.openFile fp IO.AppendMode)+openFile fp "r+b" = coerce (IO.openBinaryFile fp IO.ReadWriteMode)+openFile fp "w+b" = coerce (IO.openBinaryFile fp IO.WriteMode)+openFile fp "a+b" = coerce (IO.openBinaryFile fp IO.AppendMode)+openFile fp "rb+" = coerce (IO.openBinaryFile fp IO.ReadWriteMode)+openFile fp "wb+" = coerce (IO.openBinaryFile fp IO.WriteMode)+openFile fp "ab+" = coerce (IO.openBinaryFile fp IO.AppendMode)+openFile _  m     = error ("openFile unknown mode: " ++ show m)+{-# NOINLINE openFile #-}+{-# ANN openFile hasBlackBox #-}++-- | Close a file+closeFile+  :: File+  -> SimIO ()+closeFile (File fp) = SimIO (IO.hClose fp)+{-# NOINLINE closeFile #-}+{-# ANN closeFile hasBlackBox #-}++-- | Read one character from a file+getChar+  :: File+  -- ^ File to read from+  -> SimIO Char+getChar (File fp) = SimIO (IO.hGetChar fp)+{-# NOINLINE getChar #-}+{-# ANN getChar hasBlackBox #-}++-- | Insert a character into a buffer specified by the file+putChar+  :: Char+  -- ^ Character to insert+  -> File+  -- ^ Buffer to insert to+  -> SimIO ()+putChar c (File fp) = SimIO (IO.hPutChar fp c)+{-# NOINLINE putChar #-}+{-# ANN putChar hasBlackBox #-}++-- | Read one line from a file+getLine+  :: forall n+   . KnownNat n+  => File+  -- ^ File to read from+  -> Reg (Vec n (Unsigned 8))+  -- ^ Vector to store the content+  -> SimIO Int+getLine (File fp) (Reg r) = SimIO $ do+  s <- IO.hGetLine fp+  let d = snatToNum (SNat @n) - length s+  when (d < 0) (IO.hSeek fp IO.RelativeSeek (toInteger d))+  modifyIORef r (rep s)+  return 0+ where+   rep :: String -> Vec m (Unsigned 8) -> Vec m (Unsigned 8)+   rep []     vs          = vs+   rep (x:xs) (Cons _ vs) = Cons (toEnum (fromEnum x)) (rep xs vs)+   rep _      Nil         = Nil+{-# NOINLINE getLine #-}+{-# ANN getLine hasBlackBox #-}++-- | Determine whether we've reached the end of the file+isEOF+  :: File+  -- ^ File we want to inspect+  -> SimIO Bool+isEOF (File fp) = SimIO (IO.hIsEOF fp)+{-# NOINLINE isEOF #-}+{-# ANN isEOF hasBlackBox #-}++-- | Set the position of the next operation on the file+seek+  :: File+  -- ^ File to set the position for+  -> Integer+  -- ^ Position+  -> Int+  -- ^ Mode:+  --+  -- * 0: From the beginning of the file+  -- * 1: From the current position+  -- * 2: From the end of the file+  -> SimIO Int+seek (File fp) pos mode = SimIO (IO.hSeek fp (toEnum mode) pos >> return 0)+{-# NOINLINE seek #-}+{-# ANN seek hasBlackBox #-}++-- | Set the position of the next operation to the beginning of the file+rewind+  :: File+  -> SimIO Int+rewind (File fp) = SimIO (IO.hSeek fp IO.AbsoluteSeek 0 >> return 0)+{-# NOINLINE rewind #-}+{-# ANN rewind hasBlackBox #-}++-- | Returns the offset from the beginning of the file (in bytes).+tell+  :: File+  -- ^ File we want to inspect+  -> SimIO Integer+tell (File fp) = SimIO (IO.hTell fp)+{-# NOINLINE tell #-}+{-# ANN tell hasBlackBox #-}++-- | Write any buffered output to file+flush+  :: File+  -> SimIO ()+flush (File fp) = SimIO (IO.hFlush fp)+{-# NOINLINE flush #-}+{-# ANN flush hasBlackBox #-}++-- | Simulation-level I/O environment that can be synthesized to HDL-level I\/O.+-- Note that it is unlikely that the HDL-level I\/O can subsequently be+-- synthesized to a circuit.+--+-- = Example+--+-- @+-- tbMachine :: (File,File) -> Int -> SimIO Int+-- tbMachine (fileIn,fileOut) regOut = do+--   eofFileOut <- 'isEOF' fileOut+--   eofFileIn  <- 'isEOF' fileIn+--   when (eofFileIn || eofFileOut) $ do+--     'display' "success"+--     'finish' 0+--+--   goldenIn  <- 'getChar' fileIn+--   goldenOut <- 'getChar' fileOut+--   res <- if regOut == fromEnum goldenOut then do+--            return (fromEnum goldenIn)+--          else do+--            'display' "Output doesn't match golden output"+--            'finish' 1+--   display ("Output matches golden output")+--   return res+--+-- tbInit :: (File,File)+-- tbInit = do+--   fileIn  <- 'openFile' "./goldenInput00.txt" "r"+--   fileOut <- 'openFile' "./goldenOutput00.txt" "r"+--   return (fileIn,fileOut)+--+-- topEntity :: Signal System Int+-- topEntity = regOut+--   where+--     clk = systemClockGen+--     rst = resetGen+--     ena = enableGen+--+--     regOut = register clk rst ena (fromEnum 'a') regIn+--     regIn  = 'mealyIO' clk tbMachine tbInit regOut+-- @+mealyIO+  :: KnownDomain dom+  => Clock dom+  -- ^ Clock at which rate the I\/O environment progresses+  -> (s -> i -> SimIO o)+  -- ^ Transition function inside an I\/O environment+  -> SimIO s+  -- ^ I/O action to create the initial state+  -> Signal dom i+  -> Signal dom o+mealyIO !_ f (SimIO i) inp = unsafePerformIO (i >>= go inp)+ where+  go q@(~(k :- ks)) s =+    (:-) <$> unSimIO (f s k) <*> unsafeInterleaveIO ((q `seq` go ks s))+{-# NOINLINE mealyIO #-}

@@ -8,13 +8,10 @@ Synchronizer circuits for safe clock domain crossings -} -{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE Safe                  #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE Safe #-}  {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise       #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}

@@ -6,12 +6,7 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Unsafe #-} @@ -23,6 +18,7 @@ module Clash.Explicit.Testbench   ( -- * Testbench functions for circuits     assert+  , assertBitVector   , ignoreFor   , stimuliGenerator @@ -51,9 +47,9 @@ import Clash.Explicit.Signal   (Clock, Reset, System, Signal, clockPeriod, toEnable, fromList, register,   unbundle, unsafeSynchronizer, veryUnsafeSynchronizer)-import Clash.Signal.Internal (Clock (..))+import Clash.Signal.Internal (Clock (..), Reset (..)) import Clash.Signal-  (mux, DomainResetKind, ResetKind(Asynchronous), KnownDomain, Reset(..),+  (mux, DomainResetKind, ResetKind(Asynchronous), KnownDomain,   Enable) import Clash.Sized.Index     (Index) import Clash.Sized.Internal.BitVector

@@ -4,8 +4,8 @@   Maintainer  :  QBayLogic B.V <devops@qbaylogic.com>  "Clash.HaskellPrelude" re-exports most of the Haskell "Prelude" with the exception of-the following: (++), (!!), concat, drop, foldl, foldl1, foldr, foldr1, head,-init, iterate, last, length, map, repeat, replicate, reverse, scanl, scanr,+the following: (++), (!!), concat, drop, even, foldl, foldl1, foldr, foldr1, head,+init, iterate, last, length, map, odd, repeat, replicate, reverse, scanl, scanr, splitAt, tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3. -} @@ -18,6 +18,7 @@ where  import Prelude hiding-  ((++), (!!), concat, concatMap, drop, foldl, foldl1, foldr, foldr1, head, init,-   iterate, last, length, map, repeat, replicate, reverse, scanl, scanr, splitAt,-   tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3, undefined, (^))+  ((++), (!!), concat, concatMap, drop, even, foldl, foldl1, foldr, foldr1, head, init,+   iterate, last, length, map, odd, repeat, replicate, reverse, scanl, scanr, splitAt,+   tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3, undefined, (^),+   getChar, putChar, getLine)

@@ -6,15 +6,11 @@ Hidden arguments -} -{-# LANGUAGE AllowAmbiguousTypes    #-}-{-# LANGUAGE ConstraintKinds        #-}-{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE Rank2Types             #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeApplications       #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}  {-# LANGUAGE Trustworthy #-} 

@@ -7,23 +7,22 @@ PLL and other clock-related components for Intel (Altera) FPGAs -} -{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE ExplicitForAll    #-}+{-# LANGUAGE FlexibleContexts #-}  module Clash.Intel.ClockGen   ( altpll   , alteraPll   ) where -import Clash.Clocks           (clocks, Clocks)+import Clash.Clocks           (Clocks (..)) import Clash.Promoted.Symbol  (SSymbol) import Clash.Signal.Internal-  (Signal, Clock, Reset)+  (Signal, Clock, Reset, KnownDomain (..))   -- | A clock source that corresponds to the Intel/Quartus \"ALTPLL\" component+-- (Arria GX, Arria II, Stratix IV, Stratix III, Stratix II, Stratix,+--  Cyclone 10 LP, Cyclone IV, Cyclone III, Cyclone II, Cyclone) -- with settings to provide a stable 'Clock' from a single free-running input -- -- Only works when configured with:@@ -41,11 +40,11 @@ -- @ altpll   :: forall domOut domIn name-   . SSymbol name-  -- ^ Name of the component, must correspond to the name entered in the QSys-  -- dialog.+   . (KnownDomain domIn, KnownDomain domOut)+  => SSymbol name+  -- ^ Name of the component instance.   ---  -- For example, when you entered \"altPLL50\", instantiate as follows:+  -- Instantiate as follows:   --   -- > SSymbol @"altPLL50"   -> Clock domIn@@ -54,12 +53,12 @@   -- ^ Reset for the PLL   -> (Clock domOut, Signal domOut Bool)   -- ^ (Stable PLL clock, PLL lock)-altpll !_ = clocks+altpll !_ = knownDomain @domIn `seq` knownDomain @domOut `seq` clocks {-# NOINLINE altpll #-}  -- | A clock source that corresponds to the Intel/Quartus \"Altera PLL\"--- component with settings to provide a stable 'Clock' from a single--- free-running input+-- component (Arria V, Stratix V, Cyclone V) with settings to provide a stable+-- 'Clock' from a single free-running input -- -- Only works when configured with: --@@ -83,12 +82,11 @@ -- -- respectively. alteraPll-  :: Clocks t+  :: (Clocks t, KnownDomain domIn, ClocksCxt t)   => SSymbol name-  -- ^ Name of the component, must correspond to the name entered in the QSys-  -- dialog.+  -- ^ Name of the component instance.   ---  -- For example, when you entered \"alteraPLL50\", instantiate as follows:+  -- Instantiate as follows:   --   -- > SSymbol @"alteraPLL50"   -> Clock domIn

@@ -13,15 +13,9 @@ <https://www.altera.com/content/dam/altera-www/global/en_US/pdfs/literature/ug/ug_altddio.pdf> -} -{-# LANGUAGE CPP              #-}-{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MagicHash        #-}-{-# LANGUAGE TypeFamilies     #-}-{-# LANGUAGE TypeOperators    #-}-#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE NoStarIsType #-}-#endif+{-# LANGUAGE TypeFamilies #-}  module Clash.Intel.DDR   ( altddioIn

@@ -1,20 +1,28 @@ {-|   Copyright   :  (C) 2019, Myrtle Software Ltd   License     :  BSD2 (see the file LICENSE)-  Maintainer  :  QBayLogic B.V. <clash@qbaylogic.com>+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>  Control module instance, and register, names in generated HDL code. -} -{-# LANGUAGE DataKinds      #-}-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeOperators  #-}+module Clash.Magic+  (+  -- ** Functions to control names of identifiers in HDL+    prefixName+  , suffixName+  , suffixNameP+  , suffixNameFromNat+  , suffixNameFromNatP+  , setName -module Clash.Magic where+  -- ** Functions to control Clash's (de)duplication mechanisms+  , deDup+  , noDeDup+  ) where  import Clash.NamedTypes ((:::))-import GHC.TypeLits     (Symbol)+import GHC.TypeLits     (Nat,Symbol)  -- | Prefix instance and register names with the given 'Symbol' prefixName@@ -28,6 +36,58 @@ suffixName = id {-# NOINLINE suffixName #-} +-- | Suffix instance and register names with the given 'Nat'+suffixNameFromNat+  :: forall (name :: Nat) a . a -> name ::: a+suffixNameFromNat = id+{-# NOINLINE suffixNameFromNat #-}++-- | Suffix instance and register names with the given 'Symbol', but add it+-- in front of other suffixes.+--+-- When you write+--+-- @+-- suffixName \@\"A\" (suffixName \@\"B\" f))+-- @+--+-- you get register and instance names inside /f/ with the suffix: "_B_A"+--+-- However, if you want them in the other order you can write:+--+-- @+-- suffixNameP \@\"A\" (suffixName \@\"B\" f))+-- @+--+-- so that names inside /f/ will have the suffix "_A_B"+suffixNameP+  :: forall (name :: Symbol) a . a -> name ::: a+suffixNameP = id+{-# NOINLINE suffixNameP #-}++-- | Suffix instance and register names with the given 'Nat', but add it in+-- front of other suffixes.+--+-- When you write+--+-- @+-- suffixNameNat \@1 (suffixName \@\"B\" f))+-- @+--+-- you get register and instance names inside /f/ with the suffix: "_B_1"+--+-- However, if you want them in the other order you can write:+--+-- @+-- suffixNameNatP \@1 (suffixName \@\"B\" f))+-- @+--+-- so that names inside /f/ will have the suffix "_1_B"+suffixNameFromNatP+  :: forall (name :: Nat) a . a -> name ::: a+suffixNameFromNatP = id+{-# NOINLINE suffixNameFromNatP #-}+ -- | Name the instance or register with the given 'Symbol', instead of using -- an auto-generated name. Pre- and suffixes annotated with 'prefixName' and -- 'suffixName' will be added to both instances and registers named with@@ -36,3 +96,108 @@   :: forall (name :: Symbol) a . a -> name ::: a setName = id {-# NOINLINE setName #-}++-- | Force deduplication, i.e. share a function or operator between multiple+-- branches.+--+-- By default Clash converts+--+-- @+-- case x of+--   A -> 3 * y+--   B -> x * x+-- @+--+-- to+--+-- @+-- let f_arg0 = case x of {A -> 3; _ -> x}+--     f_arg1 = case x of {A -> y; _ -> x}+--     f_out  = f_arg0 * f_arg1+-- in  case x of+--       A -> f_out+--       B -> f_out+-- @+--+-- However, it won't do this for:+--+-- @+-- case x of+--   A -> 3 + y+--   B -> x + x+-- @+--+-- Because according to the internal heuristics the multiplexer introduced for+-- the deduplication are more expensive than the addition. This might not be+-- the case for your particular platform.+--+-- In these cases you can force Clash to deduplicate by:+--+-- @+-- case x of+--   A -> 'deDup' (3 + y)+--   B -> 'deDup' (x + x)+-- @+deDup+  :: forall a . a -> a+deDup = id+{-# NOINLINE deDup #-}++-- | Do not deduplicate, i.e. /keep/, an applied function inside a+-- case-alternative; do not try to share the function between multiple+-- branches.+--+-- By default Clash converts+--+-- @+-- case x of+--   A -> f 3 y+--   B -> f x x+--   C -> h x+-- @+--+-- to+--+-- @+-- let f_arg0 = case x of {A -> 3; _ -> x}+--     f_arg1 = case x of {A -> y; _ -> x}+--     f_out  = f f_arg0 f_arg1+-- in  case x of+--       A -> f_out+--       B -> f_out+--       C -> h x+-- @+--+-- i.e. it deduplicates functions (and operators such as multiplication) between+-- case-alternatives to save on area. This comes at the cost of multiplexing the+-- arguments for the deduplicated function.+--+-- There are two reasons you would want to stop Clash from doing this:+--+-- 1. The deduplicated function is in the critical path, and the addition of the+--    multiplexers further increased the propagation delay.+--+-- 2. Clash's heuristics were off, and the addition of the multiplexers actually+--    made the final circuit larger instead of smaller.+--+-- In these cases you want to tell Clash not to deduplicate:+--+-- @+-- case x of+--   A -> 'noDeDup' f 3 y+--   B -> f x x+--   C -> h x+-- @+--+-- Where the application of /f/ in the /A/-alternative is now explicitly not+-- deduplicated, and given that the /f/ in the B-alternative is the only+-- remaining application of /f/ in the case-expression it is also not+-- deduplicated.+--+-- Note that if the /C/-alternative also had an application of /f/, then the+-- applications of /f/ in the /B/- and /C/-alternatives would have been+-- deduplicated; i.e. the final circuit would have had two application of /f/.+noDeDup+  :: forall a . a -> a+noDeDup = id+{-# NOINLINE noDeDup #-}

@@ -33,8 +33,7 @@  -} -{-# LANGUAGE PolyKinds     #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}  {-# LANGUAGE Safe #-} 

@@ -32,11 +32,10 @@   Some circuit examples can be found in "Clash.Examples". -} -{-# LANGUAGE CPP               #-}-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeOperators     #-}  {-# LANGUAGE Unsafe #-} @@ -133,9 +132,12 @@   , Lift (..)     -- ** Type classes     -- *** Clash+  -- , module Clash.Class.AutoReg+  , autoReg, deriveAutoReg   , module Clash.Class.BitPack   , module Clash.Class.Exp   , module Clash.Class.Num+  , module Clash.Class.Parity   , module Clash.Class.Resize     -- *** Other   , module Control.Applicative@@ -143,7 +145,6 @@   , module Data.Default.Class     -- ** Exceptions   , module Clash.XException-  , undefined     -- ** Named types   , module Clash.NamedTypes     -- ** Hidden arguments@@ -159,15 +160,18 @@ import           Control.Applicative import           Data.Bits import           Data.Default.Class+import           GHC.Stack                   (HasCallStack) import           GHC.TypeLits import           GHC.TypeLits.Extra import           Language.Haskell.TH.Syntax  (Lift(..)) import           Clash.HaskellPrelude  import           Clash.Annotations.TopEntity+import           Clash.Class.AutoReg         (AutoReg, deriveAutoReg) import           Clash.Class.BitPack import           Clash.Class.Exp import           Clash.Class.Num+import           Clash.Class.Parity import           Clash.Class.Resize import qualified Clash.Explicit.Prelude      as E import           Clash.Hidden@@ -207,12 +211,13 @@  {- $hiding "Clash.Prelude" re-exports most of the Haskell "Prelude" with the exception of-the following: (++), (!!), concat, drop, foldl, foldl1, foldr, foldr1, head,-init, iterate, last, length, map, repeat, replicate, reverse, scanl, scanr,+the following: (++), (!!), concat, drop, even, foldl, foldl1, foldr, foldr1, head,+init, iterate, last, length, map, odd, repeat, replicate, reverse, scanl, scanr, splitAt, tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3.  It instead exports the identically named functions defined in terms of-'Clash.Sized.Vector.Vec' at "Clash.Sized.Vector".+'Clash.Sized.Vector.Vec' at "Clash.Sized.Vector". For the 'odd' end 'even'+function a type class called Parity is available at 'Clash.Class.Parity'. -}  @@ -259,3 +264,11 @@   -- ^ Window of at least size 1 windowD = hideClockResetEnable E.windowD {-# INLINE windowD #-}++-- | Implicit version of 'Clash.Class.AutoReg.autoReg'+autoReg+  :: (HasCallStack, HiddenClockResetEnable dom, AutoReg a)+  => a+  -> Signal dom a+  -> Signal dom a+autoReg = hideClockResetEnable E.autoReg

@@ -4,11 +4,8 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds        #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MagicHash        #-}-{-# LANGUAGE TypeOperators    #-}-{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Trustworthy #-} @@ -42,7 +39,7 @@ -- >>> (7 :: Unsigned 6) ! 6 -- *** Exception: (!): 6 is out of range [5..0] -- ...-(!) :: (BitPack a, KnownNat (BitSize a), Enum i) => a -> i -> Bit+(!) :: (BitPack a, Enum i) => a -> i -> Bit (!) v i = index# (pack v) (fromEnum i)  {-# INLINE slice #-}@@ -96,8 +93,7 @@ -- >>> replaceBit 6 0 (-5 :: Signed 6) -- *** Exception: replaceBit: 6 is out of range [5..0] -- ...-replaceBit :: (BitPack a, KnownNat (BitSize a), Enum i) => i -> Bit -> a-           -> a+replaceBit :: (BitPack a, Enum i) => i -> Bit -> a -> a replaceBit i b v = unpack (replaceBit# (pack v) (fromEnum i) b)  {-# INLINE setSlice #-}@@ -134,7 +130,7 @@ -- 00_0100 -- >>> msb (4 :: Signed 6) -- 0-msb :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+msb :: BitPack a => a -> Bit msb v = msb# (pack v)  {-# INLINE lsb #-}

@@ -5,7 +5,6 @@ -}  {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MagicHash        #-}  {-# LANGUAGE Trustworthy #-} @@ -13,8 +12,6 @@  module Clash.Prelude.BitReduction where -import GHC.TypeLits                   (KnownNat)- import Clash.Class.BitPack            (BitPack (..)) import Clash.Sized.Internal.BitVector (Bit, reduceAnd#, reduceOr#, reduceXor#) @@ -39,7 +36,7 @@ -- -- >>> reduceAnd (0 :: Unsigned 0) -- 1-reduceAnd :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+reduceAnd :: BitPack a => a -> Bit reduceAnd v = reduceAnd# (pack v)  {-# INLINE reduceOr #-}@@ -58,7 +55,7 @@ -- -- >>> reduceOr (0 :: Unsigned 0) -- 0-reduceOr :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+reduceOr :: BitPack a => a -> Bit reduceOr v = reduceOr# (pack v)  {-# INLINE reduceXor #-}@@ -81,5 +78,5 @@ -- -- >>> reduceXor (0 :: Unsigned 0) -- 0-reduceXor :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+reduceXor :: BitPack a => a -> Bit reduceXor v = reduceXor# (pack v)

@@ -19,6 +19,7 @@  @ {\-\# LANGUAGE RecordWildCards, TupleSections, DeriveAnyClass, TypeApplications \#-\}+ module CPU where  import Clash.Prelude@@ -372,11 +373,8 @@  -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}  {-# LANGUAGE Safe #-} 

@@ -65,14 +65,8 @@  -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}  {-# LANGUAGE Unsafe #-} 

@@ -8,13 +8,9 @@ Self-synchronizing circuits based on data-flow principles. -} -{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Safe #-} 

@@ -8,15 +8,9 @@ RAM primitives with a combinational read port. -} -{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Safe #-} 

@@ -8,11 +8,8 @@ ROMs -} -{-# LANGUAGE DataKinds        #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MagicHash        #-}-{-# LANGUAGE RankNTypes       #-}-{-# LANGUAGE TypeOperators    #-}+{-# LANGUAGE RankNTypes #-}  {-# LANGUAGE Safe #-} @@ -91,7 +88,7 @@   -- ^ Read address @rd@   -> a   -- ^ The value of the ROM at address @rd@-asyncRom# content rd = arr ! rd+asyncRom# content = \rd -> arr ! rd   where     szI = length content     arr = listArray (0,szI-1) (toList content)

@@ -63,12 +63,7 @@ @ -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE FlexibleContexts #-}  {-# LANGUAGE Unsafe #-} 

@@ -29,10 +29,8 @@   Some circuit examples can be found in "Clash.Examples". -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE NoImplicitPrelude   #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}  {-# LANGUAGE Safe #-} @@ -108,7 +106,6 @@   , module Data.Bits       -- ** Exceptions   , module Clash.XException-  , E.undefined     -- ** Named types   , module Clash.NamedTypes     -- ** Hidden arguments

@@ -6,9 +6,7 @@ Synchronizer circuits for safe clock domain crossings -} -{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeFamilies #-}  module Clash.Prelude.Synchronizer   ( -- * Bit-synchronizers

@@ -6,10 +6,8 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}  {-# LANGUAGE Unsafe #-} @@ -18,6 +16,7 @@ module Clash.Prelude.Testbench   ( -- * Testbench functions for circuits     assert+  , assertBitVector   , ignoreFor   , outputVerifier'   , outputVerifierBitVector'@@ -68,6 +67,22 @@ assert msg actual expected ret =   hideReset (hideClock E.assert) msg actual expected ret {-# INLINE assert #-}++-- | The same as 'assert', but can handle don't care bits in it's expected value.+assertBitVector+  :: (KnownNat n, HiddenClock dom , HiddenReset dom )+  => String+  -- ^ Additional message+  -> Signal dom (BitVector n)+  -- ^ Checked value+  -> Signal dom (BitVector n)+  -- ^ Expected value+  -> Signal dom b+  -- ^ Return value+  -> Signal dom b+assertBitVector msg actual expected ret =+  hideReset (hideClock E.assertBitVector) msg actual expected ret+{-# INLINE assertBitVector #-}  -- | --

@@ -6,19 +6,10 @@ -}  {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE KindSignatures      #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}-{-# LANGUAGE RankNTypes          #-}-#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE NoStarIsType #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}  {-# LANGUAGE Trustworthy #-} @@ -77,6 +68,7 @@ where  import Data.Kind          (Type)+import GHC.Show           (appPrec) import GHC.TypeLits       (KnownNat, Nat, type (+), type (-), type (*),                            type (^), type (<=), natVal) import GHC.TypeLits.Extra (CLog, FLog, Div, Log, Mod, Min, Max)@@ -109,7 +101,11 @@ snatProxy _ = SNat  instance Show (SNat n) where-  show p@SNat = 'd' : show (snatToInteger p)+  showsPrec d p@SNat | n <= 1024 = showChar 'd' . shows n+                     | otherwise = showParen (d > appPrec) $+                                     showString "SNat @" . shows n+   where+    n = snatToInteger p  instance ShowX (SNat n) where   showsPrecX = showsPrecXWith showsPrec

@@ -18,9 +18,8 @@ You can generate more 'SNat' literals using 'decLiteralsD' from "Clash.Promoted.Nat.TH" -} -{-# LANGUAGE CPP             #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DataKinds       #-}  {-# LANGUAGE Trustworthy #-} 

@@ -4,9 +4,7 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskellQuotes #-}  {-# LANGUAGE Safe #-}@@ -18,6 +16,7 @@ where  import Language.Haskell.TH.Syntax+import GHC.Show     (appPrec) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)  -- | Singleton value for a type-level string @s@@@ -32,7 +31,8 @@   instance Show (SSymbol s) where-  show s@SSymbol = symbolVal s+  showsPrec d s@SSymbol = showParen (d > appPrec) $+    showString "SSymbol @" . shows (ssymbolToString s)  {-# INLINE ssymbolProxy #-} -- | Create a singleton symbol literal @'SSymbol' s@ from a proxy for

@@ -66,26 +66,20 @@ Check out 'IntelSystem' and 'XilinxSystem' too! -} -{-# LANGUAGE CPP                   #-}-{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE ExplicitNamespaces    #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE RankNTypes #-}++{-# LANGUAGE Trustworthy #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif -{-# LANGUAGE Trustworthy #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK show-extensions #-}  module Clash.Signal@@ -140,7 +134,7 @@   , unsafeSynchronizer #endif     -- * Reset-  , Reset(..)+  , Reset   , unsafeToReset   , unsafeFromReset   , unsafeToHighPolarity@@ -150,10 +144,10 @@ #ifdef CLASH_MULTIPLE_HIDDEN   , convertReset #endif-  , E.resetSynchronizer+  , resetSynchronizer   , holdReset     -- ** Enabling-  , Enable(..)+  , Enable   , toEnable   , fromEnable   , S.enableGen@@ -164,9 +158,11 @@   , HiddenClock   , hideClock   , exposeClock-  , exposeSpecificClock   , withClock+#ifdef CLASH_MULTIPLE_HIDDEN+  , exposeSpecificClock   , withSpecificClock+#endif   , hasClock     -- ** Hidden reset   , HiddenReset@@ -217,6 +213,8 @@   , (.&&.), (.||.)     -- * Product/Signal isomorphism   , Bundle(..)+  , EmptyTuple(..)+  , TaggedEmptyTuple(..)     -- * Simulation functions (not synthesizable)   , simulate   , simulateB@@ -251,33 +249,31 @@   , mergeBiSignalOuts   ) where--import           GHC.TypeLits-  (KnownNat, KnownSymbol, AppendSymbol, Symbol, type (<=))-import           Data.Bits             (Bits) -- Haddock only+import           GHC.TypeLits          (type (<=)) import           Data.Proxy            (Proxy(..)) import           Prelude import           Test.QuickCheck       (Property, property) + #ifdef CLASH_MULTIPLE_HIDDEN-import           Clash.Class.HasDomain (WithSingleDomain, WithSpecificDomain)-#else-import           Clash.Class.HasDomain (WithSpecificDomain)+import           GHC.TypeLits          (AppendSymbol)+import           Clash.Class.HasDomain (WithSingleDomain) #endif++import           Clash.Class.HasDomain (WithSpecificDomain) import qualified Clash.Explicit.Signal as E import           Clash.Explicit.Signal-  (System, resetSynchronizer, systemClockGen, systemResetGen)+  (resetSynchronizer, systemClockGen, systemResetGen) import qualified Clash.Explicit.Signal as S import           Clash.Hidden import           Clash.Promoted.Nat    (SNat (..), snatToNum)-import           Clash.Promoted.Symbol (SSymbol (..))-import           Clash.Signal.Bundle   (Bundle (..))+import           Clash.Signal.Bundle+  (Bundle (..), EmptyTuple(..), TaggedEmptyTuple(..)) import           Clash.Signal.BiSignal --(BisignalIn, BisignalOut, ) import           Clash.Signal.Internal hiding   (sample, sample_lazy, sampleN, sampleN_lazy, simulate, simulate_lazy, testFor) import           Clash.Signal.Internal.Ambiguous   (knownVDomain, clockPeriod, activeEdge, resetKind, initBehavior, resetPolarity)-import qualified Clash.Signal.Internal as S import           Clash.XException      (NFDataX)  {- $setup

@@ -83,19 +83,15 @@ @ -} -{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE GADTs                  #-}-{-# LANGUAGE InstanceSigs           #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE MagicHash              #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif@@ -116,14 +112,15 @@  import           Data.Kind                  (Type) import           Data.List                  (intercalate)-import           Data.Maybe                 (fromMaybe,fromJust,isJust)+import           Data.Maybe                 (fromMaybe,isJust) +import           Clash.Class.HasDomain import           Clash.Class.BitPack        (BitPack (..)) import           Clash.Sized.BitVector      (BitVector) import qualified Clash.Sized.Vector         as V import           Clash.Sized.Vector         (Vec) import           Clash.Signal.Internal      (Signal(..), Domain, head#, tail#)-import           Clash.XException           (errorX)+import           Clash.XException           (errorX, fromJustX)  import           GHC.TypeLits               (KnownNat, Nat) import           GHC.Stack                  (HasCallStack)@@ -167,6 +164,9 @@ newtype BiSignalOut (ds :: BiSignalDefault) (dom :: Domain) (n :: Nat)   = BiSignalOut [Signal dom (Maybe (BitVector n))] +type instance HasDomain dom1 (BiSignalOut ds dom2 n) = DomEq dom1 dom2+type instance TryDomain t (BiSignalOut ds dom n) = 'Found dom+ #if MIN_VERSION_base(4,11,0) instance Semigroup (BiSignalOut defaultState dom n) where   (BiSignalOut b1) <> (BiSignalOut b2) = BiSignalOut (b1 ++ b2)@@ -207,7 +207,6 @@ -- | Read the value from an __inout__ port readFromBiSignal   :: ( HasCallStack-     , KnownNat (BitSize a)      , BitPack a)   => BiSignalIn ds d (BitSize a)   -- ^ A 'BiSignalIn' with a number of bits needed to represent /a/@@ -250,7 +249,7 @@     input     (fmap pack <$> writes)     (isJust <$> writes)-    (pack . fromJust <$> writes)+    (pack . fromJustX <$> writes) {-# INLINE writeToBiSignal #-}  -- | Converts the 'out' part of a BiSignal to an 'in' part. In simulation it

@@ -1,34 +1,39 @@ {-| Copyright  :  (C) 2013-2016, University of Twente,                   2017-2019, Myrtle Software Ltd, Google Inc.+                       2019, QBayLogic B.V. License    :  BSD2 (see the file LICENSE) Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>  The Product/Signal isomorphism -} -{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE DefaultSignatures      #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE MagicHash              #-}-{-# LANGUAGE TemplateHaskell        #-}-{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators          #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif  {-# LANGUAGE Trustworthy #-} +--{-# OPTIONS_GHC -ddump-splices #-} {-# OPTIONS_HADDOCK show-extensions #-}  module Clash.Signal.Bundle   ( Bundle (..)+  -- ** Tools to emulate pre Clash 1.0 @Bundle ()@ instance+  , EmptyTuple(..)+  , TaggedEmptyTuple(..)+  -- ** Internal+  , vecBundle#   ) where +import Data.Functor.Compose+import GHC.Generics import GHC.TypeLits                 (KnownNat) import Prelude                      hiding (head, map, tail) @@ -67,11 +72,25 @@ -- data D = A | B -- -- instance Bundle D where---   type 'Unbundled'' clk D = 'Signal'' clk D---   'bundle'   _ s = s---   'unbundle' _ s = s+--   type 'Unbundled' clk D = 'Signal' clk D+--   'bundle'   s = s+--   'unbundle' s = s -- @ --+-- For custom product types you'll have to write the instance manually:+-- @+-- data Pair a b = MkPair { getA :: a, getB :: b }+--+-- instance Bundle (Pair a b) where+--   type Unbundled dom (Pair a b) = Pair (Signal dom a) (Signal dom b)+--+--   -- bundle :: Pair (Signal dom a) (Signal dom b) -> Signal dom (Pair a b)+--   bundle   (MkPair as bs) = MkPair <$> as <*> bs+--+--   -- unbundle :: Signal dom (Pair a b) -> Pair (Signal dom a) (Signal dom b)+--   unbundle pairs = MkPair (getA <$> pairs) (getB <$> pairs)+-- @+ class Bundle a where   type Unbundled (dom :: Domain) a = res | res -> dom a   type Unbundled dom a = Signal dom a@@ -143,3 +162,49 @@   type Unbundled t (RTree d a) = RTree d (Signal t a)   bundle   = sequenceA   unbundle = sequenceA . fmap lazyT++instance Bundle ((f :*: g) a) where+  type Unbundled t ((f :*: g) a) = (Compose (Signal t) f :*: Compose (Signal t) g) a+  bundle (Compose l :*: Compose r) = (:*:) <$> l <*> r+  unbundle s = Compose (getL <$> s) :*: Compose (getR <$> s)+   where+    getL (l :*: _) = l+    getR (_ :*: r) = r++-- | See "TaggedEmptyTuple"+data EmptyTuple = EmptyTuple++-- | Helper type to emulate the "old" behavior of Bundle's unit instance. I.e.,+-- the instance for @Bundle ()@ used to be defined as:+--+--     class Bundle () where+--       bundle   :: () -> Signal domain ()+--       unbundle :: Signal domain () -> ()+--+-- In order to have sensible type inference, the "Bundle" class specifies that+-- the argument type of 'bundle' should uniquely identify the result type, and+-- vice versa for 'unbundle'. The type signatures in the snippet above don't+-- though, as @()@ doesn't uniquely map to a specific domain. In other words,+-- 'domain' should occur in both the argument and result of both functions.+--+-- "TaggedEmptyTuple" tackles this by carrying the domain in its type. The+-- 'bundle' and 'unbundle' instance now looks like:+--+--     class Bundle EmptyTuple where+--       bundle   :: TaggedEmptyTuple domain -> Signal domain EmptyTuple+--       unbundle :: Signal domain EmptyTuple -> TaggedEmptyTuple domain+--+-- @domain@ is now mentioned both the argument and result for both 'bundle' and+-- 'unbundle'.+data TaggedEmptyTuple (dom :: Domain) = TaggedEmptyTuple++-- | See https://github.com/clash-lang/clash-compiler/pull/539/commits/94b0bff5770aa4961e04ddce2515130df3fc7863+-- and documentation for "TaggedEmptyTuple".+instance Bundle EmptyTuple where+  type Unbundled dom EmptyTuple = TaggedEmptyTuple dom++  bundle :: TaggedEmptyTuple dom -> Signal dom EmptyTuple+  bundle TaggedEmptyTuple = pure EmptyTuple++  unbundle :: Signal dom EmptyTuple -> TaggedEmptyTuple dom+  unbundle s = seq s TaggedEmptyTuple

@@ -1,14 +1,28 @@-{-# LANGUAGE CPP             #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}  module Clash.Signal.Bundle.Internal where -import           Clash.CPP             (maxTupleSize)-import           Clash.Signal.Internal (Signal)-import           Control.Monad         (replicateM)-import           Data.List             (foldl')+import           Control.Monad               (liftM)+import           Clash.Annotations.Primitive (Primitive(InlinePrimitive))+import           Clash.CPP                   (maxTupleSize)+import           Clash.Signal.Internal       (Signal((:-)))+import           Clash.XException            (seqX)+import           Data.List                   (foldl')+import qualified Language.Haskell.TH.Syntax  as TH import           Language.Haskell.TH +idPrimitive :: TH.Name -> DecQ+idPrimitive nm =+  PragmaD . AnnP (ValueAnnotation nm) <$> TH.liftData ip+ where+  ipJson = "[{\"Primitive\": {\"name\": \"" ++ show nm ++ "\", \"primType\": \"Function\"}}]"+  ip = InlinePrimitive [minBound..maxBound] ipJson++-- | Monadic version of concatMap+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat (mapM f xs)+ -- | Contruct all the tuple instances for Bundle. deriveBundleTuples   :: Name@@ -24,69 +38,130 @@   let bundleTy = ConT bundleTyName       signal   = ConT ''Signal -  allNames <- replicateM maxTupleSize (newName "a")-  tempNames <- replicateM maxTupleSize (newName "b")-  t <- newName "t"-  x <- newName "x"-  tup <- newName "tup"+      aNamesAll = map (\i -> mkName ('a':show i)) [1..maxTupleSize::Int]+      aPrimeNamesAll = map (\i -> mkName ('a':show i++"'")) [1..maxTupleSize::Int]+      asNamesAll = map (\i -> mkName ("as" <> show i)) [1..maxTupleSize::Int]+      tNm = mkName "t"+      sTailNm = mkName "sTail"+      sNm = mkName "s" -  pure $ flip map [2..maxTupleSize] $ \tupleNum ->-    let names = take tupleNum allNames-        temps = take tupleNum tempNames-        vars  = fmap VarT names-        tuple = foldl' AppT (TupleT tupleNum)+  flip concatMapM [2..maxTupleSize] $ \tupleNum ->+    let aNames = take tupleNum aNamesAll+        aPrimeNames = take tupleNum aPrimeNamesAll+        asNames = take tupleNum asNamesAll+        vars  = fmap VarT aNames +        bundlePrimName = mkName ("bundle" ++ show tupleNum ++ "#")+        unbundlePrimName = mkName ("unbundle" ++ show tupleNum ++ "#")+        qualBundleNm = mkName ("Clash.Signal.Bundle.bundle" ++ show tupleNum ++ "#")+        qualUnbundlePrimName = mkName ("Clash.Signal.Bundle.unbundle" ++ show tupleNum ++ "#")++        mkTupleT = foldl' AppT (TupleT tupleNum)+         -- Instance declaration-        instTy = AppT bundleTy $ tuple vars+        instTy = AppT bundleTy $ mkTupleT vars          -- Associated type Unbundled #if MIN_VERSION_template_haskell(2,15,0)         unbundledTypeEq =           TySynEqn Nothing             ((ConT unbundledTyName `AppT`-                VarT t ) `AppT` tuple vars )-            $ tuple $ map (AppT (signal `AppT` VarT t)) vars+                VarT tNm ) `AppT` mkTupleT vars )+            $ mkTupleT $ map (AppT (signal `AppT` VarT tNm)) vars         unbundledType = TySynInstD unbundledTypeEq #else         unbundledTypeEq =           TySynEqn-            [ VarT t, tuple vars ]-            $ tuple $ map (AppT (signal `AppT` VarT t)) vars+            [ VarT tNm, mkTupleT vars ]+            $ mkTupleT $ map (AppT (signal `AppT` VarT tNm)) vars         unbundledType = TySynInstD unbundledTyName unbundledTypeEq #endif -        bundleLambda = LamE (map VarP temps) (TupE $ map VarE temps)-        applicatives = VarE '(<$>) : repeat (VarE '(<*>))-        bundle =+        mkFunD nm alias = FunD nm [Clause [] (NormalB (VarE alias)) []]+        bundleD = mkFunD bundleName bundlePrimName+        unbundleD = mkFunD unbundleName unbundlePrimName++        sigType t = ConT ''Signal `AppT` VarT (mkName "dom") `AppT` t++        -- unbundle3# ~s@((a, b, c) :- abcs) =+        --   let (as, bs, cs) = s `seq` unbundle3# abcs in+        --   (a :- as, b :- bs, c :- cs)+        unbundleNoInlineAnn = PragmaD (InlineP unbundlePrimName NoInline FunLike AllPhases)++        unbundleSig = SigD unbundlePrimName (+          mkFunTys+            [mkTupleT (map sigType (map VarT aNames))]+            (sigType (mkTupleT (map VarT aNames)))+          )++        seqE nm res = UInfixE (VarE nm) (VarE 'seq) res+        seqXE nm res = UInfixE (VarE nm) (VarE 'seqX) res++        unbundleFBody =+          LetE+            [ ValD+                (TupP (map VarP asNames))+                (NormalB (+                  tNm `seqXE` (sNm `seqE` (VarE unbundlePrimName `AppE` VarE sTailNm)))) []]+            (TupE+              (zipWith+                (\a as -> UInfixE (VarE a) (ConE '(:-)) (VarE as))+                aNames+                asNames))++        unbundleF =           FunD-            bundleName-            [ Clause-                [ TupP $ map VarP names ]-                ( NormalB-                $ foldl'-                    (\f (a, b) -> a `AppE` f `AppE` b)-                    bundleLambda-                    (zip applicatives $ map VarE names)-                )-                []-            ]+            unbundlePrimName+            [Clause+              [AsP sNm (TildeP (UInfixP+                                 (AsP tNm (TildeP (TupP (map VarP aNames))))+                                 '(:-)+                                 (VarP sTailNm)))]+              (NormalB unbundleFBody)+              [] ] -        unbundleLambda n =-          LamE-            [ TupP [ if i == n then VarP x else WildP | i <- [0..tupleNum-1] ] ]-            (VarE x)+        -- bundle2# (a1, a2) = (\ a1' a2' -> (a1', a2')) <$> a1 <*> a2+        bundleNoInlineAnn = PragmaD (InlineP bundlePrimName NoInline FunLike AllPhases) -        unbundle =+        bundleSig = SigD bundlePrimName (+          mkFunTys+            [sigType (mkTupleT (map VarT aNames))]+            (mkTupleT (map sigType (map VarT aNames)))+          )++        bundleFmap =+          UInfixE+            (LamE (map VarP aPrimeNames) (TupE (map VarE aPrimeNames)))+            (VarE '(<$>))+            (VarE (head aNames))++        bundleFBody =+          foldl'+            (\e n -> UInfixE e (VarE '(<*>)) (VarE n))+            bundleFmap+            (tail aNames)++        bundleF =           FunD-            unbundleName-            [ Clause-                [ VarP tup ]-                ( NormalB . TupE $-                    map-                      (\n -> VarE 'fmap `AppE` unbundleLambda n `AppE` VarE tup)-                      [0..tupleNum-1]-                )-                []-            ]+            bundlePrimName+            [Clause+              [TupP (map VarP aNames)]+              (NormalB bundleFBody)+              [] ]+    in do+      unbundlePrimAnn <- idPrimitive qualUnbundlePrimName+      bundlePrimAnn <- idPrimitive qualBundleNm+      pure [ -- Instance and its methods+             InstanceD Nothing [] instTy [unbundledType, bundleD, unbundleD] -    in InstanceD Nothing [] instTy [unbundledType, bundle, unbundle]+             -- Bundle primitive+           , bundleSig, bundleF, bundlePrimAnn, bundleNoInlineAnn++             -- Unbundle primitive+           , unbundleSig, unbundleF, unbundlePrimAnn, unbundleNoInlineAnn+           ]++mkFunTys :: Foldable t => t Type -> Type -> Type+mkFunTys args res= foldl' go res args+ where+  go l r = AppT (AppT ArrowT l) r

@@ -6,25 +6,18 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} -{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE KindSignatures       #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeApplications     #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE NoStarIsType #-}-#endif+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif -{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} -{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise       #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}  module Clash.Signal.Delayed   ( -- * Delay-annotated synchronous signals@@ -48,23 +41,19 @@   ) where -import           Data.Coerce                   (coerce)-import           Data.Kind                     (Type)-import           Data.Proxy                    (Proxy(..)) import           GHC.TypeLits-  (KnownNat, type (^), type (+), type (*), Nat)-import           Data.Singletons.Prelude       (Apply, TyFun, type (@@))+  (KnownNat, type (^), type (+), type (*)) -import           Clash.Signal.Internal         (Domain) import Clash.Signal.Delayed.Internal   (DSignal(..), dfromList, dfromList_lazy, fromSignal, toSignal,    unsafeFromSignal, antiDelay, feedback) import qualified Clash.Explicit.Signal.Delayed as E-import           Clash.Sized.Vector            (Vec, dtfold)+import           Clash.Sized.Vector            (Vec) import           Clash.Signal-  (HiddenClockResetEnable , hideClockResetEnable, Signal, delay)+  (HiddenClock, HiddenClockResetEnable, HiddenEnable, hideClock,+   hideClockResetEnable, hideEnable) -import           Clash.Promoted.Nat            (SNat (..), snatToInteger)+import           Clash.Promoted.Nat            (SNat (..)) import           Clash.XException              (NFDataX)  {- $setup@@ -135,29 +124,27 @@ -- | Delay a 'DSignal' for @d@ cycles, the value at time 0..d-1 is /a/. -- -- @--- delay2+-- delayN2 --   :: HiddenClockResetEnable dom --   => Int --   -> 'DSignal' dom n Int --   -> 'DSignal' dom (n + 2) Int--- delay2 = 'delayN' d2+-- delayN2 = 'delayN' d2 -- @ -- -- >>> printX $ sampleN @System 6 (toSignal (delayN2 (-1) (dfromList [1..]))) -- [-1,-1,1,2,3,4] delayN   :: forall dom  a d n-   . ( HiddenClockResetEnable dom+   . ( HiddenClock dom+     , HiddenEnable dom      , NFDataX a )   => SNat d   -> a   -- ^ Initial value   -> DSignal dom n a   -> DSignal dom (n+d) a-delayN d dflt = coerce . go (snatToInteger d) . coerce @_ @(Signal dom a)-  where-    go 0 = id-    go i = delay dflt . go (i-1)+delayN d dflt = hideClock (hideEnable (E.delayN d dflt))  -- | Delay a 'DSignal' for @d@ cycles, where @d@ is derived from the context. -- The value at time 0..d-1 is a default value.@@ -188,9 +175,6 @@   -> DSignal dom (n+d) a delayI dflt = delayN (SNat :: SNat d) dflt -data DelayedFold (dom :: Domain) (n :: Nat) (delay :: Nat) (a :: Type) (f :: TyFun Nat Type) :: Type-type instance Apply (DelayedFold dom n delay a) k = DSignal dom (n + (delay*k)) a- -- | Tree fold over a 'Vec' of 'DSignal's with a combinatorial function, -- and delaying @delay@ cycles after each application. -- Values at times 0..(delay*k)-1 are set to a default.@@ -207,7 +191,8 @@ -- [-1,-1,1,1,0,1,16,81] delayedFold   :: forall dom  n delay k a-   . ( HiddenClockResetEnable dom+   . ( HiddenClock dom+     , HiddenEnable dom      , NFDataX a      , KnownNat delay      , KnownNat k )@@ -221,10 +206,4 @@   -- ^ Vector input of size 2^k   -> DSignal dom (n + (delay * k)) a   -- ^ Output Signal delayed by (delay * k)-delayedFold _ dflt op = dtfold (Proxy :: Proxy (DelayedFold dom n delay a)) id go-  where-    go :: SNat l-       -> DelayedFold dom n delay a @@ l-       -> DelayedFold dom n delay a @@ l-       -> DelayedFold dom n delay a @@ (l+1)-    go SNat x y = delayI dflt (op <$> x <*> y)+delayedFold d dflt f = hideClock (hideEnable (E.delayedFold d dflt f))

@@ -5,25 +5,22 @@   License     :  BSD2 (see the file LICENSE)   Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com> -}-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE DefaultSignatures      #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE NoImplicitPrelude      #-}-{-# LANGUAGE PolyKinds              #-}-{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators          #-}+ #if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif  module Clash.Signal.Delayed.Bundle (-  Bundle,-  Unbundled,-  bundle,-  unbundle,+    Bundle(..)+  -- ** Tools to emulate pre Clash 1.0 @Bundle ()@ instance+  , B.EmptyTuple(..)+  , TaggedEmptyTuple(..)   ) where  import           Control.Applicative           (liftA2)@@ -69,9 +66,9 @@ -- data D = A | B -- -- instance Bundle D where---   type 'Unbundled' dom delay D = 'DSignal' dom d D---   'bundle'   _ s = s---   'unbundle' _ s = s+--   type 'Unbundled' dom delay D = 'DSignal' dom delay D+--   'bundle'   s = s+--   'unbundle' s = s -- @ -- class Bundle a where@@ -222,3 +219,17 @@   type Unbundled t delay (RTree d a) = RTree d (DSignal t delay a)   bundle   = sequenceA   unbundle = sequenceA . fmap lazyT++-- | Same as "Clash.Signal.Bundle.TaggedEmptyTuple", but adapted for "DSignal".+data TaggedEmptyTuple (dom :: Domain) (d :: Nat) = TaggedEmptyTuple++-- | See https://github.com/clash-lang/clash-compiler/pull/539/commits/94b0bff5770aa4961e04ddce2515130df3fc7863+-- and documentation for "TaggedEmptyTuple".+instance Bundle B.EmptyTuple where+  type Unbundled dom d B.EmptyTuple = TaggedEmptyTuple dom d++  bundle :: TaggedEmptyTuple dom d -> DSignal dom d B.EmptyTuple+  bundle TaggedEmptyTuple = pure B.EmptyTuple++  unbundle :: DSignal dom d B.EmptyTuple -> TaggedEmptyTuple dom d+  unbundle s = seq s TaggedEmptyTuple