clash-prelude-1.8.1/0000755000000000000000000000000007346545000012442 5ustar0000000000000000clash-prelude-1.8.1/AUTHORS.md0000755000000000000000000000026007346545000014112 0ustar0000000000000000See [GitHub contributors statistics](https://github.com/clash-lang/clash-compiler/graphs/contributors) and [clash-lang.org/publications](https://clash-lang.org/publications/). clash-prelude-1.8.1/CHANGELOG.md0000755000000000000000000026574707346545000014303 0ustar0000000000000000# Changelog for the Clash project ## 1.8.1 *Nov 10th 2023* * Bump package dependencies to allow inclusion in stackage-nightly * Bump package dependencies to allow building on GHC 9.8.1 ## 1.8.0 *Nov 10th 2023* Release highlights: * Support for GHC 9.2, 9.4, 9.6 and 9.8. While GHC 9.2 is supported, we recommend users to skip this version as there is a severe degradation of error message quality. With this change, Clash now supports GHC versions 8.6 through 9.8. * Major overhaul of the clocking functionality in `Clash.Xilinx.ClockGen` and `Clash.Intel.ClockGen`, see their respective entries below * `mealyS` function (and several variations) to make writing state machines using the strict `State` monad easier * Overhaul of `resetGlitchFilter`, see its respective entries below. Added: * `altpllSync` and `alteraPllSync` in `Clash.Intel.ClockGen`. These replace the deprecated functions without the `Sync` suffix. Unlike the old functions, these functions are safe to use and have a reset signal for each output domain that can be used to keep the domain in reset while the clock output stabilizes. All PLL functions now also support multiple clock outputs like the old `alteraPll` did. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * A new clock type `DiffClock` is introduced to signify a differential clock signal that is passed to the design on two ports in antiphase. This is used by the differential Xilinx clock wizards in `Clash.Xilinx.ClockGen`. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * `Clash.Explicit.Testbench.clockToDiffClock`, to create a differential clock signal in a test bench. It is not suitable for synthesizing a differential output in hardware. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * `resetGlitchFilterWithReset`, which accomplishes the same task as `resetGlitchFilter` in domains with unknown initial values by adding a power-on reset input to reset the glitch filter itself. [#2544](https://github.com/clash-lang/clash-compiler/pull/2544) * Convenience functions: `noReset`, `andReset`, `orReset` plus their unsafe counterparts [#2539](https://github.com/clash-lang/clash-compiler/pull/2539) * Convenience constraint aliases: `HasSynchronousReset`, `HasAsynchronousReset`, and `HasDefinedInitialValues` [#2539](https://github.com/clash-lang/clash-compiler/pull/2539) * `Clash.Prelude.Mealy.mealyS` and `Clash.Explicit.Mealy.mealyS` and their bundled equivalents `mealySB` which make writing state machines using the strict `State` monad easier. The tutorial has also been simplified by using this change. [#2484](https://github.com/clash-lang/clash-compiler/pull/2484) * An experimental feature allowing clocks to vary their periods over time, called "dynamic clocks". Given that this is an experimental feature, it is not part of the public API. [#2295](https://github.com/clash-lang/clash-compiler/pull/2295) * The prelude now exports `+>>.` and `.<<+`, which can be used to shift in a bit into a `BitVector` from the left or right respectively - similar to `+>>` and `<<+` for `Vec`s. [#2307](https://github.com/clash-lang/clash-compiler/pull/2307) * `Clash.DataFiles.tclConnector` and the executable `static-files` in `clash-lib`. They provide the Tcl Connector, a Tcl script that allows Vivado to interact with the metadata generated by Clash (Quartus support will be added later). See `Clash.DataFiles.tclConnector` for further information. More documentation about the Tcl Connector and the Clash<->Tcl API will be made available later. [#2335](https://github.com/clash-lang/clash-compiler/pull/2335) * Add `BitPack`, `NFDataX` and `ShowX` instances for `Ordering` [#2366](https://github.com/clash-lang/clash-compiler/pull/2366) * Verilog users can now influence the "precision" part of the generated `timescale` pragma using `-fclash-timescale-precision`. [#2353](https://github.com/clash-lang/clash-compiler/pull/2353) * Clash now includes blackboxes for `integerToFloat#`, `integerToDouble#` [#2342](https://github.com/clash-lang/clash-compiler/issues/2342) * Instances `Arbitrary (Erroring a)`, `Arbitrary (Saturating a)`, `Arbitrary (Saturating a)`, and `Arbitrary (Zeroing a)` [#2356](https://github.com/clash-lang/clash-compiler/pull/2356) * `Clash.Magic.clashSimulation`, a way to differentiate between Clash simulation and generating HDL. [#2473](https://github.com/clash-lang/clash-compiler/pull/2473) * `Clash.Magic.clashCompileError`: make HDL generation error out with a custom error message. Simulation in Clash will also error when the function is evaluated, including a call stack. HDL generation unfortunately does not include a call stack. [#2399](https://github.com/clash-lang/clash-compiler/pull/2399) * Added `Clash.XException.MaybeX`, a data structure with smart constructors that can help programmers deal with `XException` values in their blackbox model implementations [#2442](https://github.com/clash-lang/clash-compiler/pull/2442) * `Clash.Magic.SimOnly`, A container for data you only want to have around during simulation and is ignored during synthesis. Useful for carrying around things such as: a map of simulation/vcd traces, co-simulation state or meta-data, etc. [#2464](https://github.com/clash-lang/clash-compiler/pull/2464) * `KnownNat (DomainPeriod dom)` as an implied constraint to `KnownDomain dom`. This reduces the amount of code needed to write - for example - clock speed dependent code. [#2541](https://github.com/clash-lang/clash-compiler/pull/2541) * `Clash.Annotations.SynthesisAttributes.annotate`: a term level way of annotating signals with synthesis attributes [#2547](https://github.com/clash-lang/clash-compiler/pull/2547) * `Clash.Annotations.SynthesisAttributes.markDebug`: a way of marking a signals "debug", instructing synthesizers to leave the signal alone and offer debug features [#2547](https://github.com/clash-lang/clash-compiler/pull/2547) * Add hex and octal BitVector parsing. [#1772](https://github.com/clash-lang/clash-compiler/pull/2505) * `1 <= n => Foldable1 (Vec n)` instance (`base-4.18+` only) [#2563](https://github.com/clash-lang/clash-compiler/pull/2563) * You can now use `~PERIOD`, `~ISSYNC`, `~ISINITDEFINED` and `~ACTIVEEDGE` on arguments of type `Clock`, `Reset`, `Enable`,`ClockN` and `DiffClock`. [#2590](https://github.com/clash-lang/clash-compiler/pull/2590) Removed: * Deprecated module `Clash.Prelude.BitIndex`: functions have been moved to `Clash.Class.BitPack` [#2555](https://github.com/clash-lang/clash-compiler/pull/2555) * Deprecated module `Clash.Prelude.BitReduction`: functions have been moved to `Clash.Class.BitPack` [#2555](https://github.com/clash-lang/clash-compiler/pull/2555) * Deprecated function `Clash.Explicit.Signal.enable`: function has been renamed to `andEnable` [#2555](https://github.com/clash-lang/clash-compiler/pull/2555) * The module `Clash.Clocks.Deriving` has been removed. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) Deprecated: * `unsafeFromLowPolarity`, `unsafeFromHighPolarity`, `unsafeToLowPolarity`, `unsafeToHighPolarity` have been replaced by `unsafeFromActiveLow`, `unsafeFromActiveHigh`, `unsafeToActiveLow`, `unsafeToActiveHigh`. While former ones will continue to exist, a deprecation warning has been added pointing to the latter ones. [#2540](https://github.com/clash-lang/clash-compiler/pull/2540) * The functions `altpll` and `alteraPll` in `Clash.Intel.ClockGen` have been deprecated because they are unsafe to use while this is not apparent from the name. The `locked` output signal of these functions is an asynchronous signal which needs to be synchronized before it can be used (something the examples did in fact demonstrate). For the common use case, new functions are available, named `altpllSync` and `alteraPllSync`. These functions are safe. For advanced use cases, the old functionality can be obtained through `unsafeAltpll` and `unsafeAlteraPll`. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) Changed: * The wizards in `Clash.Xilinx.ClockGen` have been completely overhauled. The original functions were unsafe and broken in several ways. See the documentation in `Clash.Xilinx.ClockGen` for how to use the new functions. Significant changes are: * `clockWizard` and `clockWizardDifferential` now output a `Clock` and a `Reset` which can be directly used by logic. Previously, it outputted a clock and an asynchronous `locked` signal which first needed to be synchronized before it could be used (hence the old function being unsafe). Additionally, the original `locked` signal was strange: it mistakenly was an `Enable` instead of a `Signal dom Bool` and there was a polarity mismatch between Clash simulation and HDL. The `locked` signal was also not resampled to the output domain in Clash simulation. * There are new functions `unsafeClockWizard` and `unsafeClockWizardDifferential` for advanced use cases which directly expose the `locked` output of the wizard. * All clock generators now have the option to output multiple clocks from a single instance. * `clockWizardDifferential` now gets its input clock as a `DiffClock` type; use `clockToDiffClock` to generate this in your test bench if needed. Previously, the function received two clock inputs, but this generated `create_clock` statements in the top-level SDC file for both phases which is incorrect. * A constraint was removed: The _output_ clock domain no longer requires asynchronous resets. This was originally intended to signal that the outgoing lock signal is an asynchronous signal. The constraint does not convey this information at all and is wrong; it also prevents using synchronous resets in the circuit as recommended by Xilinx. Note that if you use the `unsafe` functions, it is still necessary to synchronize the `locked` output in your design. * The port names of the primitives in HDL are now correctly lower case. * Add Tcl generation. This moves the responsibility of MMCM component generation from the user to `clashConnector.tcl`, which can be found in [`clash-lib:Clash.DataFiles`](https://hackage.haskell.org/package/clash-lib-1.8.0/docs/Clash-DataFiles.html). * The wizards now use the user-provided name as the name of the _instance_ rather than the name of the _IP core_. This change was also done for `Clash.Intel.ClockGen` in Clash v1.2.0 in March 2020, when Clash started generating Intel Qsys files. Before that, the user needed to generate a Qsys component manually. Now, in Clash v1.8.0, we also generate the Tcl for Xilinx wizards. When the user is responsible for creating the IP core, it makes sense to always set the component name to the user-provided value. But when that is also generated by Clash, that is no longer needed. Allowing users to set the instance name instead makes it possible to match on the instance in SDC files and such. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * The IP core generators in `Clash.Intel.ClockGen` now declare that their input domain needs to have asynchronous resets (`HasAsynchronousReset`), as the functions react asynchronously to their reset input and thus need to be glitch-free. The functions marked `unsafe` do not have this constraint; instead, the function documentation calls attention to the requirement. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * `resetGlitchFilter` now uses a counter instead of shift register, allowing glitch filtering over much larger periods. [#2374](https://github.com/clash-lang/clash-compiler/pull/2374) * `resetGlitchFilter` now filters glitches symmetrically, only deasserting the reset after the incoming reset has stabilized. For more information, read [#2374](https://github.com/clash-lang/clash-compiler/pull/2374). * `resetGlitchFilter` does not support domains with unknown initial values anymore. Its previous behavior could lead to unstable circuits. Domains not supporting initial values should consider using `resetGlitchFilterWithReset` or `holdReset`. The previous behavior can still be attained through the new `unsafeResetGlitchFilter`. [#2544](https://github.com/clash-lang/clash-compiler/pull/2544) * `fromJustX` now uses `deepErrorX` instead of `errorX`. This adds `NFDataX` constraints to `blockRam` like functions, `asyncRam` and `writeToBiSignal`. [#2113](https://github.com/clash-lang/clash-compiler/pull/2113) * All memory functions now use `deepErrorX` for `XException`s. This adds `NFDataX` constraints to `asyncRom`, `asyncRomPow2` and `asyncRom#`. [#2113](https://github.com/clash-lang/clash-compiler/pull/2113) * Before this release, `scanl1` was re-exported from the Haskell Prelude. Clash's Prelude now exports a `Vec` specialized version. [#2172](https://github.com/clash-lang/clash-compiler/pull/2172) * When generating (System)Verilog, Clash now sets the default net type to `none`. This means any implicitly declared signal in the design will trigger an error when elaborating the design. [#2174](https://github.com/clash-lang/clash-compiler/pull/2174) * Blackbox templates no longer have the `outputReg` key, it has been replaced with the more general `outputUsage` which specifies how signals are used in terms of whether writes are * continuous (i.e. a concurrent context) * procedural non-blocking (i.e. `signal` in a VHDL process) * procedural blocking (i.e. `variable` in a VHDL process) The `~OUTPUTWIREREG` tag continues to work for backwards compatibility, but there is also a new `~OUTPUTUSAGE` tag which is recommended. In the future, the `~OUTPUTWIREREG` tag may be removed. [#2230](https://github.com/clash-lang/clash-compiler/pull/2230) * `Clash.Explicit.Testbench.outputVerifier` now takes an additional clock as an argument: the clock used by the circuit under test. If your tests use the same domain for the test circuit and design under test, consider using `Clash.Explicit.Testbench.outputVerifier'`. [#2295](https://github.com/clash-lang/clash-compiler/pull/2295) * `Clash.Explicit.Signal.veryUnsafeSynchronizer` now accepts either a static clock period or a dynamic one. If you don't use dynamic clocks, convert your calls to use `Left`. [#2295](https://github.com/clash-lang/clash-compiler/pull/2295) * `SDomainConfiguration` is now a record, easing field access. [#2349](https://github.com/clash-lang/clash-compiler/pull/2349) * Generalized the return types of `periodToHz` and `hzToPeriod`. Use a type application (`periodToHz @(Ratio Natural)`, `hzToPeriod @Natural`) to get the old behavior back, in case type errors arise. [#2436](https://github.com/clash-lang/clash-compiler/pull/2436) * `periodToHz` and `hzToPeriod` now throw an `ErrorCall` with call stack when called with the argument 0 (zero), instead of a `RatioZeroDenominator :: ArithException`. [#2436](https://github.com/clash-lang/clash-compiler/pull/2436) * `hasX` now needs an `NFDataX` constraint, in addition to an `NFData` one. This API change was made to fix an issue where `hasX` would hide error calls in certain situations, see [#2450](https://github.com/clash-lang/clash-compiler/issues/2450). * Clock generators now wait at least 100 ns before producing their first tick. This change has been implemented to account for Xilinx's GSR in clock synchronization primitives. This change does not affect Clash simulation. See [#2455](https://github.com/clash-lang/clash-compiler/issues/2455). * From GHC 9.4.1 onwards the following types: `BiSignalOut`, `Index`, `Signed`, `Unsigned`, `File`, `Ref`, and `SimIO` are all encoded as `newtype` instead of `data` now that [#2511](https://github.com/clash-lang/clash-compiler/pull/2511) is merged. This means you can once again use `Data.Coerce.coerce` to coerce between these types and their underlying representation. [#2535](https://github.com/clash-lang/clash-compiler/pull/2535) * The `Foldable (Vec n)` instance and `Traversable (Vec n)` instance no longer have the `1 <= n` constraint. `Foldable.{foldr1,foldl1,maximum,minimum}` functions now throw an error at run-/simulation-time, and also at HDL-generation time, for vectors of length zero. [#2563](https://github.com/clash-lang/clash-compiler/pull/2563) * The `maximum` and `minimum` functions exported by `Clash.Prelude` work on non-empty vectors, instead of the more generic version from `Data.Foldable`. [#2563](https://github.com/clash-lang/clash-compiler/pull/2563) * `unsafeToReset` and `invertReset` now have a KnownDomain constraint This was done in preparation for [Remove KnownDomain #2589](https://github.com/clash-lang/clash-compiler/pull/2589) Fixed: * `altpll` and `alteraPll` in `Clash.Intel.ClockGen` now account for the input domain's `ResetPolarity`. Before this fix, the reset was always interpreted as an active-high signal. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) * Fix `alteraPll` `qsys` generation. PR [#2417](https://github.com/clash-lang/clash-compiler/pull/2417) (included in Clash v1.6.5) caused a bug in the generation of the `qsys` file: it generated a spurious extra output clock which was completely unused otherwise. [#2587](https://github.com/clash-lang/clash-compiler/pull/2587) * Files in `clash-manifest.json` are now (correctly) listed in reverse topological order [#2334](https://github.com/clash-lang/clash-compiler/issues/2334) * Dependencies in `clash-manifest.json` are now listed in reverse topological ordering [#2325](https://github.com/clash-lang/clash-compiler/issues/2325) * Clash now renders undefined bits set via `-fclash-force-undefined` correctly [#2360](https://github.com/clash-lang/clash-compiler/issues/2360) * `resetGen`'s documentation now mentions it is non-synthesizable ([#2375](https://github.com/clash-lang/clash-compiler/issues/2375)) * `trueDualPortBlockRam` now handles undefined values in its input correctly [#2350](https://github.com/clash-lang/clash-compiler/issues/2350) * `trueDualPortBlockRam` now correctly handles port enables when clock edges coincide [#2351](https://github.com/clash-lang/clash-compiler/issues/2351) * `Clash.Primitives.DSL.deconstructProduct` now projects fields out of a product [#2469](https://github.com/clash-lang/clash-compiler/issues/2469) * BiSignal test does not look through `Annotate` [#2472](https://github.com/clash-lang/clash-compiler/issues/2472) * Port size not rendered when type has more than one `Annotate` [#2475](https://github.com/clash-lang/clash-compiler/pull/2475) * Clash now preserves `NOINLINE` of functions being specialized [#2502](https://github.com/clash-lang/clash-compiler/issues/2502) * When `convertReset` was used with two domains that had a different reset polarity, the polarity of the signal was not changed. * Functional arguments of primitives cannot have 0-bit results [#2549](https://github.com/clash-lang/clash-compiler/issues/2549) * If the source reset of `convertReset` is synchronous, a flip-flop in the source domain is inserted to filter glitches from the source reset. [#2573](https://github.com/clash-lang/clash-compiler/pull/2573) * SystemVerilog backend: Assignment patterns for unpacked arrays now have an index for every element; improves QuestaSim compatibility. [#2595](https://github.com/clash-lang/clash-compiler/pull/2595) * Name duplication in generated Verilog involving reset synchronizer [#2598](https://github.com/clash-lang/clash-compiler/issues/2598) Internal added: * `Clash.Primitives.DSL.instDecl` now accepts `TExpr`s instead of `LitHDL`s as generics/parameters. This allows for VHDL black boxes to use all possible generic types. To ease transition, `litTExpr` has been added to `Clash.Primitives.DSL`. [#2471](https://github.com/clash-lang/clash-compiler/issues/2471) * `Clash.Core.TermLiteral.deriveTermToData` now works on records [#2270](https://github.com/clash-lang/clash-compiler/pull/2270) * `Clash.Primitives.getVec` tries to get all elements in a Vector from an expression [#2483](https://github.com/clash-lang/clash-compiler/pull/2483) * Added `Clash.Primitives.DSL.deconstructMaybe`. This DSL function makes it easy to deconstruct a `Maybe` into its constructor bit and data. This is often useful for primitives taking 'enable' and 'data' signals. [#2202](https://github.com/clash-lang/clash-compiler/pull/2202) * Added `unsafeToActiveHigh` and `unsafeToActiveLow` to `Clash.Primitives.DSL`. [#2270](https://github.com/clash-lang/clash-compiler/pull/2270) * Added `TermLiteral` instance for `Either` [#2329](https://github.com/clash-lang/clash-compiler/pull/2329) * `Clash.Primitives.DSL.declareN`, a companion to `declare` which declares multiple signals in one go. [#2592](https://github.com/clash-lang/clash-compiler/pull/2592) Internal changes: * `Clash.Primitives.DSL.boolFromBit` is now polymorphic in its HDL backend. [#2202](https://github.com/clash-lang/clash-compiler/pull/2202) * `Clash.Primitives.DSL.unsignedFromBitVector` is now polymorphic in its HDL backend. [#2202](https://github.com/clash-lang/clash-compiler/pull/2202) * `Clash.Primitives.DSL.fromBV` now converts some `BitVector` expression into some type. [#2202](https://github.com/clash-lang/clash-compiler/pull/2202) * Add `CompDecl` to `Clash.Netlist.Types.Declaration` to accomodate VHDL's `component` declarations. * Black box functions declare their usage, necessary for implicit netlist usage analysis implemented in [#2230](https://github.com/clash-lang/clash-compiler/pull/2230) * Added `showsTypePrec` to `TermLiteral` to make `TermLiteral SNat` work as expected. Deriving an instance is now a bit simpler. Instances which previously had to be defined as: ```haskell instance TermLiteral Bool where termToData = $(deriveTermToData ''Bool) ``` can now be defined using: ```haskell deriveTermLiteral ''Bool ``` [#2329](https://github.com/clash-lang/clash-compiler/pull/2329) ## 1.6.6 *Oct 2nd 2023* * Support Aeson 2.2 * Dropped the snap package The Clash snap package has not been a recommended way to use Clash for quite some time, and it is a hassle to support. In order to build a snap package, we build .deb packages for Clash with Ubuntu 20.04 LTS. But the interaction between the Debian build system and GHC is problematic, requiring significant effort to support and to upgrade to a more recent Ubuntu release. Additionally, snap packages have their own issues on distributions other than Ubuntu. Given that we no longer recommend people use our snap package and given the effort required to keep supporting them, we have decided to drop the snap package. ## 1.6.5 *Jun 27th 2023* Fixed: * Support building with all combinations of specific versions of our dependencies `hashable` and `primitive`. [#2485](https://github.com/clash-lang/clash-compiler/pull/2485) * The Haskell simulation of the PLL lock signal in `Clash.Clocks` (used by `Clash.Intel.ClockGen`) is fixed: the signal is now unasserted for the time the reset input is asserted and vice versa, and no longer crashes the simulation. HDL generation is unchanged. The PLL functions now have an additional constraint: `KnownDomain pllLock`. [#2420](https://github.com/clash-lang/clash-compiler/pull/2420) Changed: * Export the constructor for the `Wrapping` type in the `Clash.Num.Wrapping` module. See [#2292](https://github.com/clash-lang/clash-compiler/issues/2292) ## 1.6.4 *Aug 30th 2022* Fixed: * Input validation of the used arguments in blackboxes is now complete. [#2184](https://github.com/clash-lang/clash-compiler/pull/2184) * `Clash.Annotations.BitRepresentation.Deriving.deriveAnnotation` no longer has quadratic complexity in the size of the constructors and fields. [#2209](https://github.com/clash-lang/clash-compiler/pull/2209) * Fully resolve type synonyms when deriving bit representations. [#2209](https://github.com/clash-lang/clash-compiler/pull/2209) * Disregard ticks when determining whether terms are shared. Fixes [#2233](https://github.com/clash-lang/clash-compiler/issues/2233). * The blackbox parser will make sure it fully parses its input, and report an error when it can't. [#2237](https://github.com/clash-lang/clash-compiler/issues/2237) * Wrap ~ARG[n] in parentheses. Fixes [#2213](https://github.com/clash-lang/clash-compiler/issues/2213) * The VHDL shift primitives no longer generate bound check failures. Fixes [#2215](https://github.com/clash-lang/clash-compiler/issues/2215) * Evaluator fails impredicative type instantiation of error values [#2272](https://github.com/clash-lang/clash-compiler/issues/2272) * Fix out of bound errors in toEnum/fromSLV for sum types [#2220](https://github.com/clash-lang/clash-compiler/issues/2220) * Netlist generation fails for certain uses of GADTs [#2289](https://github.com/clash-lang/clash-compiler/issues/2289) * The documentation for `ANN TestBench` had it backwards; it now correctly indicates the annotation is on the test bench, not the device under test. [#1750](https://github.com/clash-lang/clash-compiler/issues/1750) Fixes with minor changes: * `reduceXor` now produces a result if the argument has undefined bits instead of throwing an `XException` (the result is an undefined bit). `reduceAnd` and `reduceOr` already always produced a result. [#2244](https://github.com/clash-lang/clash-compiler/pull/2244) Added: * Support for symbols in types while deriving bit representations. [#2209](https://github.com/clash-lang/clash-compiler/pull/2209) * Support for promoted data types while deriving bit representations. [#2209](https://github.com/clash-lang/clash-compiler/pull/2209) * `scanlPar` and `scanrPar` in Clash's Prelude, as well as the `RTree` versions `tscanl` and `tscanr`. These variants of `scanl1` and `scanr1` compile to a binary tree of operations, with a depth of `O(log(n))` (`n` being the length of the vector) rather than a depth of `n` for `scanl1` and `scanr1`. [#2177](https://github.com/clash-lang/clash-compiler/pull/2177) * The GADT constructors for `RTree` (`RLeaf` and `RBranch`) are now exported directly in addition to the patterns `LR` and `BR`. [#2177](https://github.com/clash-lang/clash-compiler/pull/2177) * Added the `~ISSCALAR` template which can be used to check if an argument is rendered to a scalar in HDL. [#2184](https://github.com/clash-lang/clash-compiler/pull/2184) * Added support for records and infix constructors when using `Clash.Annotations.BitRepresentation.Deriving.deriveAnnotation`. [#2191](https://github.com/clash-lang/clash-compiler/pull/2191) * Clash now contains instances for `ShowX`, `NFDataX` and `BitPack` on the newtypes from the Data.Functor modules (`Identity`, `Const`, `Compose`, `Product` and `Sum`). [#2218](https://github.com/clash-lang/clash-compiler/issues/2218) ## 1.6.3 *Apr 7th 2022* Fixed: * Handle `~ISUNDEFINED` hole in black boxes for `BitVector` and for product types. This means that with `-fclash-aggressive-x-optimization-blackboxes`, resets are now omitted for _undefined_ reset values of such types as well. [#2117](https://github.com/clash-lang/clash-compiler/issues/2117) * The `alteraPll` primitive was unusable since commit `d325557750` (release v1.4.0), it now works again. [#2136](https://github.com/clash-lang/clash-compiler/pull/2136) * Simulation/Synthesis mismatch for X-exception to undefined bitvector conversion [#2154](https://github.com/clash-lang/clash-compiler/issues/2154) * The VHDL blackbox for `Signed.fromInteger` can now handle any `Netlist Expr` as input [#2149](https://github.com/clash-lang/clash-compiler/issues/2149) * Clash no longer escapes extended identifiers when rendering SDC files. [#2142](https://github.com/clash-lang/clash-compiler/pull/2142) * The types defined in `clash-prelude-hedgehog` now come with `Show` instances [#2133](https://github.com/clash-lang/clash-compiler/issues/2133) * Extreme values are now generated from the input range instead of the type's bounds [#2138](https://github.com/clash-lang/clash-compiler/issues/2138) Internal change: * Clash now always generates non-extended identifiers for port names, so that generated names play nicer with different vendor tools. [#2142](https://github.com/clash-lang/clash-compiler/pull/2142) * Top entity name available in netlist context. Top entity name used in generated name for include files. [#2146](https://github.com/clash-lang/clash-compiler/pull/2146) ## 1.6.2 *Feb 25th 2022* Fixed: * Clash now compiles for users of Clang - i.e., all macOS users. * The `trueDualPortBlockRam` model did not accurately simulate concurrent active ports, thus causing a Haskell/HDL simulation mismatch for `asyncFIFOSynchronizer`. * `trueDualPortBlockRam` Haskell/HDL simulation mismatch for port enable. * Sometimes `trueDualPortBlockRam` swapped the names of the ports in exception messages. [#2102](https://github.com/clash-lang/clash-compiler/pull/2102) * The evaluator rule for unpack{Float,Double}# are now corrected to return boxed float and double instead of unboxed literals. [#2097](https://github.com/clash-lang/clash-compiler/issues/2097) Changed: * The `trueDualPortBlockRam` model now only models read/write conflicts for concurrent active ports * The `trueDualPortBlockRam` model now models write/write conflicts for concurrent active ports ## 1.6.1 *Feb 11th 2022* Changed: * We accidentally released `v1.6.0` with the Cabal flag `multiple-hidden` enabled. This is an experimental feature, supposed to be disabled by default for releases. `v1.6.1` disables it again. Added: * `Clash.Class.HasDomain.TryDomain` instances for Clash sized types ## 1.6.0 *Feb 10th 2022* Added: * `Clash.Class.Counter`: a class that defines a odometer-style supercounter. [#1763](https://github.com/clash-lang/clash-compiler/pull/1763) * `isLike` function for BitPack types. [#1774](https://github.com/clash-lang/clash-compiler/pull/1774) * 'seqErrorX' for catching both `XException` and `ErrorCall`. [#1774](https://github.com/clash-lang/clash-compiler/pull/1774) * `Clash.Explicit.BlockRam.File.memFile`, a function for creating the contents of the data files this blockRAM uses. Can also be imported from `Clash.Prelude.BlockRam.File`, `Clash.Prelude.ROM.File` and `Clash.Explicit.ROM.File`. [#1840](https://github.com/clash-lang/clash-compiler/pull/1840) * Support for Yosys compatible SVA to `Clash.Verification`. This enables formal verification using SymbiYosis for Verilog and SystemVerilog. [#1798](https://github.com/clash-lang/clash-compiler/pull/1798) * `Clash.Explicit.Signal.Delayed.forward`, a function that can be used to retime a `DSignal` into the future without applying any logic. [#1882](https://github.com/clash-lang/clash-compiler/pull/1882) * `Clash.Signal.andEnable` is the `HiddenEnable` version of `Clash.Explicit.Signal.andEnable` (formerly known as `enable`) [#1849](https://github.com/clash-lang/clash-compiler/pull/1849) * `runUntil`, a function to sample a signal until it returns a value that satisfies the user-given test. It is a convenience function that, among others, allow easy running of a `testBench` style function in Haskell simulation, logging assertion failures to stderr. [#1940](https://github.com/clash-lang/clash-compiler/pull/1940) * Support for true dual ported block ram through `Clash.Prelude.BlockRam.trueDualPortBlockRam` and `Clash.Explicit.BlockRam.trueDualPortBlockRam`. [#1726](https://github.com/clash-lang/clash-compiler/pull/1726) [#1975](https://github.com/clash-lang/clash-compiler/pull/1975) * `clash-{prelude,lib}-hedgehog` packages which provide generators for types in `clash-prelude` and `clash-lib`. The former is published on Hackage. [#1976](https://github.com/clash-lang/clash-compiler/pull/1976) * Clash now contains black boxes which are verilator compatible. When running with `--verilog` or `--systemverilog` a C++ shim is automatically produced which can be used to quickly generate a verilated executable. Users who wish to interact with verilator simulations are recommended to use [clashilator](https://github.com/gergoerdi/clashilator). [#2019](https://github.com/clash-lang/clash-compiler/pull/2019) * Support for YAML blackboxes. Clash will now pickup on files with a `.primitives.yaml` extension. While we recommend upgrading your primitive files to the new format, old style primitives are still supported. We've included a tool to automatically upgrade your JSON files, see [#2037](https://github.com/clash-lang/clash-compiler/pull/2037) * `MemBlob`: a datastructure for efficient constants, typically used for initializing memories. [#2041](https://github.com/clash-lang/clash-compiler/pull/2041) Fixed: * BlockRam simulation is now less strict. [#1458](https://github.com/clash-lang/clash-compiler/issues/1458) * Don't overflow VHDL's integer type when addressing RAM/ROM in simulation.Addresses are masked to 32 bits to be sure to keep it within the simulator's range. [#1875](https://github.com/clash-lang/clash-compiler/pull/1875) * `show` on `BitVector 0` no longer results in an empty string. [#1785](https://github.com/clash-lang/clash-compiler/pull/1785) * Clash now preserves transfinite floating numbers (NaN, Infinity) when packing/unpacking [#1803](https://github.com/clash-lang/clash-compiler/issues/1803) * `SynthesisAnnotation`s can now be defined in type synoynms without being excluded from the generated HDL [#1771](https://github.com/clash-lang/clash-compiler/issues/1771) * Manifest files now correctly list bidirectional ports as "inout" rather than "in" [#1843](https://github.com/clash-lang/clash-compiler/issues/1843) * `div`/`rem`/`mod` now avoid division by zero during VHDL simulation. Due to the use of concurrent statements, even unreachable code would previously result in simulation error [#1873](https://github.com/clash-lang/clash-compiler/pull/1873) * Don't overflow the range of VHDL's natural type in shift/rotate, leading to simulation issues. Shift now saturates to a 31-bit shift amount. For rotate, in simulation only, the rotate amount is modulo the word width of the rotated value [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) * `shiftL` for Clash datatypes does not cause a crash anymore when running Clash code with a really large shift amount [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) * VHDL generated for `Signed.fromInteger` now truncates, like the Clash simulation, when the result is smaller than the argument [#1874](https://github.com/clash-lang/clash-compiler/pull/1874) * Clash now preserves boolean combinatorial logic better when generating HDL [#1881](https://github.com/clash-lang/clash-compiler/issues/1881) * `valid` field of `TemplateFunction` is now checked for includes [#1945](https://github.com/clash-lang/clash-compiler/issues/1945) * Clash now generates clock generators that ensure that the amount of time between simulation start and the first active edge of the clock is equal to (/or longer than/) the period of the clock. The first active edges of the clocks do still occur simultaneously. [#2001](https://github.com/clash-lang/clash-compiler/issues/2001) * Expected values in assert become undefined when using `-fclash-compile-ultra` [#2040](https://github.com/clash-lang/clash-compiler/issues/2040) * `toEnum`/`fromEnum` on sized types is now less eager to report warnings about integer functions being used [#2046](https://github.com/clash-lang/clash-compiler/issues/2046) Changed: * `Clash.Verification.PrettyPrinters` has been moved from clash-prelude to to `Clash.Verification.Pretty` in `clash-lib`. [#1798](https://github.com/clash-lang/clash-compiler/pull/1798) * RAM/ROM functions: They now throw `XExeception` for out-of-bounds address inputs, so this condition no longer aborts simulation. [#1875](https://github.com/clash-lang/clash-compiler/pull/1875) * `Vec`'s show instance now generates valid Haskell. [#1776](https://github.com/clash-lang/clash-compiler/issues/1776) * `ShowX` and its functions now produce valid Haskell [#1782](https://github.com/clash-lang/clash-compiler/issues/1782) * `bLit` now infers the size of the generated BitVector from the string given to it. This means you don't have to give it an explicit type signature anymore. This does slightly modify the syntax needed to invoke `bLit`. E.g., `$$(bLit "00..1") :: BitVector 5` should be rewritten as `$(bLit "00..1")`. If you relied on the size inference, wrap the new invocation in `resize`. For example: `resize $(bLit "00..1")`. [#1784](https://github.com/clash-lang/clash-compiler/pull/1784) * `NumericUnderscores` is now enabled by default in `clash`, `clashi`, and starter projects using Clash >=1.6. [#1785](https://github.com/clash-lang/clash-compiler/pull/1785) * `Show` instance of `BitVector` now includes a `0b` prefix, making it a copyable expression for fully defined vectors. [#1785](https://github.com/clash-lang/clash-compiler/pull/1785) * `blockRam` uses `STArray` as the underlying representation to improve simulation performance [#1878](https://github.com/clash-lang/clash-compiler/pull/1878) * `asyncRom` now throws `XException` for out-of-bounds addressing, no longer aborting simulation [#1878](https://github.com/clash-lang/clash-compiler/pull/1878) * Clash now renders ADTs with all zero-width fields as enumerations in VHDL [#1879](https://github.com/clash-lang/clash-compiler/pull/1879) * A warning about possible hard-to-debug issues has been added to the `Clash.Signal` documentation on hidden clocks, resets, and enables, in the form of the section named "Monomorphism restriction leads to surprising behavior" [#1960](https://github.com/clash-lang/clash-compiler/pull/1960) * `Clash.Explicit.Testbench.outputVerifier` and `outputVerifierBitVector` now emit a warning if they are used improperly. This situation only arises when they are used in synthesized code rather than a test bench context. When the clock domains `circuitDom` and `testDom` are two different domains, the clock crossing inside `outputVerifier` is only suitable inside a test bench, not inside a synthesized circuit. Clash now emits a warning for this case. [#1931](https://github.com/clash-lang/clash-compiler/pull/1931) * `resetSynchronizer` now no longer takes an `Enable` argument. The argument was already marked for removal and was ignored. [#1964](https://github.com/clash-lang/clash-compiler/pull/1964) * Clash can now compile multiple entities concurrently, providing speedups to designs with multiple entities to build [#2034](https://github.com/clash-lang/clash-compiler/pull/2034) * All `asyncRam` variants and `asyncFIFOSynchronizer` now require that the data has an `NFDataX` instance. [#2055](https://github.com/clash-lang/clash-compiler/pull/2055) * Clash now respects the `-Werror` option from GHC [#2066](https://github.com/clash-lang/clash-compiler/pull/2066) * `asyncFIFOSynchronizer` now uses the synchronous dual-ported RAM `trueDualPortBlockRam`, where it previously used a dual-ported RAM with an asynchronous read port `asyncRam`. With this change it's nearly guaranteed that `asyncFIFOSynchronizer` actually synthesizes to a circuit that uses the dual-ported RAMs found on most FPGAs. [#2083](https://github.com/clash-lang/clash-compiler/pull/2083) Deprecated: * The function `Clash.Explicit.Signal.enable` is renamed to `andEnable` and the existing name deprecated [#1849](https://github.com/clash-lang/clash-compiler/pull/1849) * '-fclash-float-support': it is now on by default and can't be turned off. [#2048](https://github.com/clash-lang/clash-compiler/pull/2048) Removed: * GHC 8.4 is no longer supported. Users should upgrade to at least GHC 8.6. [#1762](https://github.com/clash-lang/clash-compiler/pull/1762) Internal changes: * `clash-lib` now uses `Data.Monoid.Ap` instead of `Data.Semigroup.Monad.Mon`. This means users defining primitives with `TemplateFunction` will need to replace `Mon`/`getMon` with `Ap`/`getAp`. [#1835](https://github.com/clash-lang/clash-compiler/pull/1835) * Clash now supports more expressive debug options at the command line [#1800](https://github.com/clash-lang/clash-compiler/issues/1800). * Added `zeroWidthSpec` transformation [#1891](https://github.com/clash-lang/clash-compiler/pull/1891) * Added `collapseRHSNoops` inlining stage and `WorkIdentity` constructor [#1896](https://github.com/clash-lang/clash-compiler/pull/1896) * Added `HasType` and `InferType` classes for getting / inferring core types from data representing some typed "thing" [#1915](https://github.com/clash-lang/clash-compiler/pull/1915) * Added `HasFreeVars` class for getting free variables from data "containing" variables [#1917](https://github.com/clash-lang/clash-compiler/pull/1917) * Added the primitive equality type (`~#`) to `Clash.Core.TysPrim`. In order to make this change, `undefinedTy` and `unsafeCoerceTy` were moved from `Clash.Core.Type` to `Clash.Core.Util`. [#1955](https://github.com/clash-lang/clash-compiler/pull/1955) * Clash now keeps information about which let bindings are recursive from GHC core. This can be used to avoid performing free variable calculations, or sorting bindings in normalization. [#1980](https://github.com/clash-lang/clash-compiler/pull/1980) [#2000](https://github.com/clash-lang/clash-compiler/pull/2000) * Manifest files now use SHA256 for a cache invalidation digest [#1985](https://github.com/clash-lang/clash-compiler/pull/1985) ## 1.4.7 *Jan 30th 2022* Fixed: * Clash now shows days in time strings for compile runs which take longer than a day [#1989](https://github.com/clash-lang/clash-compiler/compare/issue-1989). * Types defined in the package head are no longer qualified in the package body when rendering VHDL [#1996](https://github.com/clash-lang/clash-compiler/issues/1996). * `asyncRam` with different read and write clocks no longer produce the wrong results in Haskell simulation. [#2031](https://github.com/clash-lang/clash-compiler/pull/2031) * `Clash.Explicit.RAM.asyncRam#` Haskell simulation incorrectly treated an _undefined_ write enable as asserted. It now causes an _undefined_ value to be written instead. This problem did not propagate to the other `asyncRam` functions, where the same condition would simultaneously lead to an undefined write address, which would be handled correctly. This problem also only affects Haskell simulation, not the generated HDL. [#2031](https://github.com/clash-lang/clash-compiler/pull/2031) * `Clash.Explicit.BlockRam.blockRam#` and `Clash.Explicit.BlockRam.File.blockRamFile#` Haskell simulation incorrectly treated an _undefined_ write enable as asserted. It now causes an _undefined_ value to be written instead. This problem did not propagate to the other `blockRam` functions, where the same condition would simultaneously lead to an undefined write address, which would be handled correctly. This problem also only affects Haskell simulation, not the generated HDL.([#2054](https://github.com/clash-lang/clash-compiler/pull/2054)) Internal changes: * Removed instances of `Hashable Term` and `Hashable Type` [#1986](https://github.com/clash-lang/clash-compiler/pull/1986) * Added structural equality on `Term` (`Clash.Core.Subst.eqTerm`) and `Type` (`Clash.Core.Subst.eqType`) Internal fixes: * Enable used to be a `Bool` in the Blackbox DSL, so we could use `boolToBit`. However it now has its own type in the DSL (`Enable domainName`), so we've added a new conversion function in order to convert it to a Bool. ## 1.4.6 *Oct 26th 2021* Fixed: * Clash tries to cast-specialize non-"global binders" resulting in "specialisation of non-work-free cast" warning [#1933](https://github.com/clash-lang/clash-compiler/issues/1945) * More consistently render bare untyped and unsized literals for `~LIT` tags. This fixes [#1934](https://github.com/clash-lang/clash-compiler/issues/1934) ## 1.4.5 *Oct 13th 2021* Changed: * `clash-lib` now supports prettyprinter 1.7 Documentation: * The documentation on hidden clocks, resets, and enables has been corrected and extended in `Clash.Signal`. ## 1.4.4 *Oct 11th 2021* Changed: * `clash-lib` now supports aeson >= 2.0 Fixed: * Dont' loop on recursive data types hiding behind type families [#1921](https://github.com/clash-lang/clash-compiler/issues/1921) * Recognize `enableGen` as workfree and don't duplicate registers [#1935](https://github.com/clash-lang/clash-compiler/issues/1935) ## 1.4.3 *Aug 8th 2021* Fixed: * Clash no longer generates calls to `{shift,rotate}_{left,right}` in VHDL where the count is a negative number [#1810](https://github.com/clash-lang/clash-compiler/issues/1810). * Clash no longer incurs unnecessary compile-time complexity while compiling Vector indexing operator [#1557](https://github.com/clash-lang/clash-compiler/issues/1557) ## 1.4.2 *May 18th 2021* Fixed: * Erroneous examples in `Clash.Annotation.TopEntity` documentation [#646](https://github.com/clash-lang/clash-compiler/issues/646) and [#654](https://github.com/clash-lang/clash-compiler/issues/654) * `unconcat` cannot be used as initial/reset value for a `register` [#1756](https://github.com/clash-lang/clash-compiler/issues/1756) * `showX` now doesn't crash if a spine of a `Vec` is undefined * `~ISACTIVEENABLE` in blackboxes works again, and now acts on `Signal dom Bool` in addition to `Enable dom`. Since [#1368](https://github.com/clash-lang/clash-compiler/pull/1368), enable lines were always generated even if they were known to be always enabled. Fixes [#1786](https://github.com/clash-lang/clash-compiler/issues/1786). * clash --show-options now shows -fclash-* options in GHC 9.0 [#1787](https://github.com/clash-lang/clash-compiler/issues/1787) * `makeRecursiveGroups` now correctly identifies mutual recursion between global binders ([#1796](https://github.com/clash-lang/clash-compiler/issues/1796)). ## 1.4.1 *April 6th 2021* Fixed: * Broken VHDL primitive template for setSlice# [#1715](https://github.com/clash-lang/clash-compiler/issues/1715) * Unable to reduce nested type families [#1721](https://github.com/clash-lang/clash-compiler/issues/1721) * DEC transformation fails for functions applied to more than 62 arguments [#1669](https://github.com/clash-lang/clash-compiler/issues/1669) * Erroneous examples in BlockRam.File and ROM.File documentation [#1608](https://github.com/clash-lang/clash-compiler/issues/1608) * Blackboxes of `Clash.Sized.Vector` functions error on vectors containing `Clocks`, `Reset`, or `Enable` [#1606](https://github.com/clash-lang/clash-compiler/issues/1606) * `Clash.Signal.Delayed.delayI` cannot be reset, the `HiddenReset` constraint was unintentional. Asserting its reset has never worked. Removed the constraint [#1739](https://github.com/clash-lang/clash-compiler/pull/1739). * Annotate attributes cannot use type families [#1742](https://github.com/clash-lang/clash-compiler/issues/1742) Changed: * `Clash.Prelude.ROM.File.romFile` now takes an `Enum addr => addr` as address argument, making it actually useful. [#407](https://github.com/clash-lang/clash-compiler/issues/407) ## 1.4.0 *March 12th 2021* Highlighted changes (repeated in other categories): * Clash no longer disables the monomorphism restriction. See [#1270](https://github.com/clash-lang/clash-compiler/issues/1270), and mentioned issues, as to why. This can cause, among other things, certain eta-reduced descriptions of sequential circuits to no longer type-check. See [#1349](https://github.com/clash-lang/clash-compiler/pull/1349) for code hints on what kind of changes to make to your own code in case it no longer type-checks due to this change. * Type arguments of `Clash.Sized.Vector.fold` swapped: before `forall a n . (a -> a -> a) -> Vec (n+1) a -> a`, after `forall n a . (a -> a -> a) -> Vec (n+1) a`. This makes it easier to use `fold` in a `1 <= n` context so you can "simply" do `fold @(n-1)` * `Fixed` now obeys the laws for `Enum` as set out in the Haskell Report, and it is now consistent with the documentation for the `Enum` class on Hackage. As `Fixed` is also `Bounded`, the rule in the Report that `succ maxBound` and `pred minBound` should result in a runtime error is interpreted as meaning that `succ` and `pred` result in a runtime error whenever the result cannot be represented, not merely for `minBound` and `maxBound` alone. * Primitives should now be stored in `*.primitives` files instead of `*.json`. While primitive files very much look like JSON files, they're not actually spec complaint as they use newlines in strings. This has recently been brought to our attention by Aeson fixing an oversight in their parser implementation. We've therefore decided to rename the extension to prevent confusion. Fixed: * Result of `Clash.Class.Exp.(^)` has enough bits in order to deal with `x^0`. * Resizes to `Signed 0` (e.g., `resize @(Signed n) @(Signed 0)`) don't throw an error anymore * `satMul` now correctly handles arguments of type `Index 2` * `Clash.Explicit.Reset.resetSynchronizer` now synchronizes on synchronous domains too [#1567](https://github.com/clash-lang/clash-compiler/pull/1567). * `Clash.Explicit.Reset.convertReset`: now converts synchronous domains too, if necessary [#1567](https://github.com/clash-lang/clash-compiler/pull/1567). * `inlineWorkFree` now never inlines a topentity. It previously only respected this invariant in one of the two cases [#1587](https://github.com/clash-lang/clash-compiler/pull/1587). * Clash now reduces recursive type families [#1591](https://github.com/clash-lang/clash-compiler/issues/1591) * Primitive template warning is now retained when a `PrimitiveGuard` annotation is present [#1625](https://github.com/clash-lang/clash-compiler/issues/1625) * `signum` and `RealFrac` for `Fixed` now give the correct results. * Fixed a memory leak in register when used on asynchronous domains. Although the memory leak has always been there, it was only triggered on asserted resets. These periods are typically short, hence typically unnoticable. * `createDomain` will not override user definitions of types, helping users who strive for complete documentation coverage [#1674] https://github.com/clash-lang/clash-compiler/issues/1674 * `fromSNat` is now properly constrained [#1692](https://github.com/clash-lang/clash-compiler/issues/1692) * As part of an internal overhaul on netlist identifier generation [#1265](https://github.com/clash-lang/clash-compiler/pull/1265): * Clash no longer produces "name conflicts" between basic and extended identifiers. I.e., `\x\` and `x` are now considered the same variable in VHDL (likewise for other HDLs). Although the VHDL spec considers them distinct variables, some HDL tools - like Quartus - don't. * Capitalization of Haskell names are now preserved in VHDL. Note that VHDL is a case insensitive languages, so there are measures in place to prevent Clash from generating both `Foo` and `fOO`. This used to be handled by promoting every capitalized identifier to an extended one and wasn't handled for basic ones. * Names generated for testbenches can no longer cause collisions with previously generated entities. * Names generated for components can no longer cause collisions with user specified top entity names. * For (System)Verilog, variables can no longer cause collisions with (to be) generated entity names. * HO blackboxes can no longer cause collisions with identifiers declared in their surrounding architecture block. Changed: * Treat enable lines specially in generated HDL [#1171](https://github.com/clash-lang/clash-compiler/issues/1171) * `Signed`, `Unsigned`, `SFixed`, and `UFixed` now correctly implement the `Enum` law specifying that the predecessor of `minBound` and the successor of `maxBound` should result in an error [#1495](https://github.com/clash-lang/clash-compiler/pull/1495). * `Fixed` now obeys the laws for `Enum` as set out in the Haskell Report, and it is now consistent with the documentation for the `Enum` class on Hackage. As `Fixed` is also `Bounded`, the rule in the Report that `succ maxBound` and `pred minBound` should result in a runtime error is interpreted as meaning that `succ` and `pred` result in a runtime error whenever the result cannot be represented, not merely for `minBound` and `maxBound` alone. * Type arguments of `Clash.Sized.Vector.fold` swapped: before `forall a n . (a -> a -> a) -> Vec (n+1) a -> a`, after `forall n a . (a -> a -> a) -> Vec (n+1) a`. This makes it easier to use `fold` in a `1 <= n` context so you can "simply" do `fold @(n-1)` * Moved `Clash.Core.Evaluator` into `Clash.GHC` and provided generic interface in `Clash.Core.Evalautor.Types`. This removes all GHC specific code from the evaluator in clash-lib. * Clash no longer disables the monomorphism restriction. See [#1270](https://github.com/clash-lang/clash-compiler/issues/1270), and mentioned issues, as to why. This can cause, among other things, certain eta-reduced descriptions of sequential circuits to no longer type-check. See [#1349](https://github.com/clash-lang/clash-compiler/pull/1349) for code hints on what kind of changes to make to your own code in case it no longer type-checks due to this change. * Clash now generates SDC files for each topentity with clock inputs * `deepErrorX` is now equal to `undefined#`, which means that instead of the whole BitVector being undefined, its individual bits are. This makes sure bit operations are possible on it. [#1532](https://github.com/clash-lang/clash-compiler/pull/1532) * From GHC 9.0.1 onwards the following types: `BiSignalOut`, `Index`, `Signed`, `Unsigned`, `File`, `Ref`, and `SimIO` are all encoded as `data` instead of `newtype` to work around an [issue](https://github.com/clash-lang/clash-compiler/pull/1624#discussion_r558333461) where the Clash compiler can no longer recognize primitives over these types. This means you can no longer use `Data.Coerce.coerce` to coerce between these types and their underlying representation. * Signals on different domains used to be coercable because the domain had a type role "phantom". This has been changed to "nominal" to prevent accidental, unsafe coercions. [#1640](https://github.com/clash-lang/clash-compiler/pull/1640) * Size parameters on types in Clash.Sized.Internal.* are now nominal to prevent unsafe coercions. [#1640](https://github.com/clash-lang/clash-compiler/pull/1640) * `hzToPeriod` now takes a `Ratio Natural` rather than a `Double`. It rounds slightly differently, leading to more intuitive results and satisfying the requested change in [#1253](https://github.com/clash-lang/clash-compiler/issues/1253). Clash expresses clock rate as the clock period in picoseconds. If picosecond precision is required for your design, please use the exact method of specifying a clock period rather than a clock frequency. * `periodToHz` now results in a `Ratio Natural` * `createDomain` doesn't override existing definitions anymore, fixing [#1674](https://github.com/clash-lang/clash-compiler/issues/1674) * Manifest files are now stored as `clash-manifest.json` * Manifest files now store hashes of the files Clash generated. This allows Clash to detect user changes on a next run, preventing accidental data loss. * Primitives should now be stored in `*.primitives` files. While primitive files very much look like JSON files, they're not actually spec complaint as they use newlines in strings. This has recently been brought to our attention by Aeson fixing an oversight in their parser implementation. We've therefore decided to rename the extension to prevent confusion. * Each binder marked with a `Synthesize` or `TestBench` pragma will be put in its own directory under their fully qualified Haskell name. For example, two binders `foo` and `bar` in module `A` will be synthesized in `A.foo` and `A.bar`. * Clash will no longer generate vhdl, verilog, or systemverilog subdirectories when using `-fclash-hdldir`. * `Data.Kind.Type` is now exported from `Clash.Prelude` [#1700](https://github.com/clash-lang/clash-compiler/issues/1700) Added: * Support for GHC 9.0.1 * `Clash.Signal.sameDomain`: Allows user obtain evidence whether two domains are equal. * `xToErrorCtx`: makes it easier to track the origin of `XException` where `pack` would hide them [#1461](https://github.com/clash-lang/clash-compiler/pull/1461) * Additional field with synthesis attributes added to `InstDecl` in `Clash.Netlist.Types` [#1482](https://github.com/clash-lang/clash-compiler/pull/1482) * `Data.Ix.Ix` instances for `Signed`, `Unsigned`, and `Index` [#1481](https://github.com/clash-lang/clash-compiler/pull/1481) [#1631](https://github.com/clash-lang/clash-compiler/pull/1631) * Added `nameHint` to allow explicitly naming terms, e.g. `Signal`s. * Checked versions of `resize`, `truncateB`, and `fromIntegral`. Depending on the type `resize`, `truncateB`, and `fromIntegral` either yield an `XException` or silently perform wrap-around if its argument does not fit in the resulting type's bounds. The added functions check the bound condition and fail with an error call if the condition is violated. They do not affect HDL generation. [#1491](https://github.com/clash-lang/clash-compiler/pull/1491) * `HasBiSignalDefault`: constraint to Clash.Signal.BiSignal, `pullUpMode` gives access to the pull-up mode. [#1498](https://github.com/clash-lang/clash-compiler/pull/1498) * Match patterns to bitPattern [#1545](https://github.com/clash-lang/clash-compiler/pull/1545) * Non TH `fromList` and `unsafeFromList` for Vec. These functions allow Vectors to be created from a list without needing to use template haskell, which is not always desirable. The unsafe version of the function does not compare the length of the list to the desired length of the vector, either truncating or padding with undefined if the lengths differ. * `Clash.Explicit.Reset.resetGlitchFilter`: filters glitchy reset signals. Useful when your reset signal is connected to sensitive actuators. * Clash can now generate EDAM for using Edalize. This generates edam.py files in all top entities with the configuration for building that entity. Users still need to edit this file to specify the EDA tool to use, and if necessary the device to target (for Quartus, Vivado etc.). [#1386](https://github.com/clash-lang/clash-compiler/issues/1386) * `-fclash-aggressive-x-optimization-blackboxes`: when enabled primitives can detect undefined values and change their behavior accordingly. For example, if `register` is used in combination with an undefined reset value, it will leave out the reset logic entirely. Related issue: [#1506](https://github.com/clash-lang/clash-compiler/issues/1506). * Automaton-based interface to simulation, to allow interleaving of cyle-by-cycle simulation and external effects [#1261](https://github.com/clash-lang/clash-compiler/pull/1261) New internal features: * `constructProduct` and `deconstructProduct` in `Clash.Primitives.DSL`. Like `tuple` and `untuple`, but on arbitrary product types. * Support for multi result primitives. Primitives can now assign their results to multiple variables. This can help to work around synthesis tools limits in some cases. See [#1560](https://github.com/clash-lang/clash-compiler/pull/1560). * Added a rule for missing `Int` comparisons in `GHC.Classes` in the compile time evaluator. [#1648](https://github.com/clash-lang/clash-compiler/issues/1648) * Clash now creates a mapping from domain names to configurations in `LoadModules`. [#1405](https://github.com/clash-lang/clash-compiler/pull/1405) * The convenience functions in `Clash.Primitives.DSL` now take a list of HDLs, instead of just one. * `Clash.Netlist.Id` overhauls the way identifiers are generated in the Netlist part of Clash. * Added `defaultWithAction` to Clash-as-a-library API to work around/fix issues such as [#1686](https://github.com/clash-lang/clash-compiler/issues/1686) * Manifest files now list files and components in an reverse topological order. This means it can be used when calling EDA tooling without causing compilation issues. Deprecated: * `Clash.Prelude.DataFlow`: see [#1490](https://github.com/clash-lang/clash-compiler/pull/1490). In time, its functionality will be replaced by [clash-protocols](https://github.com/clash-lang/clash-protocols). Removed: * The deprecated function `freqCalc` has been removed. ## 1.2.5 *November 9th 2020* Fixed: * The normalizeType function now fully normalizes types which require calls to reduceTypeFamily [#1469](https://github.com/clash-lang/clash-compiler/issues/1469) * `flogBaseSNat`, `clogBaseSNat` and `logBaseSNat` primitives are now implemented correctly.Previously these primitives would be left unevaluated causing issues as demonstrated in [#1479](https://github.com/clash-lang/clash-compiler/issues/1469) * Specializing on functions with type family arguments no longer fails [#1477](https://github.com/clash-lang/clash-compiler/issues/1477) * `satSucc`, `satPred` correctly handle "small types" such as `Index 1`. * `msb` no longer fails on values larger than 64 bits * `undefined` can now be used as a reset value of `autoReg@Maybe` [#1507](https://github.com/clash-lang/clash-compiler/issues/1507) * Signal's `fmap` is now less strict, preventing infinite loops in very specific situations. See [#1521](https://github.com/clash-lang/clash-compiler/issues/1521) * Clash now uses correct function names in manifest and sdc files [#1533](https://github.com/clash-lang/clash-compiler/issues/1533) * Clash no longer produces erroneous HDL in very specific cases [#1536](https://github.com/clash-lang/clash-compiler/issues/1536) * Usage of `fold` inside other HO primitives (e.g., `map`) no longer fails [#1524](https://github.com/clash-lang/clash-compiler/issues/1524) Changed: * Due to difficulties using `resetSynchronizer` we've decided to make this function always insert a synchronizer. See: [#1528](https://github.com/clash-lang/clash-compiler/issues/1528). ## 1.2.4 *July 28th 2020* * Changed: * Relaxed upper bound versions of `aeson` and `dlist`, in preparation for the new Stack LTS. * Reverted changes to primitive definitions for 'zipWith', 'map', 'foldr', and 'init' introduced in 1.2.2. They have shown to cause problems in very specific circumstances. ## 1.2.3 *July 11th 2020* * Changed: * Upgrade to nixos 20.03. Nix and snap users will now use packages present in 20.03. * Added: * `instance Monoid a => Monoid (Vec n a)` * `instance Text.Printf(Index)` * `instance Text.Printf(Signed)` * `instance Text.Printf(Unsigned)` * Fixed: * Clash renders incorrect VHDL when GHCs Worker/Wrapper transformation is enabled [#1402](https://github.com/clash-lang/clash-compiler/issues/1402) * Minor faults in generated HDL when using annotations from `Clash.Annotations.SynthesisAttributes` * Cabal installed through Snap (`clash.cabal`) can now access the internet to fetch pacakges. [#1411]https://github.com/clash-lang/clash-compiler/issues/1411 * Generated QSys file for `altpll` incompatible with Quartus CLI (did work in Quartus GUI) * Clash no longer uses component names that clash with identifiers imported from: * IEEE.STD_LOGIC_1164.all * IEEE.NUMERIC_STD.all * IEEE.MATH_REAL.all * std.textio.all when generating VHDL. See https://github.com/clash-lang/clash-compiler/issues/1439. ## 1.2.2 *June 12th 2020* * Changed: * The hardwired functions to unroll primitive definitions for 'zipWith', 'map', 'foldr', and 'init' have been changed to only unroll a single step, whereas they would previously unroll the whole definition in one step. This allows Clash to take advantage of the lazy nature of these functions, in turn speeding up compilation speeds significantly in some cases. Part of [PR 1354](https://github.com/clash-lang/clash-compiler/pull/1354). * Added: * Support for GHC 8.10 * Ability to load designs from precompiled modules (i.e., stored in a package database). See [#1172](https://github.com/clash-lang/clash-compiler/pull/1172) * Support for '-main-is' when used with `--vhdl`, `--verilog`, or `--systemverilog` * A partial instance for `NFDataX (Signal domain a)` * Fixed: * Clash's evaluator now inlines work free definitions, preventing [situations where it would otherwise get stuck in an infinite loop](https://github.com/clash-lang/clash-compiler/pull/1354#issuecomment-635430374) * `caseCon` doesn't apply type-substitution correctly [#1340](https://github.com/clash-lang/clash-compiler/issues/1340) * Clash generates illegal SystemVerilog slice [#1313](https://github.com/clash-lang/clash-compiler/issues/1313) * Fix result type of head and tail Verilog blackboxes [#1351](https://github.com/clash-lang/clash-compiler/issues/1351) * Certain recursive let-expressions in side a alternatives of a case-expression throw the Clash compiler into an infinite loop [#1316](https://github.com/clash-lang/clash-compiler/issues/1316) * Fixes issue with one of Clash's transformations, `inlineCleanup`, introducing free variables [#1337](https://github.com/clash-lang/clash-compiler/issues/1337) * Fails to propagate type information of existential type [#1310](https://github.com/clash-lang/clash-compiler/issues/1310) * Certain case-expressions throw the Clash compiler into an infinite loop [#1320](https://github.com/clash-lang/clash-compiler/issues/1320) * Added blackbox implementation for 'Clash.Sized.Vector.iterateI', hence making it usable as a register reset value [#1240](https://github.com/clash-lang/clash-compiler/issues/1240) * `iterate` and `iterateI` can now be used in reset values [#1240](https://github.com/clash-lang/clash-compiler/issues/1240) * Prim evaluation fails on undefined arguments [#1297](https://github.com/clash-lang/clash-compiler/issues/1297) * Missing re-indexing in (Un)Signed fromSLV conversion [#1292](https://github.com/clash-lang/clash-compiler/issues/1292) * VHDL: generate a type qualification inside ~TOBV, fixes [#1360](https://github.com/clash-lang/clash-compiler/issues/1360) ## 1.2.1 *April 23rd 2020* * Changed: * Treat `Signed 0`, `Unsigned 0`, `Index 1`, `BitVector 0` as unit. In effect this means that 'minBound' and 'maxBound' return 0, whereas previously they might crash [#1183](https://github.com/clash-lang/clash-compiler/issues/1183) * Infix use of `deepseqX` is now right-associative * Added: * Add 'natToInteger', 'natToNatural', and 'natToNum'. Similar to 'snatTo*', but works solely on a type argument instead of an SNat. * `Clash.Sized.Vector.unfoldr` and `Clash.Sized.Vector.unfoldrI` to construct vectors from a seed value * Added NFDataX instances for `Data.Monoid.{First,Last}` * Fixed: * The Verilog backend can now deal with non-contiguous ranges in custom bit-representations. * Synthesizing BitPack instances for type with phantom parameter fails [#1242](https://github.com/clash-lang/clash-compiler/issues/1242) * Synthesis of `fromBNat (toBNat d5)` failed due to `unsafeCoerce` coercing from `Any` * Memory leak in register primitives [#1256](https://github.com/clash-lang/clash-compiler/issues/1256) * Illegal VHDL slice when projecting nested SOP type [#1254](https://github.com/clash-lang/clash-compiler/issues/1254) * Vivado VHDL code path (`-fclash-hdlsyn Vivado`) generates illegal VHDL [#1264](https://github.com/clash-lang/clash-compiler/issues/1264) ## 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. * 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) * 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 * Annotate expressions with attributes that persist in the generated HDL, e.g. synthesis directives: http://hackage.haskell.org/package/clash-prelude/docs/Clash-Annotations-SynthesisAttributes.html * Control (System)Verilog module instance, and VHDL entity instantiation names in generated code: http://hackage.haskell.org/package/clash-prelude/docs/Clash-Magic.html * Much improved infrastructure for handling of unknown values: defined spine, but unknown leafs: http://hackage.haskell.org/package/clash-prelude/docs/Clash-XException.html#t:NFDataX * Experimental: Multiple hidden clocks. Can be enabled by compiling `clash-prelude` with `-fmultiple-hidden` * Experimental: Limited GADT support (pattern matching on vectors, or custom GADTs as longs as their usage can be statically removed; no support of recursive GADTs) * Experimental: Use regular Haskell functions to generate HDL black boxes for primitives (in an addition to existing string templates for HDL black boxes) 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-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 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* * New features: * 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: `Clash.Intel.ClockGen` and `Clash.Xilinx.ClockGen`. * 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 ## 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 clash-prelude-1.8.1/LICENSE0000644000000000000000000000260307346545000013450 0ustar0000000000000000Copyright (c) 2013-2016, University of Twente, 2016-2019, Myrtle Software Ltd, 2017-2019, QBayLogic B.V., Google Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. clash-prelude-1.8.1/README.md0000755000000000000000000000301507346545000013723 0ustar0000000000000000# Clash - A functional hardware description language [![Pipeline status](https://gitlab.com/clash-lang/clash-compiler/badges/master/pipeline.svg)](https://gitlab.com/clash-lang/clash-compiler/commits/master) [![Hackage](https://img.shields.io/hackage/v/clash-prelude.svg)](https://hackage.haskell.org/package/clash-prelude) [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/clash-prelude.svg?style=flat)](http://packdeps.haskellers.com/feed?needle=exact%3Aclash-prelude) Clash is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The Clash compiler transforms these high-level descriptions to low-level synthesizable VHDL, Verilog, or SystemVerilog. Features of Clash: * Strongly typed, yet with a very high degree of type inference, enabling both safe and fast prototyping using concise descriptions. * Interactive REPL: load your designs in an interpreter and easily test all your component without needing to setup a test bench. * Higher-order functions, with type inference, result in designs that are fully parametric by default. * Synchronous sequential circuit design based on streams of values, called `Signal`s, lead to natural descriptions of feedback loops. * Support for multiple clock domains, with type safe clock domain crossing. # Support For updates and questions join the mailing list clash-language+subscribe@googlegroups.com or read the [forum](https://groups.google.com/d/forum/clash-language) clash-prelude-1.8.1/benchmarks/0000755000000000000000000000000007346545000014557 5ustar0000000000000000clash-prelude-1.8.1/benchmarks/BenchBitVector.hs0000644000000000000000000001477507346545000017772 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-} {-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} #define WORD_SIZE_IN_BITS 64 module BenchBitVector where import Data.Bits import Clash.Sized.BitVector import Clash.Class.Num import Clash.Class.BitPack.BitIndex import GHC.TypeLits (type (*)) 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 #-} smallValue2 :: BitVector WORD_SIZE_IN_BITS smallValue2 = $(lift (2^(16::Int)-100 :: BitVector WORD_SIZE_IN_BITS)) {-# INLINE smallValue2 #-} largeValue1 :: 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 = $(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 (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) msbBench :: Benchmark msbBench = env setup $ \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 where setup = return largeValue1 appendBench :: Benchmark appendBench = env setup $ \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 (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 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 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 clash-prelude-1.8.1/benchmarks/BenchCommon.hs0000644000000000000000000000037307346545000017306 0ustar0000000000000000module 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 #-} clash-prelude-1.8.1/benchmarks/BenchFixed.hs0000644000000000000000000000316607346545000017120 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-} {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} #define WORD_SIZE_IN_BITS 64 module BenchFixed (fixedBench) where import Clash.Class.Num import Clash.Sized.Fixed import Clash.Sized.Unsigned 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)) {-# INLINE smallValueR_pos #-} smallValueU1 :: UFixed 24 17 smallValueU1 = $(lift (5126.889117 :: UFixed 24 17)) {-# INLINE smallValueU1 #-} smallValueU2 :: UFixed 24 17 smallValueU2 = $(lift (56.589117 :: UFixed 24 17)) {-# INLINE smallValueU2 #-} fromRationalBench :: Benchmark fromRationalBench = env setup $ \m -> bench "fromRational" $ nf (fromRational :: Rational -> UFixed 24 17) m where setup = return smallValueR_pos addBench :: Benchmark addBench = env setup $ \m -> bench "+" $ nf (uncurry (+)) m where setup = return (smallValueU1,smallValueU2) subBench :: Benchmark subBench = env setup $ \m -> bench "-" $ nf (uncurry (-)) m where setup = return (smallValueU1,smallValueU2) multBench :: Benchmark multBench = env setup $ \m -> bench "*" $ nf (uncurry (*)) m where setup = return (smallValueU1,smallValueU2) multBench_wrap :: Benchmark multBench_wrap = env setup $ \m -> bench "satMult SatWrap" $ nf (uncurry (satMul SatWrap)) m where setup = return (smallValueU1,smallValueU2) clash-prelude-1.8.1/benchmarks/BenchRAM.hs0000644000000000000000000001016607346545000016476 0ustar0000000000000000{-# LANGUAGE MagicHash, TypeApplications, DataKinds #-} module BenchRAM (ramBench) where import Criterion (Benchmark, env, bench, nf, bgroup, envWithCleanup) import System.Directory import System.IO import Clash.Explicit.BlockRam import Clash.Explicit.BlockRam.File import Clash.Explicit.RAM import Clash.Explicit.ROM import Clash.Explicit.Signal import Clash.Prelude.ROM import Clash.Promoted.Nat import Clash.Promoted.Nat.Literals import qualified Clash.Sized.Vector as V import Clash.Sized.Internal.BitVector (undefined#) ramBench :: Benchmark ramBench = bgroup "RAMs" [ asyncRamBench , asyncRomBench , blockRamBench , blockRamROBench , blockRamFileBench , blockRamFileROBench , romBench ] asyncRamBench :: Benchmark asyncRamBench = env setup $ \m -> bench "asyncRam#" $ nf (take 298 . drop 2 . simulate_lazy (\rw -> let (r,w) = unbundle rw in asyncRam# @System clockGen clockGen enableGen (SNat @4096) 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 8298 . drop 2 . simulate_lazy (\w -> ram w (pure True) w w )) (cycle m) where ramInit = V.replicate (SNat @4096) (1 :: Int) setup = pure ([557,558..857]) ram = blockRam# @System clockGen enableGen ramInit blockRamROBench :: Benchmark blockRamROBench = env setup $ \m -> bench "blockRam# (0% writes)" $ nf (take 8298 . drop 2 . simulate_lazy (\w -> ram w (pure False) w w )) (cycle m) where ramInit = V.replicate (SNat @4096) (1 :: Int) setup = pure ([557,558..857]) ram = blockRam# @System clockGen enableGen ramInit blockRamFileBench :: Benchmark blockRamFileBench = envWithCleanup setup cleanup $ \(~(m,_,ram)) -> bench "blockRamFile# (100% writes)" $ nf (take 8298 . drop 2 . simulate_lazy (\w -> ram w (pure True) w (pure undefined#) )) (cycle m) where setup = do (fp,h) <- openTempFile "." "mem.bin" hPutStr h (unlines (replicate 4096 (replicate 63 '0' ++ ['1']))) hClose h let ram = blockRamFile# @64 @System clockGen enableGen (SNat @4096) fp fp `seq` ram `seq` return ([557,558..857],fp,ram) cleanup (_,f,_) = removeFile f blockRamFileROBench :: Benchmark blockRamFileROBench = envWithCleanup setup cleanup $ \(~(m,_,ram)) -> bench "blockRamFile# (0% writes)" $ nf (take 8298 . drop 2 . simulate_lazy (\w -> ram w (pure False) w (pure undefined#) )) (cycle m) where setup = do (fp,h) <- openTempFile "." "mem.bin" hPutStr h (unlines (replicate 4096 (replicate 63 '0' ++ ['1']))) hClose h let ram = blockRamFile# @64 @System clockGen enableGen (SNat @4096) fp fp `seq` ram `seq` return ([557,558..857], fp, ram) cleanup (_,f,_) = removeFile f 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]) clash-prelude-1.8.1/benchmarks/BenchSigned.hs0000644000000000000000000001357207346545000017274 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-} {-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} #define WORD_SIZE_IN_BITS 64 module BenchSigned (signedBench) where import Data.Bits import Clash.Class.Num import Clash.Class.BitPack import Clash.Sized.BitVector import Clash.Sized.Signed import Criterion (Benchmark, env, bench, nf, bgroup) import Language.Haskell.TH.Syntax (lift) import GHC.TypeLits (type (*)) import BenchCommon 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 ] 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 (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 -> 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 clash-prelude-1.8.1/benchmarks/BenchUnsigned.hs0000644000000000000000000001626507346545000017641 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-} {-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} #define WORD_SIZE_IN_BITS 64 module BenchUnsigned (unsignedBench) where import Data.Bits import Data.Word 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 , unsigned8toWord8Bench , unsigned16toWord16Bench , unsigned32toWord32Bench , unsignedToWordBench ] 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 #-} smallValueW8 :: Unsigned 8 smallValueW8 = $(lift (2^(4::Int)-10 :: Unsigned 8)) {-# INLINE smallValueW8 #-} smallValueW16 :: Unsigned 16 smallValueW16 = $(lift (2^(8::Int)-10 :: Unsigned 16)) {-# INLINE smallValueW16 #-} smallValueW32 :: Unsigned 32 smallValueW32 = $(lift (2^(16::Int)-10 :: Unsigned 32)) {-# INLINE smallValueW32 #-} 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 unsigned8toWord8Bench :: Benchmark unsigned8toWord8Bench = env setup $ \m -> bench "unsigned8toWord8 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 8 -> Word8) m where setup = return smallValueW8 unsigned16toWord16Bench :: Benchmark unsigned16toWord16Bench = env setup $ \m -> bench "unsigned16toWord16 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 16 -> Word16) m where setup = return smallValueW16 unsigned32toWord32Bench :: Benchmark unsigned32toWord32Bench = env setup $ \m -> bench "unsigned32toWord32 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 32 -> Word32) m where setup = return smallValueW32 unsignedToWordBench :: Benchmark unsignedToWordBench = env setup $ \m -> bench "unsignedToWord WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned WORD_SIZE_IN_BITS -> Word) m where setup = return smallValue1 clash-prelude-1.8.1/benchmarks/BenchVector.hs0000644000000000000000000000231507346545000017316 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-} {-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-} #define WORD_SIZE_IN_BITS 64 module BenchVector (vectorBench) where import Clash.Class.BitPack import Clash.Promoted.Nat.Literals import Clash.Sized.BitVector import Clash.Sized.Vector import Criterion (Benchmark, env, bench, nf, bgroup) import Language.Haskell.TH.Syntax (lift) import Prelude hiding (replicate) vectorBench :: Benchmark vectorBench = bgroup "Vector" [ vectorPackBench , vectorUnpackBench ] smallValue1 :: Vec 8 (BitVector 24) smallValue1 = $(lift (replicate d8 (2^(16::Int)-10 :: BitVector 24))) {-# INLINE smallValue1 #-} smallValue2 :: BitVector 192 smallValue2 = $(lift (maxBound :: BitVector 192)) {-# INLINE smallValue2 #-} vectorPackBench :: Benchmark vectorPackBench = env setup $ \m -> bench "pack" $ nf (pack :: Vec 8 (BitVector 24) -> BitVector 192) m where setup = return smallValue1 vectorUnpackBench :: Benchmark vectorUnpackBench = env setup $ \m -> bench "unpack" $ nf (unpack :: BitVector 192 -> Vec 8 (BitVector 24)) m where setup = return smallValue2 clash-prelude-1.8.1/benchmarks/benchmark-main.hs0000644000000000000000000000044607346545000017773 0ustar0000000000000000module Main where import Criterion.Main import BenchRAM import BenchBitVector import BenchFixed import BenchSigned import BenchUnsigned import BenchVector main :: IO () main = defaultMain [ ramBench , bitVectorBench , fixedBench , signedBench , unsignedBench , vectorBench ] clash-prelude-1.8.1/clash-prelude.cabal0000644000000000000000000004233207346545000016162 0ustar0000000000000000Cabal-version: 2.2 Name: clash-prelude Version: 1.8.1 Synopsis: Clash: a functional hardware description language - Prelude library Description: Clash is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The Clash compiler transforms these high-level descriptions to low-level synthesizable VHDL, Verilog, or SystemVerilog. . Features of Clash: . * Strongly typed, but with a very high degree of type inference, enabling both safe and fast prototyping using concise descriptions. . * Interactive REPL: load your designs in an interpreter and easily test all your component without needing to setup a test bench. . * Higher-order functions, with type inference, result in designs that are fully parametric by default. . * Synchronous sequential circuit design based on streams of values, called @Signal@s, lead to natural descriptions of feedback loops. . * Support for multiple clock domains, with type safe clock domain crossing. . . This package provides: . * Prelude library containing datatypes and functions for circuit design . To use the library: . * Import "Clash.Prelude" . * Alternatively, if you want to explicitly route clock and reset ports, for more straightforward multi-clock designs, you can import the "Clash.Explicit.Prelude" module. Note that you should not import "Clash.Prelude" and "Clash.Explicit.Prelude" at the same time as they have overlapping definitions. . 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: 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. Copyright: Copyright © 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2019, QBayLogic B.V., Google Inc., 2021-2023, QBayLogic B.V. Category: Hardware Build-type: Simple Extra-source-files: README.md CHANGELOG.md AUTHORS.md extra-doc-files: doc/*.svg source-repository head type: 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. Note that this greatly increases compile times for `clash-prelude`. default: False manual: True flag super-strict description: Use `deepseqX` (instead of `seqX`) in register-like constructs. This can help to eliminate space leaks when using lazy data structures in registers-like constructs. This potentially slows down Clash hardware simulation. 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 experimental feature, possibly triggering confusing error messages. By default, it is enabled on development versions of Clash and disabled on releases. default: False manual: True flag doctests description: You can disable testing with doctests using `-f-doctests`. default: True manual: True flag unittests description: You can disable testing with unittests using `-f-unittests`. default: True manual: True flag benchmarks description: You can disable testing with benchmarks using `-f-benchmarks`. default: True manual: True flag workaround-ghc-mmap-crash description: Only use this flag when hit by GHC bug #19421. See clash-compiler PR #2444. default: False manual: True common common-options default-language: Haskell2010 default-extensions: BangPatterns BinaryLiterals DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies InstanceSigs KindSignatures MagicHash NoStarIsType PostfixOperators ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeOperators ViewPatterns Library import: common-options HS-Source-Dirs: src ghc-options: -Wall -Wcompat -fexpose-all-unfoldings -fno-worker-wrapper CPP-Options: -DCABAL -- See https://github.com/clash-lang/clash-compiler/pull/2511 if impl(ghc >= 9.4) CPP-Options: -DCLASH_OPAQUE=OPAQUE else CPP-Options: -DCLASH_OPAQUE=NOINLINE 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 Clash.Annotations.BitRepresentation.Deriving Clash.Annotations.BitRepresentation.Internal Clash.Annotations.BitRepresentation.Util Clash.Annotations.SynthesisAttributes Clash.Annotations.TH Clash.Class.AutoReg Clash.Class.AutoReg.Internal Clash.Class.BitPack Clash.Class.BitPack.BitIndex Clash.Class.BitPack.BitReduction Clash.Class.BitPack.Internal Clash.Class.BitPack.Internal.TH Clash.Class.Counter Clash.Class.Counter.Internal Clash.Class.Counter.TH Clash.Class.Exp Clash.Class.HasDomain Clash.Class.HasDomain.HasSingleDomain Clash.Class.HasDomain.HasSpecificDomain Clash.Class.HasDomain.CodeGen Clash.Class.HasDomain.Common Clash.Class.Num Clash.Class.Parity Clash.Class.Resize Clash.Clocks Clash.Explicit.BlockRam Clash.Explicit.BlockRam.Blob Clash.Explicit.BlockRam.File Clash.Explicit.BlockRam.Internal Clash.Explicit.BlockRam.Model Clash.Explicit.DDR Clash.Explicit.Mealy Clash.Explicit.Moore Clash.Explicit.RAM Clash.Explicit.ROM Clash.Explicit.ROM.Blob Clash.Explicit.ROM.File Clash.Explicit.Prelude Clash.Explicit.Prelude.Safe Clash.Explicit.Reset Clash.Explicit.SimIO Clash.Explicit.Signal Clash.Explicit.Signal.Delayed Clash.Explicit.Synchronizer Clash.Explicit.Testbench Clash.Explicit.Verification Clash.HaskellPrelude Clash.Hidden Clash.Intel.ClockGen Clash.Intel.DDR Clash.Magic Clash.Num.Erroring Clash.Num.Overflowing Clash.Num.Saturating Clash.Num.Wrapping Clash.Num.Zeroing Clash.NamedTypes Clash.Prelude Clash.Prelude.BlockRam Clash.Prelude.BlockRam.Blob Clash.Prelude.BlockRam.File Clash.Prelude.DataFlow Clash.Prelude.Mealy Clash.Prelude.Moore Clash.Prelude.RAM Clash.Prelude.ROM Clash.Prelude.ROM.Blob Clash.Prelude.ROM.File Clash.Prelude.Safe Clash.Prelude.Testbench Clash.Promoted.Nat Clash.Promoted.Nat.Literals Clash.Promoted.Nat.TH Clash.Promoted.Nat.Unsafe Clash.Promoted.Symbol Clash.Signal Clash.Signal.Bundle Clash.Signal.BiSignal Clash.Signal.Delayed Clash.Signal.Delayed.Internal Clash.Signal.Delayed.Bundle Clash.Signal.Internal Clash.Signal.Internal.Ambiguous Clash.Signal.Trace Clash.Sized.BitVector Clash.Sized.Fixed Clash.Sized.Index Clash.Sized.RTree Clash.Sized.Signed Clash.Sized.Unsigned Clash.Sized.Vector Clash.Sized.Internal.BitVector Clash.Sized.Internal.Index Clash.Sized.Internal.Mod Clash.Sized.Internal.Signed Clash.Sized.Internal.Unsigned Clash.Verification Clash.Verification.DSL Clash.Verification.Internal Clash.XException Clash.XException.Internal Clash.XException.MaybeX Clash.XException.TH Clash.Xilinx.ClockGen Clash.Xilinx.DDR Clash.Tutorial Clash.Examples Clash.Examples.Internal other-modules: Clash.Class.AutoReg.Instances Clash.Clocks.Internal Clash.CPP Clash.Signal.Bundle.Internal Language.Haskell.TH.Compat Paths_clash_prelude other-extensions: CPP ConstraintKinds FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses PatternSynonyms RankNTypes TemplateHaskell TypeFamilies UndecidableInstances Build-depends: array >= 0.5.1.0 && < 0.6, arrows >= 0.4 && < 0.5, base >= 4.11 && < 5, binary >= 0.8.5 && < 0.11, bytestring >= 0.10.8 && < 0.13, constraints >= 0.9 && < 1.0, containers >= 0.4.0 && < 0.7, data-binary-ieee754 >= 0.4.4 && < 0.6, data-default-class >= 0.1.2 && < 0.2, deepseq >= 1.4.1.0 && < 1.6, extra >= 1.6.17 && < 1.8, ghc-prim >= 0.5.1.0 && < 0.12, ghc-typelits-extra >= 0.4 && < 0.5, ghc-typelits-knownnat >= 0.7.2 && < 0.8, ghc-typelits-natnormalise >= 0.7.2 && < 0.8, hashable >= 1.2.1.0 && < 1.5, half >= 0.2.2.3 && < 1.0, infinite-list ^>= 0.1, lens >= 4.10 && < 5.3, QuickCheck >= 2.7 && < 2.15, recursion-schemes >= 5.1 && < 5.3, reflection >= 2 && < 2.2, singletons >= 2.0 && < 3.1, string-interpolate ^>= 0.3, template-haskell >= 2.12.0.0 && < 2.22, th-abstraction >= 0.2.10 && < 0.7.0, th-lift >= 0.7.0 && < 0.9, th-orphans >= 0.13.1 && < 1.0, text >= 0.11.3.1 && < 2.2, time >= 1.8 && < 1.14, transformers >= 0.5.2.0 && < 0.7, type-errors >= 0.2.0.0 && < 0.3, uniplate >= 1.6.12 && < 1.7, vector >= 0.11 && < 1.0, mtl >= 2.0 && < 3.0 if impl(ghc >= 9.0.0) Build-Depends: ghc-bignum >= 1.0 && < 1.4 else Build-Depends: integer-gmp >= 1.0.1.0 && < 2.0 if flag(large-tuples) Build-Depends: ghc test-suite doctests type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: doctests.hs ghc-options: -Wall -Wcompat -threaded hs-source-dirs: tests if !flag(doctests) buildable: False else build-depends: base, clash-prelude, doctest-parallel >= 0.2 && < 0.4, filepath if flag(workaround-ghc-mmap-crash) ghc-options: -with-rtsopts=-xm20000000 test-suite unittests import: common-options type: exitcode-stdio-1.0 main-is: unittests.hs ghc-options: -Wall -Wcompat -threaded -- Note that multiple -with-rtsopts are not cumulative if flag(workaround-ghc-mmap-crash) ghc-options: "-with-rtsopts=-N -xm20000000" else ghc-options: -with-rtsopts=-N hs-source-dirs: tests if !flag(unittests) buildable: False else build-depends: clash-prelude, ghc-typelits-knownnat, ghc-typelits-natnormalise, ghc-typelits-extra, base, bytestring, deepseq, hedgehog >= 1.0.3 && < 1.5, hint >= 0.7 && < 0.10, quickcheck-classes-base >= 0.6 && < 1.0, tasty >= 1.2 && < 1.6, tasty-hedgehog >= 1.2.0, tasty-hunit, tasty-th, tasty-quickcheck, template-haskell Other-Modules: Clash.Tests.AsyncFIFOSynchronizer Clash.Tests.AutoReg Clash.Tests.BitPack Clash.Tests.BitVector Clash.Tests.BlockRam Clash.Tests.BlockRam.Blob Clash.Tests.Clocks Clash.Tests.Counter Clash.Tests.DerivingDataRepr Clash.Tests.DerivingDataReprTypes Clash.Tests.Fixed Clash.Tests.FixedExhaustive Clash.Tests.MaybeX Clash.Tests.NFDataX Clash.Tests.NumNewtypes Clash.Tests.Ram Clash.Tests.Reset Clash.Tests.Resize Clash.Tests.Signal Clash.Tests.Signed Clash.Tests.SizedNum Clash.Tests.TopEntityGeneration Clash.Tests.Unsigned Clash.Tests.Vector Clash.Tests.XException Clash.Tests.Laws.Enum Clash.Tests.Laws.SaturatingNum Hedgehog.Extra Test.Tasty.HUnit.Extra Test.Tasty.Hedgehog.Extra Test.QuickCheck.Extra benchmark benchmark-clash-prelude type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: benchmark-main.hs ghc-options: -O2 -Wall hs-source-dirs: benchmarks ghc-options: -with-rtsopts=-T if !flag(benchmarks) buildable: False else build-depends: base, clash-prelude, criterion >= 1.3.0.0 && < 1.7, directory, deepseq, template-haskell Other-Modules: BenchBitVector BenchCommon BenchFixed BenchRAM BenchSigned BenchUnsigned BenchVector clash-prelude-1.8.1/doc/0000755000000000000000000000000007346545000013207 5ustar0000000000000000clash-prelude-1.8.1/doc/csSort.svg0000644000000000000000000002271207346545000015211 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-05 09:58:26 +0000Canvas 1Layer 17insertinsertinsertinsert<>3911199131379 clash-prelude-1.8.1/doc/firstDF.svg0000644000000000000000000002056007346545000015274 0ustar0000000000000000 2014-11-04 10:45ZCanvas 1Layer 1aaEndatavalidreadydatavalidreadyfaEncEnccEnfirstDF fbbEnbEncEnccEn clash-prelude-1.8.1/doc/fold.svg0000644000000000000000000002423707346545000014664 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-01 14:19:28 +0000Canvas 1Layer 1x0fx1fxnf ...ffff ... ... clash-prelude-1.8.1/doc/foldl.svg0000644000000000000000000001306507346545000015035 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:44:21 +0000Canvas 1Layer 1x0fx1fxnf ...z clash-prelude-1.8.1/doc/foldl1.svg0000644000000000000000000001307007346545000015112 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:55:45 +0000Canvas 1Layer 1x1fx2fxnf ...x0 clash-prelude-1.8.1/doc/foldr.svg0000644000000000000000000001307307346545000015042 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:45:19 +0000Canvas 1Layer 1x0fx1fxnf ...z clash-prelude-1.8.1/doc/foldr1.svg0000644000000000000000000001310707346545000015121 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:53:45 +0000Canvas 1Layer 1x0fx1fx<n-1>f ...xn clash-prelude-1.8.1/doc/generate.svg0000644000000000000000000001155107346545000015525 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:22:29 +0000Canvas 1Layer 1fff ...zLayer 2 clash-prelude-1.8.1/doc/idDF.svg0000644000000000000000000000755507346545000014552 0ustar0000000000000000 2014-11-05 09:25ZCanvas 1Layer 1aEnaaEnidDFaEnaaEn clash-prelude-1.8.1/doc/ifoldl.svg0000644000000000000000000001526407346545000015211 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-01 14:40:22 +0000Canvas 1Layer 1x0fx1fxnf ...zLayer 2‘0’‘1’‘n’ clash-prelude-1.8.1/doc/ifoldr.svg0000644000000000000000000001523407346545000015214 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-01 14:36:30 +0000Canvas 1Layer 1x0fx1fxnf ...z‘0’‘1’‘n’ clash-prelude-1.8.1/doc/imap.svg0000644000000000000000000001413007346545000014655 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-01 14:28:15 +0000Canvas 1Layer 1x0fx1fxnf . . .‘0’‘1’’n’ clash-prelude-1.8.1/doc/iterate.svg0000644000000000000000000001254307346545000015372 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:21:56 +0000Canvas 1Layer 1fff ...zLayer 2 clash-prelude-1.8.1/doc/izipWith.svg0000644000000000000000000001630207346545000015541 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-10-01 14:32:11 +0000Canvas 1Layer 1x0fx1fxnf . . .y0y1yn‘0’‘1’‘n’ clash-prelude-1.8.1/doc/lockStep.svg0000644000000000000000000004360607346545000015525 0ustar0000000000000000 2014-11-05 10:53ZCanvas 1Layer 1datavalidreadydatavalidreadyff `parDF` gdatavalidreadydatavalidreadyg&&&&&&lockStep(f `parDF` g) `seqDF` lockStepdatavalidreadydatavalidreadyh(f `parDF` g) `seqDF` lockStep `seqDF` h clash-prelude-1.8.1/doc/loopDF.svg0000644000000000000000000001752607346545000015126 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-12-11 12:29:21 +0000Canvas 1Layer 1datavalidreadydatavalidreadyhloopDF hfifoDF clash-prelude-1.8.1/doc/loopDF_sync.svg0000644000000000000000000002465307346545000016161 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-12-11 12:37:11 +0000Canvas 1Layer 1datavalidreadydatavalidreadyhstepLockloopDF hlockStepvalidreadyvalidreadyfifoDF clash-prelude-1.8.1/doc/map.svg0000644000000000000000000001200007346545000014476 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:11:34 +0000Canvas 1Layer 1x0fx1fxnf . . . clash-prelude-1.8.1/doc/mapAccumL.svg0000644000000000000000000001417107346545000015576 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:17:21 +0000Canvas 1Layer 1x0fx1fxnf ...accLayer 2 clash-prelude-1.8.1/doc/mapAccumR.svg0000644000000000000000000001414707346545000015607 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:16:26 +0000Canvas 1Layer 1x0fx1fxnf ...acc clash-prelude-1.8.1/doc/parDF.svg0000644000000000000000000002504007346545000014725 0ustar0000000000000000 2014-11-04 10:51ZCanvas 1Layer 1aaEndatavalidreadydatavalidreadyfaEnf `parDF` gbbEnbEnccEndatavalidreadydatavalidreadygcEnddEndEn clash-prelude-1.8.1/doc/scanl.svg0000644000000000000000000001467307346545000015043 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:01:38 +0000Canvas 1Layer 1x0fx1fxnf ...zLayer 2 clash-prelude-1.8.1/doc/scanlPar.svg0000644000000000000000000001733707346545000015506 0ustar0000000000000000 Canvas 1 Layer 1 x0 f x1 x2 x3 f f f clash-prelude-1.8.1/doc/scanr.svg0000644000000000000000000001464407346545000015047 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:03:08 +0000Canvas 1Layer 1x0fx1fxnf ...z clash-prelude-1.8.1/doc/secondDF.svg0000644000000000000000000002056407346545000015424 0ustar0000000000000000 2014-11-04 10:49ZCanvas 1Layer 1aaEndatavalidreadydatavalidreadyfaEncEnccEnsecondDF fbbEnbEncEnccEn clash-prelude-1.8.1/doc/seqDF.svg0000644000000000000000000002155107346545000014736 0ustar0000000000000000 2014-11-05 09:21ZCanvas 1Layer 1aaEndatavalidreadydatavalidreadyfaEnf `seqDF` gbbEnbEncEnccEndatavalidreadydatavalidreadyg clash-prelude-1.8.1/doc/sscanl.svg0000644000000000000000000001370107346545000015215 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:06:21 +0000Canvas 1Layer 1x0fx1fxnf ...zLayer 2 clash-prelude-1.8.1/doc/sscanr.svg0000644000000000000000000001365207346545000015230 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 13:06:17 +0000Canvas 1Layer 1x0fx1fxnf ...z clash-prelude-1.8.1/doc/stepLock.svg0000644000000000000000000004306007346545000015517 0ustar0000000000000000 2014-11-05 13:00ZCanvas 1Layer 1&&datavalidreadydatavalidreadyhh `seqDF` stepLock `seqDF` (f `parDF` g)datavalidreadydatavalidreadyff `parDF` gdatavalidreadydatavalidreadyg&&&&stepLockh `seqDF` stepLock clash-prelude-1.8.1/doc/swapDF.svg0000644000000000000000000001406207346545000015117 0ustar0000000000000000 2014-11-04 11:00ZCanvas 1Layer 1aEnaaEnswapDFbEnbbEnbEnbbEnaEnaaEn clash-prelude-1.8.1/doc/zipWith.svg0000644000000000000000000001412707346545000015373 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:16:36 +0000Canvas 1Layer 1x0fx1fxnf . . .y0y1yn clash-prelude-1.8.1/doc/zipWith3.svg0000644000000000000000000001626607346545000015464 0ustar0000000000000000 Produced by OmniGraffle 6.1.3 2015-05-07 12:18:39 +0000Canvas 1Layer 1x0fx1fxnf . . .y0y1ynz0z1zn clash-prelude-1.8.1/src/Clash/Annotations/0000755000000000000000000000000007346545000016560 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Annotations/BitRepresentation.hs0000644000000000000000000001016307346545000022556 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Using /ANN/ pragma's you can tell the Clash compiler to use a custom bit representation for a data type. See @DataReprAnn@ for documentation. -} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-orphans #-} module Clash.Annotations.BitRepresentation ( -- * Data structures to express a custom bit representation DataReprAnn(..) , ConstrRepr(..) -- * Convenience type synonyms for Integer , BitMask , Value , Size , FieldAnn -- * Functions , liftQ ) where import Data.Data (Data) import Data.Typeable (Typeable) import Language.Haskell.TH.Instances () import qualified Language.Haskell.TH.Lift () import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics (Generic) type BitMask = Integer 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 liftQ :: TH.Lift a => TH.Q a -> TH.Q TH.Exp liftQ = (>>= TH.lift) -- NOTE: The following instances are imported from Language.Haskell.TH.Lift. -- This module also implements 'instance Lift Exp', which might make debugging -- template haskell more difficult. Please uncomment these instances and the -- import of TH.Lift whenever it suits you. -- --deriving instance TH.Lift TH.Name --deriving instance TH.Lift TH.OccName --deriving instance TH.Lift TH.NameFlavour --deriving instance TH.Lift TH.ModName --deriving instance TH.Lift TH.NameSpace --deriving instance TH.Lift TH.PkgName -- | Annotation for custom bit representations of data types -- -- Using /ANN/ pragma's you can tell the Clash compiler to use a custom -- bit-representation for a data type. -- -- For example: -- -- @ -- data Color = R | G | B -- {-# ANN module ('DataReprAnn' -- $('liftQ' [t|Color|]) -- 2 -- [ 'ConstrRepr' 'R 0b11 0b00 [] -- , 'ConstrRepr' 'G 0b11 0b01 [] -- , 'ConstrRepr' 'B 0b11 0b10 [] -- ]) #-} -- @ -- -- This specifies that @R@ should be encoded as 0b00, @G@ as 0b01, and -- @B@ as 0b10. The first binary value in every @ConstrRepr@ in this example -- is a mask, indicating which bits in the data type are relevant. In this case -- all of the bits are. -- -- Or if we want to annotate @Maybe Color@: -- -- @ -- {-# ANN module ( 'DataReprAnn' -- $('liftQ' [t|Maybe Color|]) -- 2 -- [ 'ConstrRepr' 'Nothing 0b11 0b11 [] -- , 'ConstrRepr' 'Just 0b00 0b00 [0b11] -- ] ) #-} -- @ -- -- By default, @Maybe Color@ is a data type which consumes 3 bits. A single bit -- to indicate the constructor (either @Just@ or @Nothing@), and two bits to encode -- the first field of @Just@. Notice that we saved a single bit by exploiting -- the fact that @Color@ only uses three values (0, 1, 2), but takes two bits -- to encode it. We can therefore use the last - unused - value (3), to encode -- one of the constructors of @Maybe@. We indicate which bits encode the -- 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: TH.Type -- Size of type: Size -- Constructors: [ConstrRepr] deriving (Show, Data, Typeable, Eq, Generic, TH.Lift) -- | Annotation for constructors. Indicates how to match this constructor based -- off of the whole datatype. data ConstrRepr = ConstrRepr -- Constructor name: TH.Name -- Bits relevant for this constructor: BitMask -- data & mask should be equal to..: Value -- Masks for fields. Indicates where fields are stored: [FieldAnn] deriving (Show, Data, Typeable, Eq, Generic, TH.Lift) clash-prelude-1.8.1/src/Clash/Annotations/BitRepresentation/0000755000000000000000000000000007346545000022221 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Annotations/BitRepresentation/Deriving.hs0000644000000000000000000010440307346545000024326 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc., 2022, QBayLogic B.V. 2022, LUMI GUIDE FIETSDETECTIE B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. This module contains: * Template Haskell functions for deriving 'BitPack' instances given a custom bit representation as those defined in "Clash.Annotations.BitRepresentation". * Template Haskell functions for deriving custom bit representations, e.g. one-hot, for a data type. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Clash.Annotations.BitRepresentation.Deriving ( -- * Derivation functions deriveAnnotation , deriveBitPack , deriveDefaultAnnotation , derivePackedAnnotation , derivePackedMaybeAnnotation , deriveBlueSpecAnnotation -- * Derivators , defaultDerivator , blueSpecDerivator , packedDerivator , packedMaybeDerivator , simpleDerivator -- * Util functions , dontApplyInHDL -- * Types associated with various functions , ConstructorType(..) , FieldsType(..) -- * Convenience type synonyms , Derivator , DataReprAnnExp ) where import Clash.Annotations.BitRepresentation (DataReprAnn(..), ConstrRepr(..), BitMask, Value, Size, liftQ) import Clash.Annotations.BitRepresentation.Internal (dataReprAnnToDataRepr', constrReprToConstrRepr', DataRepr'(..)) import Clash.Annotations.BitRepresentation.Util (bitOrigins, bitOrigins', BitOrigin(..), bitRanges, Bit) import qualified Clash.Annotations.BitRepresentation.Util as Util import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack, BitSize, pack, packXWith, unpack) import Clash.Class.Resize (resize) import Language.Haskell.TH.Compat (mkTySynInstD) import Clash.Sized.BitVector (BitVector, low, (++#)) import Clash.Sized.Internal.BitVector (undefined#) import Control.Applicative (liftA3) import Control.DeepSeq (NFData) import Control.Monad (forM) import Data.Bits (shiftL, shiftR, complement, (.&.), (.|.), zeroBits, popCount, bit, testBit, Bits, setBit) import Data.Data (Data) import Data.Containers.ListUtils (nubOrd) import Data.List (mapAccumL, zipWith4, sortOn, partition, uncons) import Data.Typeable (Typeable) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Data.Proxy (Proxy(..)) import GHC.Exts (Int(I#)) import GHC.Generics (Generic) import GHC.Integer.Logarithms (integerLog2#) import GHC.TypeLits (natVal) import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Datatype (resolveTypeSynonyms) -- | Used to track constructor bits in packed derivation data BitMaskOrigin = External -- ^ Constructor bit should be stored externally | Embedded BitMask Value -- ^ Constructor bit should be stored in one of the constructor's fields deriving (Show, Data, Typeable, Lift) isExternal :: BitMaskOrigin -> Bool isExternal External = True isExternal _ = False type ReprAnnCache = Map.Map Type DataReprAnn type NameMap = Map.Map Name Type -- | DataReprAnn as template haskell expression type DataReprAnnExp = Exp -- | A derivator derives a bit representation given a type type Derivator = Type -> Q DataReprAnnExp -- | Indicates how to pack constructor for simpleDerivator data ConstructorType = Binary -- ^ First constructor will be encoded as 0b0, the second as 0b1, the third -- as 0b10, etc. | OneHot -- ^ Reserve a single bit for each constructor marker. -- | Indicates how to pack (constructor) fields for simpleDerivator data FieldsType = OverlapL -- ^ Store fields of different constructors at (possibly) overlapping bit -- positions. That is, a data type with two constructors with each two fields -- of each one bit will take /two/ bits for its whole representation (plus -- constructor bits). Overlap is left-biased, i.e. don't care bits are padded -- to the right. -- -- This is the default behavior of Clash. | OverlapR -- ^ Store fields of different constructors at (possibly) overlapping bit -- positions. That is, a data type with two constructors with each two fields -- of each one bit will take /two/ bits for its whole representation (plus -- constructor bits). Overlap is right biased, i.e. don't care bits are padded -- between between the constructor bits and the field bits. | Wide -- ^ Store fields of different constructs at non-overlapping positions. That -- is, a data type with two constructors with each two fields of each one bit -- will take /four/ bits for its whole representation (plus constructor bits). -- | Determine most significant bit set for given integer. -- -- TODO: Current complexity is O(n). We could probably use machine instructions -- for ~constant complexity. msb :: Integer -> Int msb 0 = error $ "Most significant bit does not exist for zero." msb 1 = 0 msb n = 1 + msb (shiftR n 1) mkReprAnnCache :: [DataReprAnn] -> ReprAnnCache mkReprAnnCache anns = Map.fromList [(typ, rAnn) | rAnn@(DataReprAnn typ _ _) <- anns] -- | Integer version of (ceil . log2). Can handle arguments up to 2^(2^WORDWIDTH). integerLog2Ceil :: Integer -> Int integerLog2Ceil n = let nlog2 = fromIntegral $ I# (integerLog2# n) in if n > 2^nlog2 then nlog2 + 1 else nlog2 -- | Determine number of bits needed to represent /n/ options. Alias for -- integerLog2Ceil to increase readability of programmer intentention. bitsNeeded :: Integer -> Int bitsNeeded = integerLog2Ceil #if MIN_VERSION_template_haskell(2,17,0) tyVarBndrName :: TyVarBndr f -> Name tyVarBndrName (PlainTV n _f) = n tyVarBndrName (KindedTV n _f _k) = n #else tyVarBndrName :: TyVarBndr -> Name tyVarBndrName (PlainTV n) = n tyVarBndrName (KindedTV n _k) = n #endif -- | Replace Vars types given in mapping resolve :: NameMap -> Type -> Type resolve nmap (VarT n) = nmap Map.! n resolve nmap (AppT t1 t2) = AppT (resolve nmap t1) (resolve nmap t2) resolve _nmap t@(ConT _) = t resolve _nmap t@(LitT _) = t resolve _nmap t@(TupleT _) = t resolve _nmap t = error $ "Unexpected type: " ++ show t resolveCon :: NameMap -> Con -> Con resolveCon nmap (NormalC t (unzip -> (bangs, fTypes))) = NormalC t $ zip bangs $ map (resolve nmap) fTypes resolveCon nmap (RecC t (unzip3 -> (name, bangs, fTypes))) = RecC t $ zip3 name bangs $ map (resolve nmap) fTypes resolveCon nmap (InfixC (leftB, leftTy) t (rightB, rightTy)) = InfixC (leftB, resolve nmap leftTy) t (rightB, resolve nmap rightTy) resolveCon _name constr = error $ "Unexpected constructor: " ++ show constr collectTypeArgs :: Type -> (Type, [Type]) collectTypeArgs t@(ConT _name) = (t, []) collectTypeArgs (AppT t1 t2) = let (base, args) = collectTypeArgs t1 in (base, args ++ [t2]) collectTypeArgs t = error $ "Unexpected type: " ++ show t -- | Returns size in number of bits of given type. Relies on the presence of a -- BitSize implementation. Tries to recognize literal values and return a simple -- expression. typeSize :: Type -> Q Exp typeSize typ = do bitSizeInstances <- reifyInstances ''BitSize [typ] case bitSizeInstances of [] -> fail $ unwords [ "Could not find custom bit representation nor BitSize instance" , "for", show typ ++ "." ] #if MIN_VERSION_template_haskell(2,15,0) [TySynInstD (TySynEqn _ _ (LitT (NumTyLit n)))] -> #else [TySynInstD _ (TySynEqn _ (LitT (NumTyLit n)))] -> #endif [| n |] [_impl] -> [| fromIntegral $ natVal (Proxy :: Proxy (BitSize $(return typ))) |] unexp -> fail $ "Unexpected result from reifyInstances: " ++ show unexp -- | Generate bitmask from a given bit, with a certain size bitmask :: Int -- ^ Bitmask starts at bit /n/ -> Int -- ^ Bitmask has size /m/ -> Integer bitmask _start 0 = 0 bitmask start size | start < 0 = error $ "Start cannot be <0. Was: " ++ show start | size < 0 = error $ "Size cannot be <0. Was: " ++ show size | start + 1 < size = error $ "Start + 1 (" ++ show start ++ " - 1) cannot be smaller than size (" ++ show size ++ ")." | otherwise = shiftL (2^(toInteger size) - 1) (start - (size - 1)) fieldTypes :: Con -> [Type] fieldTypes (NormalC _nm bTys) = [ty | (_, ty) <- bTys] fieldTypes (RecC _nm bTys) = [ty | (_, _, ty) <- bTys] fieldTypes (InfixC (_, ty1) _nm (_, ty2)) = [ty1, ty2] fieldTypes con = error $ "Unexpected constructor type: " ++ show con conName :: Con -> Name conName c = case c of NormalC nm _ -> nm RecC nm _ -> nm InfixC _ nm _ -> nm _ -> error $ "No GADT support" mkLet :: String -> Q Exp -> (Q Dec, Q Exp) mkLet nm qe = do let nm' = mkName nm (valD (varP nm') (normalB qe) [], varE nm') fieldSizeLets :: [[Type]] -> ([Q Dec], [[Q Exp]]) fieldSizeLets fieldtypess = (fieldSizeDecls, fieldSizessExps) where nums = map show [(0 :: Int)..] uqFieldTypes = nubOrd (concat fieldtypess) uqFieldSizes = map typeSize uqFieldTypes (fieldSizeDecls, szVars) = unzip $ zipWith (\i sz -> mkLet ("_f" ++ i) sz) nums uqFieldSizes tySizeMap = Map.fromList (zip uqFieldTypes szVars) fieldSizessExps = map (map (tySizeMap Map.!)) fieldtypess complementInteger :: Int -> Integer -> Integer complementInteger 0 _i = 0 complementInteger size i = let size' = size - 1 in if testBit i size' then complementInteger size' i else (.|.) (bit size') (complementInteger size' i) deriveAnnotation :: Derivator -> Q Type -> Q [Dec] deriveAnnotation deriv typ = return <$> pragAnnD ModuleAnnotation (deriv =<< typ) -------------------------------------------- ------------ SIMPLE DERIVATIONS ------------ -------------------------------------------- buildConstrRepr :: Q Exp -- ^ Data size (excluding constructor size) -> Name -- ^ Constr name -> [Q Exp] -- ^ Field masks -> BitMask -- ^ Constructor mask -> Value -- ^ Constructor value -> Q Exp buildConstrRepr dataSize constrName fieldAnns constrMask constrValue = [| ConstrRepr constrName $mask $value $(listE fieldAnns) |] where mask = [| shiftL constrMask ($dataSize)|] value = [| shiftL constrValue ($dataSize)|] countConstructor :: [Int] -> [(BitMask, Value)] countConstructor ns = zip (repeat mask) (map toInteger ns) where maskSize = bitsNeeded $ toInteger $ maximum ns + 1 mask = 2^maskSize - 1 oneHotConstructor :: [Int] -> [(BitMask, Value)] oneHotConstructor ns = zip values values where values = [shiftL 1 n | n <- ns] overlapFieldAnnsL :: [[Q Exp]] -> ([Q Dec], [[Q Exp]]) overlapFieldAnnsL fieldSizess = ([maxDecl], resExp) where (maxDecl, maxExp) = mkLet "_maxf" maxConstrSize resExp = map go fieldSizess fieldSizess' = listE $ map listE fieldSizess constructorSizes = [| map (sum @[] @Int) $fieldSizess' |] maxConstrSize = [| maximum $constructorSizes - 1 |] go fieldsizes = snd $ mapAccumL (\start size -> ([| $start - $size |], [| bitmask $start $size |])) maxExp fieldsizes overlapFieldAnnsR :: [[Q Exp]] -> ([Q Dec], [[Q Exp]]) overlapFieldAnnsR fieldSizess = (sumFieldDecl, resExp) where resExp = zipWith go fieldSizess sumFieldExp nums = map show [(0 :: Int) ..] (sumFieldDecl, sumFieldExp) = unzip $ zipWith (\fs i -> mkLet ("_sumf" ++ i) [|sum @[] @Int $(listE fs)|]) fieldSizess nums go fieldSizes sumFieldsSize = snd $ mapAccumL (\start size -> ([| $start - $size |], [| bitmask $start $size |])) [| $sumFieldsSize - 1 |] fieldSizes wideFieldAnns :: [[Q Exp]] -> ([Q Dec], [[Q Exp]]) wideFieldAnns fieldSizess = (decs, resExp) where decs = (dataSizeDec:constrSizeDecs) ++ constrOffsetDecs resExp = zipWith id (map go constrOffsetsExps) fieldSizess nums = map show [(0 :: Int) ..] constrSizeExps :: [Q Exp] (constrSizeDecs, constrSizeExps) = unzip $ zipWith (\fs i -> mkLet ("_sumf" ++ i) [|sum @[] @Int $(listE fs)|]) fieldSizess nums constrOffsetsExps :: [Q Exp] (last -> constrOffsetDecs, constrOffsetsExps) = unzip $ init $ scanl (\(ds, offset) (size, i) -> let e = [| $offset + $size |] (d, ve) = mkLet ("_constroffset" ++ i) e in (d:ds, ve) ) ([], [| 0 |]) (zip constrSizeExps nums) dataSizeExp :: Q Exp (dataSizeDec, dataSizeExp) = mkLet "_widedatasize" [| sum @[] @Int $(listE constrSizeExps) - 1 |] go :: Q Exp -> [Q Exp] -> [Q Exp] go offset fieldSizes = snd $ mapAccumL (\start size -> ([| $start - $size |], [| bitmask $start $size |])) [| $dataSizeExp - $offset |] fieldSizes -- | Derive DataRepr' for a specific type. deriveDataRepr :: ([Int] -> [(BitMask, Value)]) -- ^ Constructor derivator -> ([[Q Exp]] -> ([Q Dec], [[Q Exp]]) ) -- ^ Field derivator -> Derivator deriveDataRepr constrDerivator fieldsDerivator typ = do let (fun, typeArgs) = collectTypeArgs typ tyConstrName = case fun of ConT t -> t _ -> error ("deriveDataRep: expecting type constructor, but got: " <> show fun) info <- reify tyConstrName case info of (TyConI (DataD [] _constrName vars _kind dConstructors _clauses)) -> let varMap = Map.fromList $ zip (map tyVarBndrName vars) typeArgs in let resolvedConstructors = map (resolveCon varMap) dConstructors in do let nums = map show [(0 :: Int)..] let fieldtypess = map fieldTypes resolvedConstructors let (fieldSzDecs, fieldSizess) = fieldSizeLets fieldtypess -- Get sizes and names of all constructors let constrNames = map conName resolvedConstructors let (constrMasks, constrValues) = unzip $ constrDerivator [0..length dConstructors - 1] let constrSize = 1 + (msb $ maximum @[] @Integer constrMasks) let (fieldDecs, fieldAnns) = fieldsDerivator fieldSizess -- extract field annotations into declarations let mkAnnDecl i j an = mkLet ("_fa" ++ i ++ "_" ++ j) an let fieldAnnTup = zipWith (\i -> zipWith (mkAnnDecl i) nums) nums fieldAnns let (fieldAnnDecs, fieldAnnVars) = (concat $ map (map fst) fieldAnnTup, map (map snd) fieldAnnTup) let fieldAnnsFlat = listE $ concat fieldAnnVars let dataSize | null $ concat fieldAnns = [| 0 |] | otherwise = [| 1 + (msb $ maximum @[] @Integer $ $fieldAnnsFlat) |] -- Extract data size into a declaration let (dataSizeDec, dataSizeExp) = mkLet "_datasize" dataSize let decls = (dataSizeDec:fieldSzDecs) ++ fieldDecs ++ fieldAnnDecs -- Determine at which bits various fields start let constrReprs = zipWith4 (buildConstrRepr dataSizeExp) constrNames fieldAnnVars constrMasks constrValues resolvedType <- resolveTypeSynonyms typ letE decls [| DataReprAnn $(liftQ $ return resolvedType) ($dataSizeExp + constrSize) $(listE constrReprs) |] _ -> fail $ "Could not derive dataRepr for: " ++ show info -- | Simple derivators change the (default) way Clash stores data types. It -- assumes no overlap between constructors and fields. simpleDerivator :: ConstructorType -> FieldsType -> Derivator simpleDerivator ctype ftype = deriveDataRepr constrDerivator fieldsDerivator where constrDerivator = case ctype of Binary -> countConstructor OneHot -> oneHotConstructor fieldsDerivator = case ftype of OverlapL -> overlapFieldAnnsL OverlapR -> overlapFieldAnnsR Wide -> wideFieldAnns -- | Derives bit representation corresponding to the default manner in which -- Clash stores types. defaultDerivator :: Derivator defaultDerivator = simpleDerivator Binary OverlapL -- | Derives bit representation corresponding to the default manner in which -- BlueSpec stores types. blueSpecDerivator :: Derivator blueSpecDerivator = simpleDerivator Binary OverlapR -- | Derives bit representation corresponding to the default manner in which -- Clash stores types. deriveDefaultAnnotation :: Q Type -> Q [Dec] deriveDefaultAnnotation = deriveAnnotation defaultDerivator -- | Derives bit representation corresponding to the default manner in which -- BlueSpec stores types. deriveBlueSpecAnnotation :: Q Type -> Q [Dec] deriveBlueSpecAnnotation = deriveAnnotation blueSpecDerivator --------------------------------------------------------------- ------------ DERIVING PACKED MAYBE REPRESENTATIONS ------------ --------------------------------------------------------------- toBits' :: Bits a => Size -> a -> [Bit'] toBits' 0 _ = [] toBits' size bits = bit' : toBits' (size - 1) bits where bit' = if testBit bits (size - 1) then H else L bitsToInteger' :: (Bit' -> Bool) -> [Bit'] -> Integer bitsToInteger' predFunc bits = foldl setBit 0 toSet where toSet = [n | (n, b) <- zip [0..] (reverse bits), predFunc b] bitsToInteger :: [Bit'] -> Integer bitsToInteger = bitsToInteger' (==H) bitsToMask :: [Bit'] -> Integer bitsToMask = bitsToInteger' (\b -> b == H || b == L) data Bit' = X -- ^ Could be both 1 or 0 | L -- ^ 0 | H -- ^ 1 | U -- ^ Unused deriving (Show, Eq, Generic, NFData) -- | Given a number of possible values, construct a list of all complement values. -- For example, Given a list: -- -- @ -- [[HH, HH], [LL, LL]] -- @ -- -- then: -- -- @ -- [[HH, LL], [LL, HH]] -- @ -- -- would be complements. complementValues :: Size -> [[Bit']] -> [[Bit']] complementValues 0 _ = [] complementValues 1 xs | X `elem` xs' = [] | H `elem` xs' && L `elem` xs' = [] | H `elem` xs' = [[L]] | otherwise = [[H]] where xs' = map (maybe (error "complementValues: expected at least 1 bit") fst . uncons) xs complementValues size [] = [replicate size U] complementValues size values = if | all (maybe False ((==U) . fst) . uncons) values' -> map (U:) (recc (map (drop 1) values')) | any (maybe False ((==X) . fst) . uncons) values' -> map (X:) (recc (map (drop 1) values')) | otherwise -> (map (L:) (recc (map (drop 1) lows))) ++ (map (H:) (recc (map (drop 1) highs'))) where values' = filter (any (/= U)) values recc = complementValues (size - 1) (highs, lows) = partition (maybe False ((== H) . fst) . uncons) values' highs' = highs ++ filter (maybe False ((`elem` [X, U]) . fst) . uncons) values' -- | Generate all bitvalues the given type can assume. possibleValues :: ReprAnnCache -> Type -> Size -> Q [[Bit']] possibleValues typeMap typ size = let typeName = case fst (collectTypeArgs typ) of ConT t -> t fun -> error ("possibleValues: expected a type constructor, but got" <> show fun) in case Map.lookup typ typeMap of -- No custom data representation found. Nothing -> do info <- reify typeName case info of -- TODO: check if fields have custom bit representations (TyConI (DataD [] _constrName _vars _kind dConstructors _clauses)) -> let nConstrBits = bitsNeeded (toInteger $ length dConstructors) in let fieldBits = replicate (size - nConstrBits) X in let constrBits = [toBits' nConstrBits n | n <- [0..length dConstructors - 1]] in return $ zipWith (++) constrBits (repeat fieldBits) _ -> return [replicate size X] Just (dataReprAnnToDataRepr' -> dataRepr) -> -- TODO: check if fields have custom bit representations let (DataRepr' _name _size constrs) = dataRepr in forM constrs $ \constr -> do return $ map (\case { Lit [Util.H] -> H; Lit [Util.L] -> L; Lit [Util.U] -> U; Field _ _ _ -> X; c -> error $ "possibleValues (2): unexpected: " ++ show c; }) (bitOrigins' dataRepr constr) packedMaybe :: Size -> Type -> Q (Maybe DataReprAnn) packedMaybe size typ = do cache <- mkReprAnnCache <$> collectDataReprs values <- possibleValues cache typ size return $ case complementValues size values of (value:_) -> Just $ DataReprAnn (AppT (ConT ''Maybe) typ) size [ ConstrRepr 'Nothing (bitsToMask value) (bitsToInteger value) [] , ConstrRepr 'Just 0 0 [bitmask (size - 1) size] ] [] -> Nothing packedMaybeDerivator :: DataReprAnn -> Derivator packedMaybeDerivator (DataReprAnn _ size _) typ = case maybeCon of ConT nm -> 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?" ] packedM <- packedMaybe (size - 1) (maybe (error "Maybe type without argument") fst (uncons maybeTyps)) (fromMaybe (fail err) . fmap lift) packedM else fail $ unwords [ "You can only pass Maybe types to packedMaybeDerivator," , "not", show nm] unexpected -> fail $ "packedMaybeDerivator: unexpected constructor: " ++ show unexpected where (maybeCon, maybeTyps) = collectTypeArgs typ -- | Derive a compactly represented version of @Maybe a@. derivePackedMaybeAnnotation :: DataReprAnn -> Q [Dec] derivePackedMaybeAnnotation defaultDataRepr@(DataReprAnn typ _ _) = do deriveAnnotation (packedMaybeDerivator defaultDataRepr) (return typ) --------------------------------------------------------- ------------ DERIVING PACKED REPRESENTATIONS ------------ --------------------------------------------------------- packedConstrRepr :: Int -- ^ Data width -> Int -- ^ External constructor width -> Int -- ^ nth External so far -> [(BitMaskOrigin, ConstrRepr)] -> [ConstrRepr] packedConstrRepr _ _ _ [] = [] packedConstrRepr dataWidth constrWidth n ((External, ConstrRepr name _ _ anns) : constrs) = constr : packedConstrRepr dataWidth constrWidth (n+1) constrs where constr = ConstrRepr name (shiftL (2^constrWidth - 1) dataWidth) (shiftL (toInteger n) dataWidth) anns packedConstrRepr dataWidth constrWidth n ((Embedded mask value, ConstrRepr name _ _ anns) : constrs) = constr : packedConstrRepr dataWidth constrWidth n constrs where constr = ConstrRepr name mask value anns packedDataRepr :: Type -> Size -> [(BitMaskOrigin, ConstrRepr)] -> DataReprAnn packedDataRepr typ dataWidth constrs = DataReprAnn typ (dataWidth + constrWidth) (packedConstrRepr dataWidth constrWidth 0 constrs) where external = filter isExternal (map fst constrs) constrWidth = bitsNeeded $ toInteger $ min (length external + 1) (length constrs) -- | Try to distribute constructor bits over fields storeInFields :: Int -- ^ data width -> BitMask -- ^ Additional mask gathered so far -> [BitMask] -- ^ Repr bitmasks to try and pack -> [BitMaskOrigin] storeInFields _dataWidth _additionalMask [] = [] storeInFields _dataWidth _additionalMask [_] = -- Last constructor is implict [Embedded 0 0] storeInFields dataWidth additionalMask constrs@(constr:constrRest) = if commonMask == fullMask then -- We can't store the constructor anywhere special, so we need a special -- constructor bit stored besides fields External : storeInFields dataWidth additionalMask constrRest else -- Hooray, we can store it somewhere. maskOrigins ++ (storeInFields dataWidth additionalMask' (drop storeSize constrs)) where headMask = constr commonMask = (.|.) headMask additionalMask -- Variables for the case that we can store something: storeMask = complementInteger dataWidth commonMask additionalMask' = (.|.) additionalMask storeMask storeSize = 2^(popCount storeMask) - 1 maskOrigins = [Embedded storeMask (toInteger n) | n <- [1..storeSize]] -- BitMask which spans the complete data size fullMask = 2^dataWidth - 1 derivePackedAnnotation' :: DataReprAnn -> DataReprAnn derivePackedAnnotation' (DataReprAnn typ size constrs) = dataRepr where constrWidth = bitsNeeded $ toInteger $ length constrs dataWidth = size - constrWidth fieldMasks = [foldl (.|.) zeroBits anns | ConstrRepr _ _ _ anns <- constrs] -- Default annotation will overlap "to the left", so sorting on size will -- actually provide us with the 'fullest' constructors first and the -- 'empties' last. sortedMasks = reverse $ sortOn fst $ zip fieldMasks constrs origins = storeInFields dataWidth zeroBits (map fst sortedMasks) constrs' = zip origins $ map snd sortedMasks dataRepr = packedDataRepr typ dataWidth constrs' -- | This derivator tries to distribute its constructor bits over space left -- by the difference in constructor sizes. Example: -- -- @ -- type SmallInt = Unsigned 2 -- -- data Train -- = Passenger SmallInt -- | Freight SmallInt SmallInt -- | Maintenance -- | Toy -- @ -- -- The packed representation of this data type needs only a single constructor -- bit. The first bit discriminates between @Freight@ and non-@Freight@ -- constructors. All other constructors do not use their last two bits; the -- packed representation will store the rest of the constructor bits there. packedDerivator :: Derivator packedDerivator typ = [| derivePackedAnnotation' $(defaultDerivator typ ) |] derivePackedAnnotation :: Q Type -> Q [Dec] derivePackedAnnotation = deriveAnnotation packedDerivator ---------------------------------------------------- ------------ DERIVING BITPACK INSTANCES ------------ ---------------------------------------------------- -- | Collect data reprs of current module collectDataReprs :: Q [DataReprAnn] collectDataReprs = do thisMod <- thisModule unresolved <- go [thisMod] Set.empty [] mapM resolveTyps unresolved where resolveTyps (DataReprAnn t s c) = liftA3 DataReprAnn (resolveTypeSynonyms t) (pure s) (pure c) go [] _visited acc = return acc go (x:xs) visited acc | x `Set.member` visited = go xs visited acc | otherwise = do ModuleInfo newMods <- reifyModule x newAnns <- reifyAnnotations $ AnnLookupModule x go (newMods ++ xs) (x `Set.insert` visited) (newAnns ++ acc) group :: [Bit] -> [(Int, Bit)] group [] = [] group bs@(b:_) = (length head', b) : rest where tail' = dropWhile (==b) bs head' = takeWhile (==b) bs rest = group tail' bitToExpr' :: (Int, Bit) -> Q Exp -- BitVector n bitToExpr' (0, _) = fail $ "Unexpected group length: 0" bitToExpr' (numTyLit' -> n, Util.H) = [| complement (resize (pack low) :: BitVector $n) |] bitToExpr' (numTyLit' -> n, Util.L) = [| resize (pack low) :: BitVector $n |] bitToExpr' (numTyLit' -> n, _) = [| undefined# :: BitVector $n |] bitsToExpr :: [Bit] -> Q Exp -- BitVector n bitsToExpr [] = fail $ "Unexpected empty bit list" bitsToExpr bits = foldl1 (\v1 v2 -> [| $v1 ++# $v2 |]) (map bitToExpr' $ group bits) numTyLit' :: Integral a => a -> Q Type numTyLit' n = LitT <$> (numTyLit $ toInteger n) -- | Select a list of ranges from a bitvector expression select' :: Exp -> [(Int, Int)] -> Q Exp select' _vec [] = fail $ "Unexpected empty list of intervals" select' vec ranges = foldl1 (\v1 v2 -> [| $v1 ++# $v2 |]) $ map (return . select'') ranges where select'' :: (Int, Int) -> Exp select'' (from, downto) = let size = from - downto + 1 in let shifted | downto == 0 = vec | otherwise = AppE (AppE (VarE 'shiftR) vec) (LitE $ IntegerL $ toInteger downto) in SigE -- Select from whole vector (AppE (VarE 'resize) shifted) -- Type signature: (AppT (ConT ''BitVector) (LitT $ NumTyLit $ toInteger size)) -- | Select a range (bitorigin) from a bitvector select :: [Exp] -- ^ BitVectors of fields -> BitOrigin -- ^ Select bits -> Q Exp select _fields (Lit []) = fail $ "Unexpected empty literal." select _fields (Lit lits) = do let size = length lits vec <- bitsToExpr lits return $ SigE -- Apply bLit to literal string vec -- Type signature: (AppT (ConT ''BitVector) (LitT $ NumTyLit $ toInteger size)) select fields (Field fieldn from downto) = select' (fields !! fieldn) [(from, downto)] buildPackMatch :: DataReprAnn -> ConstrRepr -> Q Match buildPackMatch dataRepr cRepr@(ConstrRepr name _ _ fieldanns) = do fieldNames <- mapM (\n -> newName $ "field" ++ show n) [0..length fieldanns-1] fieldPackedNames <- mapM (\n -> newName $ "fieldPacked" ++ show n) [0..length fieldanns-1] let packed fName = AppE (VarE 'pack) (VarE fName) let pack' pName fName = ValD (VarP pName) (NormalB $ packed fName) [] let fieldPackedDecls = zipWith pack' fieldPackedNames fieldNames let origins = bitOrigins (dataReprAnnToDataRepr' dataRepr) (constrReprToConstrRepr' undefined cRepr) vec <- foldl1 (\v1 v2 -> [| $v1 ++# $v2 |]) (map (select $ map VarE fieldPackedNames) origins) #if MIN_VERSION_template_haskell(2,18,0) return $ Match (ConP name [] (VarP <$> fieldNames)) (NormalB vec) fieldPackedDecls #else return $ Match (ConP name (VarP <$> fieldNames)) (NormalB vec) fieldPackedDecls #endif -- | Build a /pack/ function corresponding to given DataRepr buildPack :: DataReprAnn -> Q [Dec] buildPack dataRepr@(DataReprAnn _name _size constrs) = do argNameIn <- newName "toBePackedIn" argName <- newName "toBePacked" constrs' <- mapM (buildPackMatch dataRepr) constrs let packBody = CaseE (VarE argName) constrs' let packLambda = LamE [VarP argName] packBody let packApplied = (VarE 'dontApplyInHDL) `AppE` (VarE 'packXWith `AppE` packLambda) `AppE` (VarE argNameIn) let func = FunD 'pack [Clause [VarP argNameIn] (NormalB packApplied) []] return [func] -- | In Haskell apply the first argument to the second argument, -- in HDL just return the second argument. -- -- This is used in the generated pack/unpack to not do anything in HDL. dontApplyInHDL :: (a -> b) -> a -> b dontApplyInHDL f a = f a -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE dontApplyInHDL #-} {-# ANN dontApplyInHDL hasBlackBox #-} buildUnpackField :: Name -> Integer -> Q Exp buildUnpackField valueName mask = let ranges = bitRanges mask in let vec = select' (VarE valueName) ranges in [| unpack $vec |] buildUnpackIfE :: Name -> ConstrRepr -> Q (Guard, Exp) buildUnpackIfE valueName (ConstrRepr name mask value fieldanns) = do let valueName' = return $ VarE valueName guard <- NormalG <$> [| ((.&.) $valueName' mask) == value |] fields <- mapM (buildUnpackField valueName) fieldanns return (guard, foldl AppE (ConE name) fields) -- | Build an /unpack/ function corresponding to given DataRepr buildUnpack :: DataReprAnn -> Q [Dec] buildUnpack (DataReprAnn _name _size constrs) = do argNameIn <- newName "toBeUnpackedIn" argName <- newName "toBeUnpacked" matches <- mapM (buildUnpackIfE argName) constrs let fallThroughLast [] = [] fallThroughLast [(_,e)] = [(NormalG (ConE 'True), e)] fallThroughLast (x:xs) = x:fallThroughLast xs let unpackBody = MultiIfE (fallThroughLast matches) let unpackLambda = LamE [VarP argName] unpackBody let unpackApplied = (VarE 'dontApplyInHDL) `AppE` unpackLambda `AppE` (VarE argNameIn) let func = FunD 'unpack [Clause [VarP argNameIn] (NormalB unpackApplied) []] return [func] -- | Derives BitPack instances for given type. Will account for custom bit -- representation annotations in the module where the splice is ran. Note that -- 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 rTyp <- resolveTypeSynonyms typ ann <- case filter (\(DataReprAnn t _ _) -> t == rTyp) anns of [a] -> return a [] -> fail "No custom bit annotation found." _ -> fail "Overlapping bit annotations found." packFunc <- buildPack ann unpackFunc <- buildUnpack ann let (DataReprAnn _name dataSize _constrs) = ann let bitSizeInst = mkTySynInstD ''BitSize [typ] (LitT (NumTyLit $ toInteger dataSize)) let bpInst = [ InstanceD (Just Overlapping) -- Overlap [] -- Context (AppT (ConT ''BitPack) typ) -- Type (bitSizeInst : packFunc ++ unpackFunc) -- Declarations ] alreadyIsInstance <- isInstance ''BitPack [typ] if alreadyIsInstance then fail $ show typ ++ " already has a BitPack instance." else return bpInst clash-prelude-1.8.1/src/Clash/Annotations/BitRepresentation/Internal.hs0000644000000000000000000001135507346545000024336 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc. 2022, LUMI GUIDE FIETSDETECTIE B.V. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Clash.Annotations.BitRepresentation.Internal ( buildCustomReprs , dataReprAnnToDataRepr' , constrReprToConstrRepr' , getConstrRepr , uncheckedGetConstrRepr , getDataRepr , thTypeToType' , ConstrRepr'(..) , DataRepr'(..) , Type'(..) , CustomReprs ) where import Clash.Annotations.BitRepresentation (BitMask, Value, Size, FieldAnn, DataReprAnn(..), ConstrRepr(..)) import Control.DeepSeq (NFData) 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) -- | Simple version of template haskell type. Used internally to match on. data Type' = AppTy' Type' Type' -- ^ Type application | ConstTy' Text.Text -- ^ Qualified name of type | LitTy' Integer -- ^ Numeral literal (used in BitVector 10, for example) | SymLitTy' Text.Text -- ^ Symbol literal (used in for example (Signal "System" Int)) deriving (Generic, NFData, Eq, Typeable, Hashable, Ord, Show) -- | Internal version of DataRepr 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' { 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) = ConstrRepr' (thToText name) n mask value (map fromIntegral fieldanns) dataReprAnnToDataRepr' :: DataReprAnn -> DataRepr' dataReprAnnToDataRepr' (DataReprAnn typ size constrs) = DataRepr' (thTypeToType' typ) size (zipWith constrReprToConstrRepr' [0..] constrs) thToText :: TH.Name -> Text.Text thToText (TH.Name (TH.OccName name') (TH.NameG _namespace _pkgName (TH.ModName modName))) = Text.pack $ modName ++ "." ++ name' thToText name' = error $ "Unexpected pattern: " ++ show name' -- | Convert template haskell type to simple representation of type thTypeToType' :: TH.Type -> Type' thTypeToType' ty = go ty where go (TH.ConT name') = ConstTy' (thToText name') go (TH.PromotedT name') = ConstTy' (thToText name') go (TH.AppT ty1 ty2) = AppTy' (go ty1) (go ty2) go (TH.LitT (TH.NumTyLit n)) = LitTy' n go (TH.LitT (TH.StrTyLit lit)) = SymLitTy' (Text.pack lit) go _ = error $ "Unsupported type: " ++ show ty -- | Convenience type for index built by buildCustomReprs type CustomReprs = ( Map.Map Type' DataRepr' , Map.Map Text.Text ConstrRepr' ) -- | Lookup data type representation based on name getDataRepr :: Type' -> CustomReprs -> Maybe DataRepr' getDataRepr name (reprs, _) = Map.lookup name reprs -- | Lookup constructor representation based on name 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 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 addCustomRepr (Map.empty, Map.empty) clash-prelude-1.8.1/src/Clash/Annotations/BitRepresentation/Util.hs0000644000000000000000000001170407346545000023475 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} module Clash.Annotations.BitRepresentation.Util ( bitOrigins , bitOrigins' , bitRanges , isContinuousMask , BitOrigin(..) , Bit(..) ) where import Clash.Annotations.BitRepresentation.Internal (DataRepr'(..), ConstrRepr'(..)) import Data.Bits (Bits, testBit, testBit, shiftR, (.|.)) import Data.List (findIndex, group, mapAccumL, uncons) import Data.Tuple (swap) data Bit -- | High = H -- | Low | L -- | Undefined | U deriving (Show,Eq) -- | Result of various utilty functions. Indicates the origin of a certain bit: -- either a literal from the constructor (or an undefined bit), or from a -- literal. data BitOrigin -- | Literal (high, low, undefind) = Lit [Bit] -- | Bits originate from a field. Field /fieldnr/ /from/ /downto/. | Field Int -- Field number Int -- Start bit (from..) Int -- End bit (inclusive, ..downto) deriving (Show) -- | Same as bitOrigins, but each item in result list represents a single bit. bitOrigins' :: DataRepr' -> ConstrRepr' -> [BitOrigin] bitOrigins' (DataRepr' _ size constrs) (ConstrRepr' _ _ mask value fields) = map bitOrigin (reverse [0..fromIntegral $ size - 1]) where commonMask = foldl (.|.) 0 [m | ConstrRepr' _ _ m _ _ <- constrs] -- | Determine origin of single bit bitOrigin :: Int -> BitOrigin bitOrigin n = if testBit mask n then Lit [if testBit value n then H else L] else case findIndex (\fmask -> testBit fmask n) fields of Nothing -> if testBit commonMask n then -- This bit is not used in this constructor, nor is it part of -- a field. We cannot leave this value uninitialized though, as -- this would result in undefined behavior when matching other -- constructors. We therefore take a /default/ bit value. Lit [if testBit value n then H else L] else -- This bit is not used in this constructor, nor is it part of -- a field, nor is it used in other constructors. It is safe to -- leave this bit uninitialized. Lit [U] Just fieldn -> let fieldbitn = length $ filter id $ take n $ bitsToBools (fields !! fieldn) in Field fieldn fieldbitn fieldbitn -- | Given a type size and one of its constructor this function will yield a -- specification of which bits the whole type is made up of. I.e., a -- construction plan on how to make the whole data structure, given its -- individual constructor fields. bitOrigins :: DataRepr' -> ConstrRepr' -> [BitOrigin] bitOrigins dataRepr constrRepr = mergeOrigins (bitOrigins' dataRepr constrRepr) -- | Merge consequtive Constructor and Field fields (if applicable). mergeOrigins :: [BitOrigin] -> [BitOrigin] mergeOrigins (Lit n : Lit n' : fs) = -- Literals can always be merged: mergeOrigins $ Lit (n ++ n') : fs mergeOrigins (Field n s e : Field n' s' e' : fs) -- Consequtive fields with same field number merged: | n == n' = mergeOrigins $ Field n s e' : fs -- No merge: | otherwise = Field n s e : mergeOrigins (Field n' s' e' : fs) -- Base cases: mergeOrigins (x:fs) = x : mergeOrigins fs mergeOrigins [] = [] -- | Convert a number to a list of its bits -- Output is ordered from least to most significant bit. -- Only outputs bits until the highest set bit. -- -- @ -- > map bitsToBools [0..2] -- [[],[True],[False,True]]) -- @ -- -- This also works for variable sized number like Integer. -- But not for negative numbers, because negative Integers have infinite bits set. bitsToBools :: (Num a, Bits a, Ord a) => a -> [Bool] bitsToBools 0 = [] bitsToBools n | n < 0 = error "Can't deal with negative bitmasks/values" | otherwise = testBit n 0 : bitsToBools (n `shiftR` 1) offsets :: Int -- ^ Offset -> [Bool] -- ^ Group -> (Int, (Int, [Bool])) offsets offset group' = (length group' + offset, (offset, group')) -- | Determine consecutively set bits in word. Will produce ranges from high -- to low. Examples: -- -- bitRanges 0b10 == [(1,1)] -- bitRanges 0b101 == [(2,2),(0,0)] -- bitRanges 0b10011001111 == [(10,10),(7,6),(3,0)] -- bitRanges :: Integer -> [(Int, Int)] bitRanges word = reverse $ map swap ranges where ranges = map (\(ofs, grp) -> (ofs, ofs+length grp-1)) groups' groups' = filter (maybe False fst . uncons . snd) groups groups = snd $ mapAccumL offsets 0 (group bits) bits = bitsToBools word isContinuousMask :: Integer -> Bool isContinuousMask word = -- Use case expression so we avoid calculating all groups case bitRanges word of -- At least two groups: (_:_:_) -> False -- Zero or one group: _ -> True clash-prelude-1.8.1/src/Clash/Annotations/Primitive.hs0000644000000000000000000002264007346545000021070 0ustar0000000000000000{-| Copyright : (C) 2017-2019, Myrtle Software 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Instruct the Clash compiler to look for primitive HDL templates provided inline or in a specified directory. For distribution of new packages with primitive HDL templates. Primitive guards can be added to warn on instantiating primitives. -} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Annotations.Primitive ( dontTranslate , hasBlackBox , warnNonSynthesizable , warnAlways , Primitive(..) , HDL(..) , PrimitiveGuard(..) , PrimitiveWarning(..) , extractPrim , extractWarnings ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Data import Data.Hashable (Hashable) import GHC.Generics (Generic) -- The commented code directly below this comment is affected by an old -- GHC bug: https://gitlab.haskell.org/ghc/ghc/-/issues/5463. In short, NOINLINE -- pragmas generated by Template Haskell, get ignored. We'd still like a better -- API than manually having to write all the guard/inline pragmas some day, -- so I'm leaving the code in for now. {- guard :: TH.Exp -> TH.Name -> TH.Q [TH.Dec] guard guardExpr fName = pure [ TH.PragmaD (TH.InlineP fName TH.NoInline TH.FunLike TH.AllPhases) , TH.PragmaD (TH.AnnP (TH.ValueAnnotation fName) (TH.SigE guardExpr typ)) ] where typ = TH.AppT (TH.ConT ''PrimitiveGuard) (TH.TupleT 0) applyUnit :: TH.Exp -> TH.Exp applyUnit e = TH.AppE e (TH.TupE []) -- | Mark a function as having a primitive. Clash will yield an error if it -- needs to translate this function, but no blackbox was loaded. Usage: -- -- @ -- $(hasBlackBox 'f) -- @ -- -- If you don't want to use TemplateHaskell, add these annotations: -- -- @ -- {-# NOINLINE f #-} -- {-# ANN f (HasBlackBox ()) #-} -- @ -- hasBlackBox :: TH.Name -> TH.Q [TH.Dec] hasBlackBox = guard (applyUnit (TH.ConE 'HasBlackBox)) -- | Mark a function as non translatable. Clash will yield an error if -- it needs to translate this function. Usage: -- -- @ -- $(dontTranslate 'f) -- @ -- -- If you don't want to use TemplateHaskell, add these annotations: -- -- @ -- {-# NOINLINE f #-} -- {-# ANN f DontTranslate #-} -- @ -- dontTranslate :: TH.Name -> TH.Q [TH.Dec] dontTranslate = guard (TH.ConE 'DontTranslate) -- | Mark a function as non synthesizable. Clash will emit the given warning -- if instantiated outside of a testbench context. Usage: -- -- @ -- $(warnNonSynthesizable 'f "Tread carefully, user!") -- @ -- -- If you don't want to use TemplateHaskell, add these annotations: -- -- @ -- {-# NOINLINE f #-} -- {-# ANN f (WarnNonSynthesizable "Tread carefully, user!" ()) #-} -- @ -- warnNotSynthesizable :: TH.Name -> String -> TH.Q [TH.Dec] warnNotSynthesizable nm warning = guard (applyUnit (TH.AppE (TH.ConE 'WarnNonSynthesizable) (TH.LitE (TH.StringL warning)))) nm -- | Emit warning when translating this value. -- -- @ -- $(warnAlways 'f "Tread carefully, user!") -- @ -- -- If you don't want to use TemplateHaskell, add these annotations: -- -- @ -- {-# NOINLINE f #-} -- {-# ANN f (WarnAlways "Tread carefully, user!" ()) #-} -- @ -- warnAlways :: TH.Name -> String -> TH.Q [TH.Dec] warnAlways nm warning = guard (applyUnit (TH.AppE (TH.ConE 'WarnAlways) (TH.LitE (TH.StringL warning)))) nm -} -- | Marks value as not translatable. Clash will error if it finds a blackbox -- definition for it, or when it is forced to translate it. You can annotate a -- variable or function @f@ like: -- -- @ -- {\-\# ANN f dontTranslate \#-\} -- @ dontTranslate :: PrimitiveGuard () dontTranslate = DontTranslate -- | Marks a value as having a blackbox. Clash will error if it hasn't found -- a blackbox. You can annotate a variable or function @f@ like: -- -- @ -- {\-\# ANN f hasBlackBox \#-\} -- @ hasBlackBox :: PrimitiveGuard () hasBlackBox = HasBlackBox [] () -- | Marks value as non-synthesizable. This will trigger a warning if -- instantiated in a non-testbench context. You can annotate a variable or -- function @f@ like: -- -- @ -- {\-\# ANN f (warnNonSynthesizable "Tread carefully, user!") \#-\} -- @ -- -- Implies `hasBlackBox`. warnNonSynthesizable :: String -> PrimitiveGuard () warnNonSynthesizable s = HasBlackBox [WarnNonSynthesizable s] () -- | Always emit warning upon primitive instantiation. You can annotate a -- variable or function @f@ like: -- -- @ -- {\-\# ANN f (warnAlways "Tread carefully, user!") \#-\} -- @ -- -- Implies `hasBlackBox`. warnAlways :: String -> PrimitiveGuard () warnAlways s = HasBlackBox [WarnAlways s] () -- | A compilation target HDL. data HDL = SystemVerilog | Verilog | VHDL 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 -- provides the HDL template inline. They are intended for the distribution of -- new packages with primitive HDL templates. -- -- === Example of 'Primitive' -- -- You have some existing IP written in one of HDLs supported by Clash, and -- you want to distribute some bindings so that the IP can be easily instantiated -- from Clash. -- -- You create a package which has a @myfancyip.cabal@ file with the following stanza: -- -- @ -- data-files: path\/to\/MyFancyIP.primitives -- cpp-options: -DCABAL -- @ -- -- and a @MyFancyIP.hs@ module with the simulation definition and primitive. -- -- @ -- module MyFancyIP where -- -- import Clash.Prelude -- -- myFancyIP :: ... -- myFancyIP = ... -- {\-\# NOINLINE myFancyIP \#-\} -- @ -- -- The @NOINLINE@ pragma is needed so that GHC will never inline the definition. -- -- Now you need to add the following imports and @ANN@ pragma: -- -- @ -- \#ifdef CABAL -- import Clash.Annotations.Primitive -- import System.FilePath -- import qualified Paths_myfancyip -- import System.IO.Unsafe -- -- {\-\# ANN module (Primitive [VHDL] (unsafePerformIO Paths_myfancyip.getDataDir \<\/\> "path" \<\/\> "to")) \#-\} -- \#endif -- @ -- -- Add more files to the @data-files@ stanza in your @.cabal@ files and more -- @ANN@ pragma's if you want to add more primitive templates for other HDLs -- -- === Example of 'InlineYamlPrimitive' -- -- The following example shows off an inline HDL primitive template. It uses the -- [string-interpolate](https://hackage.haskell.org/package/string-interpolate) -- package for nicer multiline strings. -- -- @ -- {\-\# LANGUAGE QuasiQuotes \#-\} -- module InlinePrimitive where -- -- import Clash.Annotations.Primitive -- import Clash.Prelude -- import Data.String.Interpolate (__i) -- -- {\-\# ANN example (InlineYamlPrimitive [VHDL] [__i| -- BlackBox: -- kind: Declaration -- name: InlinePrimitive.example -- template: |- -- -- begin InlinePrimitive example: -- ~GENSYM[example][0] : block -- ~RESULT <= 1 + ~ARG[0]; -- end block; -- -- end InlinePrimitive example -- |]) \#-\} -- {\-\# NOINLINE example \#-\} -- example :: Signal System (BitVector 2) -> Signal System (BitVector 2) -- example = fmap succ -- @ data Primitive = 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 JSON 'String' | InlineYamlPrimitive [HDL] String -- ^ Description of a primitive for a given 'HDL's as an inline YAML 'String' deriving (Show, Read, Data, Generic, NFData, Hashable, Eq) -- | Primitive guard to mark a value as either not translatable or as having a -- blackbox with an optional extra warning. Helps Clash generate better error -- messages. -- -- For use, see 'dontTranslate', 'hasBlackBox', 'warnNonSynthesizable' and -- 'warnAlways'. data PrimitiveGuard a = DontTranslate -- ^ Marks value as not translatable. Clash will error if it finds a blackbox -- definition for it, or when it is forced to translate it. | HasBlackBox [PrimitiveWarning] a -- ^ Marks a value as having a blackbox. Clash will error if it hasn't found -- a blackbox. deriving ( Show, Read, Data, Generic, NFData, Hashable, Functor, Foldable , Traversable, Binary, Eq ) -- | Warning that will be emitted on instantiating a guarded value. data PrimitiveWarning = WarnNonSynthesizable String -- ^ Marks value as non-synthesizable. This will trigger a warning if -- instantiated in a non-testbench context. | WarnAlways String -- ^ Always emit warning upon primitive instantiation. deriving (Show, Read, Data, Generic, NFData, Hashable, Binary, Eq) -- | Extract primitive definition from a PrimitiveGuard. Will yield Nothing -- for guards of value 'DontTranslate'. extractPrim :: PrimitiveGuard a -> Maybe a extractPrim = \case HasBlackBox _ p -> Just p DontTranslate -> Nothing -- | Extract primitive warnings from a PrimitiveGuard. Will yield an empty list -- for guards of value 'DontTranslate'. extractWarnings :: PrimitiveGuard a -> [PrimitiveWarning] extractWarnings = \case HasBlackBox w _ -> w DontTranslate -> [] clash-prelude-1.8.1/src/Clash/Annotations/SynthesisAttributes.hs0000644000000000000000000001274607346545000023166 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc., 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. API for synthesis attributes (sometimes referred to as "synthesis directives", "pragmas", or "logic synthesis directives"). This is an experimental feature, please report any unexpected or broken behavior to Clash's GitHub page (). -} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE CPP #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskellQuotes #-} module Clash.Annotations.SynthesisAttributes ( Attr(..) , Annotate , annotate , markDebug ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Hashable (Hashable) import Data.Kind (Type) import Data.String.Interpolate (__i) import GHC.Generics (Generic) import Language.Haskell.TH.Syntax (Lift) import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), hasBlackBox) import Clash.Signal.Internal (Signal) import Clash.Sized.Vector (Vec(..)) type Annotate (a :: Type) (attrs :: k) = a -- | Synthesis attributes are directives passed to synthesis tools, such as -- Quartus. An example of such an attribute in VHDL: -- -- @ -- attribute chip_pin : string; -- attribute chip_pin of sel : signal is \"C4\"; -- attribute chip_pin of data : signal is "D1, D2, D3, D4"; -- @ -- -- This would instruct the synthesis tool to map the wire /sel/ to pin /C4/, and -- wire /data/ to pins /D1/, /D2/, /D3/, and /D4/. To achieve this in Clash, /Attr/s -- are used. An example of the same annotation: -- -- @ -- import Clash.Annotations.SynthesisAttributes (Attr (..), Annotate ) -- -- myFunc -- :: (Signal System Bool \`Annotate\` 'StringAttr "chip_pin" \"C4\") -- -> (Signal System Int4 \`Annotate\` 'StringAttr "chip_pin" "D1, D2, D3, D4") -- -> ... -- myFunc sel data = ... -- {\-\# NOINLINE myFunc \#-\} -- @ -- -- To ensure this function will be rendered as its own module, do not forget a -- NOINLINE pragma. -- -- Multiple attributes for the /same/ argument can be specified by using a list. -- For example: -- -- @ -- Signal System Bool \`Annotate\` -- [ 'StringAttr "chip_pin" \"C4\" -- , 'BoolAttr "direct_enable" 'True -- , 'IntegerAttr "max_depth" 512 -- , 'Attr "keep" -- ] -- @ -- -- For Verilog see: -- -- -- For VHDL, see: -- -- -- = Warnings -- -- When using annotations, it is important that annotated arguments are not -- eta-reduced, as this may result in the annotation being stripped by GHC. For -- example -- -- @ -- f :: Signal System Bool \`Annotate\` 'StringAttr \"chip_pin\" \"C4\" -- -> Signal System Bool -- f x = id x -- Using a lambda, i.e. f = \x -> id x also works -- @ -- -- will reliably show the annotation in the generated HDL, but -- -- @ -- g :: Signal System Bool \`Annotate\` 'StringAttr \"chip_pin\" \"C4\" -- -> Signal System Bool -- g = id -- @ -- -- will not work. -- -- This is an experimental feature, please report any unexpected or broken -- behavior to Clash's GitHub page (). -- -- Use 'annotate' if you wish to annotate an intermediate signal. Its use is -- preferred over type level annotations. data Attr a = BoolAttr a Bool -- ^ Attribute which argument is rendered as a bool. Example: -- | IntegerAttr a Integer -- ^ Attribute which argument is rendered as a integer. Example: -- | StringAttr a a -- ^ Attribute which argument is rendered as a string. Example: -- | Attr a -- ^ Attribute rendered as constant. Example: -- deriving (Show, Generic, NFData, Binary, Lift, Eq, Ord, Hashable, Functor) -- | Create a new identifier in HDL and inserts given synthesis attributes. The -- name of the intermediate signal can be influenced using naming functions in -- "Clash.Magic". annotate :: forall n dom a . Vec n (Attr String) -> Signal dom a -> Signal dom a annotate !_attrs !a = a {-# CLASH_OPAQUE annotate #-} {-# ANN annotate hasBlackBox #-} {-# ANN annotate let primName = show 'annotate in InlineYamlPrimitive [minBound..] [__i| BlackBoxHaskell: name: #{primName} templateFunction: "Clash.Primitives.Annotations.SynthesisAttributes.annotateBBF" workInfo: Always |] #-} -- | Insert attributes such that signals are preserved in major synthesis tools. -- Also inserts "mark_debug", a way of signalling Vivado a signal should show up -- in a list of signals desired for ILA/VIO insertion. -- -- Attributes inserted: @keep@, @mark_debug@, @noprune@, and @preserve@. markDebug :: Signal dom a -> Signal dom a markDebug = annotate $ BoolAttr "keep" True -- Vivado: :> BoolAttr "mark_debug" True -- Quartus: :> Attr "noprune" :> Attr "preserve" :> Nil clash-prelude-1.8.1/src/Clash/Annotations/TH.hs0000644000000000000000000005027607346545000017441 0ustar0000000000000000{-| 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 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 import Data.Maybe ( catMaybes ) 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, forM, zipWithM) 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 Language.Haskell.TH.Syntax (qRecover) import Data.Generics.Uniplate.Data (rewrite) 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 Monoid a => Monoid (Naming a) where mempty = Complete mempty -- | 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 'PortName's 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 -- This shouldn't reduce type family PortLabel where -- Replace (:::) annotations with a stuck type family, to inhibit unifyTypes to reduce it guardPorts :: Type -> Type guardPorts = rewrite $ \case AppT (ConT split) name@(LitT (StrTyLit _)) | split == ''(:::) -> Just $ AppT (ConT ''PortLabel) name _ -> Nothing -- | 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 ' ::: ' annotation? | split == ''PortLabel -- 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 [PortName n2] -> return $ Complete [PortName (name ++ "_" ++ n2)] 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 -> do matches <- lift $ forM eqs $ \eq -> qRecover (return Nothing) . fmap Just $ do sub <- mconcat <$> zipWithM (\l r -> unifyTypes [l, r]) xs (tySynArgs eq) return $ applySubstitution sub $ tySynRHS eq case catMaybes matches of (r:_) -> gatherNames r -- We didn't find any matching instances (i.e. the -- type family application is stuck) so give up. [] -> 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 _) = drop 1 (unapp args) #else tySynArgs (TySynEqn args _) = args #endif #if MIN_VERSION_template_haskell(2,15,0) tySynRHS (TySynEqn _ _ r) = r #else tySynRHS (TySynEqn _ r) = r #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 . guardPorts -- 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 #if MIN_VERSION_template_haskell(2,17,0) (examineCode #else ( #endif [|| 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 #if MIN_VERSION_template_haskell(2,17,0) recover (examineCode [|| Nothing ||]) $ do let expr = liftCode (getNameBinding name >>= buildTopEntity topName) examineCode [|| Just ($$expr) ||] #else recover ([|| Nothing ||]) $ do let expr = getNameBinding name >>= buildTopEntity topName [|| Just ($$expr) ||] #endif -- | 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 clash-prelude-1.8.1/src/Clash/Annotations/TopEntity.hs0000644000000000000000000002630507346545000021061 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. 'TopEntity' annotations allow us to control hierarchy and naming aspects of the Clash compiler. We have the 'Synthesize' and 'TestBench' annotation. === 'Synthesize' annotation The 'Synthesize' annotation allows us to: * Assign names to entities (VHDL) \/ modules ((System)Verilog), and their ports. * Put generated HDL files of a logical (sub)entity in their own directory. * Use cached versions of generated HDL, i.e., prevent recompilation of (sub)entities that have not changed since the last run. Caching is based on a @.manifest@ which is generated alongside the HDL; deleting this file means deleting the cache; changing this file will result in /undefined/ behavior. Functions with a 'Synthesize' annotation must adhere to the following restrictions: * Although functions with a 'Synthesize' annotation can of course depend on functions with another 'Synthesize' annotation, they must not be mutually recursive. * Functions with a 'Synthesize' annotation must be completely /monomorphic/ and /first-order/, and cannot have any /non-representable/ arguments or result. Also take the following into account when using 'Synthesize' annotations. * The Clash compiler is based on the GHC Haskell compiler, and the GHC machinery does not understand 'Synthesize' annotations and it might subsequently decide to inline those functions. You should therefor also add a @{\-\# NOINLINE f \#-\}@ pragma to the functions which you give a 'Synthesize' functions. * Functions with a 'Synthesize' annotation will not be specialized on constants. Finally, the root module, the module which you pass as an argument to the Clash compiler must either have: * A function with a 'Synthesize' annotation. * A function called /topEntity/. You apply 'Synthesize' annotations to functions using an @ANN@ pragma: @ {\-\# ANN f (Synthesize {t_name = ..., ... }) \#-\} f x = ... @ For example, given the following specification: @ module Blinker where import Clash.Prelude import Clash.Intel.ClockGen -- Define a synthesis domain with a clock with a period of 20000 /ps/. Signal -- coming from the reset button is low when pressed, and high when not pressed. 'Clash.Explicit.Signal.createDomain' vSystem{vName=\"DomInput\", vPeriod=20000, vResetPolarity=ActiveLow} -- Define a synthesis domain with a clock with a period of 50000 /ps/. 'Clash.Explicit.Signal.createDomain' vSystem{vName=\"Dom50\", vPeriod=50000} topEntity :: Clock DomInput -> Reset DomInput -> Enable Dom50 -> Signal Dom50 Bit -> Signal Dom50 (BitVector 8) topEntity clk20 rstBtn enaBtn modeBtn = 'Clash.Signal.exposeClockResetEnable' ('Clash.Prelude.mealy' blinkerT initialStateBlinkerT . 'Clash.Prelude.isRising' 1) clk50 rst50 enaBtn modeBtn where -- Start with the first LED turned on, in rotate mode, with the counter on zero initialStateBlinkerT = (1, False, 0) -- Instantiate a PLL: this stabilizes the incoming clock signal and releases -- the reset output when the signal is stable. We're also using it to -- transform an incoming clock signal running at 20 MHz to a clock signal -- running at 50 MHz. Since the signature of topEntity already specifies the -- Dom50 domain, we don't need any type signatures to specify the domain here. (clk50, rst50) = 'Clash.Intel.ClockGen.altpllSync' clk20 rstBtn blinkerT :: (BitVector 8, Bool, Index 16650001) -> Bool -> ((BitVector 8, Bool, Index 16650001), BitVector 8) blinkerT (leds,mode,cntr) key1R = ((leds',mode',cntr'),leds) where -- clock frequency = 50e6 (50 MHz) -- led update rate = 333e-3 (every 333ms) cnt_max = 16650000 -- 50e6 * 333e-3 cntr' | cntr == cnt_max = 0 | otherwise = cntr + 1 mode' | key1R = not mode | otherwise = mode leds' | cntr == 0 = if mode then complement leds else rotateL leds 1 | otherwise = leds @ The Clash compiler would normally generate the following @topEntity.vhdl@ file: @ -- Automatically generated VHDL-93 library IEEE; use IEEE.STD_LOGIC_1164.ALL; use IEEE.NUMERIC_STD.ALL; use IEEE.MATH_REAL.ALL; use std.textio.all; use work.all; use work.Blinker_topEntity_types.all; entity topEntity is port(-- clock clk20 : in Blinker_topEntity_types.clk_DomInput; -- reset rstBtn : in Blinker_topEntity_types.rst_DomInput; -- enable enaBtn : in Blinker_topEntity_types.en_Dom50; modeBtn : in std_logic; result : out std_logic_vector(7 downto 0)); end; architecture structural of topEntity is ... end; @ However, if we add the following 'Synthesize' annotation in the file: @ {\-\# ANN topEntity ('Synthesize' { t_name = "blinker" , t_inputs = [ PortName \"CLOCK_50\" , PortName \"KEY0\" , PortName \"KEY1\" , PortName \"KEY2\" ] , t_output = PortName \"LED\" }) \#-\} @ The Clash compiler will generate the following @blinker.vhdl@ file instead: @ -- Automatically generated VHDL-93 library IEEE; use IEEE.STD_LOGIC_1164.ALL; use IEEE.NUMERIC_STD.ALL; use IEEE.MATH_REAL.ALL; use std.textio.all; use work.all; use work.blinker_types.all; entity blinker is port(-- clock CLOCK_50 : in blinker_types.clk_DomInput; -- reset KEY0 : in blinker_types.rst_DomInput; -- enable KEY1 : in blinker_types.en_Dom50; KEY2 : in std_logic; LED : out std_logic_vector(7 downto 0)); end; architecture structural of blinker is ... end; @ Where we now have: * A top-level component that is called @blinker@. * Inputs and outputs that have a /user/-chosen name: @CLOCK_50@, @KEY0@, @KEY1@, @KEY2@, @LED@, etc. See the documentation of 'Synthesize' for the meaning of all its fields. === 'TestBench' annotation Tell what binder is the test bench for a 'Synthesize'-annotated binder. @ entityBeingTested :: ... entityBeingTested = ... {\-\# NOINLINE entityBeingTested \#-\} {\-\# ANN entityBeingTested (defSyn "entityBeingTested") \#-\} myTestBench :: Signal System Bool myTestBench = ... entityBeingTested ... {\-\# NOINLINE myTestBench \#-\} {\-\# ANN myTestBench (TestBench \'entityBeingTested) \#-\} @ The 'TestBench' annotation actually already implies a 'Synthesize' annotation on the device under test, so the 'defSyn' in the example could have been omitted. We recommend you supply 'defSyn' explicitly nonetheless. In any case, it will still need the @NOINLINE@ annotation. -} {-# LANGUAGE CPP #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Annotations.TopEntity ( -- * Data types TopEntity (..) , PortName (..) -- * Convenience functions , defSyn ) where import GHC.Generics import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Syntax (Lift(..)) #if MIN_VERSION_template_haskell(2,16,0) import Language.Haskell.TH.Compat #endif import Data.Data -- | TopEntity annotation data TopEntity -- | Instruct the Clash compiler to use this top-level function as a separately -- synthesizable component. = Synthesize { t_name :: String -- ^ The name the top-level component should have, put in a correspondingly -- named file. , t_inputs :: [PortName] -- ^ List of names that are assigned in-order to the inputs of the component. , t_output :: PortName -- ^ Name assigned in-order to the outputs of the component. As a Haskell -- function can only truly return a single value -- with multiple values -- \"wrapped\" by a tuple -- this field is not a list, but a single -- @'PortName'@. Use @'PortProduct'@ to give names to the individual components -- of the output tuple. } -- | Tell what binder is the 'TestBench' for a 'Synthesize'-annotated binder. -- -- @ -- {\-\# NOINLINE myTestBench \#-\} -- {\-\# ANN myTestBench (TestBench \'entityBeingTested) \#-\} -- @ | TestBench TH.Name deriving (Eq,Data,Show,Generic) instance Lift TopEntity where lift (Synthesize name inputs output) = TH.appsE [ TH.conE 'Synthesize , lift name , lift inputs , lift output ] lift (TestBench _) = error "Cannot lift a TestBench" #if MIN_VERSION_template_haskell(2,16,0) liftTyped = liftTypedFromUntyped #endif -- | Give port names for arguments/results. -- -- Give a data type and function: -- -- @ -- data T = MkT Int Bool -- -- {\-\# ANN f (defSyn "f") \#-\} -- f :: Int -> T -> (T,Bool) -- f a b = ... -- @ -- -- Clash would normally generate the following VHDL entity: -- -- @ -- entity f is -- port(a : in signed(63 downto 0); -- b_0 : in signed(63 downto 0); -- b_1 : in boolean; -- result : out std_logic_vector(65 downto 0)); -- end; -- @ -- -- However, we can change this by using 'PortName's. So by: -- -- @ -- {\-\# ANN f -- (Synthesize -- { t_name = "f" -- , t_inputs = [ PortName \"a\" -- , PortName \"b\" ] -- , t_output = PortName \"res\" }) \#-\} -- f :: Int -> T -> (T,Bool) -- f a b = ... -- @ -- -- we get: -- -- @ -- entity f is -- port(a : in signed(63 downto 0); -- b : in std_logic_vector(64 downto 0); -- res : out std_logic_vector(65 downto 0)); -- end; -- @ -- -- If we want to name fields for tuples/records we have to use 'PortProduct' -- -- @ -- {\-\# ANN f -- (Synthesize -- { t_name = "f" -- , t_inputs = [ PortName \"a\" -- , PortProduct \"\" [ PortName \"b\", PortName \"c\" ] ] -- , t_output = PortProduct \"res\" [PortName \"q\"] }) \#-\} -- f :: Int -> T -> (T,Bool) -- f a b = ... -- @ -- -- So that we get: -- -- @ -- entity f is -- port(a : in signed(63 downto 0); -- b : in signed(63 downto 0); -- c : in boolean; -- res_q : out std_logic_vector(64 downto 0); -- res_1 : out boolean); -- end; -- @ -- -- Notice how we didn't name the second field of the result, and the second -- output port got 'PortProduct' name, \"res\", as a prefix for its name. data PortName = PortName String -- ^ You want a port, with the given name, for the entire argument\/type -- -- You can use an empty String ,@""@ , in case you want an auto-generated name. | PortProduct String [PortName] -- ^ You want to assign ports to fields of a product argument\/type -- -- The first argument of 'PortProduct' is the name of: -- -- 1. The signal/wire to which the individual ports are aggregated. -- -- 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 (Eq,Data,Show,Generic,Lift) -- | Default 'Synthesize' annotation which has no specified names for the input -- and output ports. -- -- >>> defSyn "foo" -- Synthesize {t_name = "foo", t_inputs = [], t_output = PortName ""} defSyn :: String -> TopEntity defSyn name = Synthesize { t_name = name , t_inputs = [] , t_output = PortName "" } clash-prelude-1.8.1/src/Clash/0000755000000000000000000000000007346545000014263 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/CPP.hs0000644000000000000000000000233107346545000015240 0ustar0000000000000000{-| Copyright : (C) 2019 , Myrtle Software Ltd, 2023 , QBayLogic B.V., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Clash.CPP ( maxTupleSize , haddockOnly -- ** Cabal flags , fSuperStrict , fStrictMapSignal ) where #ifndef MAX_TUPLE_SIZE #ifdef LARGE_TUPLES #if MIN_VERSION_ghc(9,0,0) import GHC.Settings.Constants (mAX_TUPLE_SIZE) #else import Constants (mAX_TUPLE_SIZE) #endif #define MAX_TUPLE_SIZE (fromIntegral mAX_TUPLE_SIZE) #else #ifdef HADDOCK_ONLY #define MAX_TUPLE_SIZE 3 #else #define MAX_TUPLE_SIZE 12 #endif #endif #endif maxTupleSize :: Num a => a maxTupleSize = MAX_TUPLE_SIZE haddockOnly :: Bool #ifdef HADDOCK_ONLY haddockOnly = True #else haddockOnly = False #endif -- | 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 #-} clash-prelude-1.8.1/src/Clash/Class/0000755000000000000000000000000007346545000015330 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/AutoReg.hs0000644000000000000000000000046507346545000017237 0ustar0000000000000000{-| Copyright : (C) 2019, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} module Clash.Class.AutoReg ( AutoReg (autoReg) , deriveAutoReg ) where import Clash.Class.AutoReg.Internal import Clash.Class.AutoReg.Instances () clash-prelude-1.8.1/src/Clash/Class/AutoReg/0000755000000000000000000000000007346545000016676 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/AutoReg/Instances.hs0000644000000000000000000000164707346545000021171 0ustar0000000000000000{-| Copyright : (C) 2019, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} -- {-# OPTIONS_GHC -ddump-splices #-} module Clash.Class.AutoReg.Instances where import Clash.Class.AutoReg.Internal import Clash.CPP (maxTupleSize) import Data.Complex (Complex) import Data.Ord (Down) import Data.Ratio (Ratio) deriveAutoReg ''Complex deriveAutoReg ''Down deriveAutoReg ''Ratio -- | __NB__: The documentation only shows instances up to /3/-tuples. By -- default, instances up to and including /12/-tuples will exist. If the flag -- @large-tuples@ is set instances up to the GHC imposed limit will exist. The -- GHC imposed limit is either 62 or 64 depending on the GHC version. deriveAutoRegTuples [2..maxTupleSize] clash-prelude-1.8.1/src/Clash/Class/AutoReg/Internal.hs0000644000000000000000000004151007346545000021007 0ustar0000000000000000{-| Copyright : (C) 2019 , Google Inc., 2021-2022, QBayLogic B.V., 2021-2022, Myrtle.ai License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- needed for constraint on the Fixed instance 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 (conAppsT) -- $setup -- >>> import Data.Maybe -- >>> import Clash.Prelude -- >>> :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 (Signed 16)@; -- when viewed as bits, a 'Nothing' would look like: -- -- >>> pack @(Maybe (Signed 16)) Nothing -- 0b0_...._...._...._.... -- -- and 'Just' -- -- >>> pack @(Maybe (Signed 16)) (Just 3) -- 0b1_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. -- class NFDataX a => AutoReg a where -- | For documentation see class 'AutoReg'. -- -- This is the version with explicit clock\/reset\/enable inputs, -- "Clash.Prelude" exports an implicit version of this: 'Clash.Prelude.autoReg' autoReg :: (HasCallStack, KnownDomain dom) => Clock dom -> Reset dom -> Enable dom -> a -- ^ Reset value -> Signal dom a -> Signal dom a autoReg = register {-# INLINE autoReg #-} 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 KnownNat n => 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 (andEnable en tag) valInit val createMaybe t v = case t of True -> Just v False -> Nothing {-# INLINE autoReg #-} 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 {-# INLINE autoReg #-} 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 {-# INLINE autoReg #-} -- | 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 go acc (ParensT ty) = go acc ty #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 #if MIN_VERSION_th_abstraction(0,3,0) tyArgs = datatypeInstTypes tyInfo #else tyArgs = datatypeVars tyInfo #endif ty = conAppsT tyNm tyArgs 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 clkN <- newName "clk" rstN <- newName "rst" enN <- newName "en" initValN <- newName "initVal" inputN <- newName "input" let initValE = varE initValN inputE = varE inputN argsP = map varP [clkN, rstN, enN, initValN, inputN] 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 clkE = varE clkN rstE = varE rstN enE = varE enN 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 , PragmaD (InlineP 'autoReg Inline FunLike AllPhases) ]] -- 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 [AppT _ _] -> True [VarT _] -> False -- gets copied by "filter isOk" above [ConT _] -> False -- we can just drop constraints like: "AutoReg Bool => ..." [LitT _] -> False -- or "KnownNat 4 =>" [TupleT 0] -> False -- handle Unit () [_] -> 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) LitT _ -> ty' _ -> 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) ',' ++ ")" clash-prelude-1.8.1/src/Clash/Class/BitPack.hs0000644000000000000000000000133707346545000017205 0ustar0000000000000000 {-| Copyright : (C) 2013-2016, University of Twente 2016-2017, Myrtle Software Ltd 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} module Clash.Class.BitPack ( BitPack (..) , isLike , bitCoerce , bitCoerceMap , boolToBV , boolToBit , bitToBool , packXWith -- * Bit Indexing , (!) , slice , split , replaceBit , setSlice , msb , lsb -- * Bit Reduction , reduceAnd , reduceOr , reduceXor ) where import Clash.Class.BitPack.Internal import Clash.Class.BitPack.BitIndex import Clash.Class.BitPack.BitReduction clash-prelude-1.8.1/src/Clash/Class/BitPack/0000755000000000000000000000000007346545000016645 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/BitPack/BitIndex.hs0000644000000000000000000001130407346545000020706 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Class.BitPack.BitIndex where import GHC.TypeLits (KnownNat, type (+), type (-)) import Clash.Class.BitPack.Internal (BitPack (..)) import Clash.Promoted.Nat (SNat (..)) import Clash.Sized.Internal.BitVector (BitVector, Bit, index#, lsb#, msb#, replaceBit#, setSlice#, slice#, split#) {- $setup >>> :set -XDataKinds >>> import Clash.Prelude -} {-# INLINE (!) #-} -- | Get the bit at the specified bit index. -- -- __NB__: Bit indices are __DESCENDING__. -- -- >>> pack (7 :: Unsigned 6) -- 0b00_0111 -- >>> (7 :: Unsigned 6) ! 1 -- 1 -- >>> (7 :: Unsigned 6) ! 5 -- 0 -- >>> (7 :: Unsigned 6) ! 6 -- *** Exception: (!): 6 is out of range [5..0] -- ... (!) :: (BitPack a, Enum i) => a -> i -> Bit (!) v i = index# (pack v) (fromEnum i) {-# INLINE slice #-} {- | Get a slice between bit index @m@ and and bit index @n@. __NB__: Bit indices are __DESCENDING__. >>> pack (7 :: Unsigned 6) 0b00_0111 >>> slice d4 d2 (7 :: Unsigned 6) 0b001 #if __GLASGOW_HASKELL__ == 906 >>> slice d6 d4 (7 :: Unsigned 6) :... • Couldn't match type ‘7 + i0’ with ‘6’ arising from a use of ‘slice’ The type variable ‘i0’ is ambiguous • In the expression: slice d6 d4 (7 :: Unsigned 6) In an equation for ‘it’: it = slice d6 d4 (7 :: Unsigned 6) #else >>> slice d6 d4 (7 :: Unsigned 6) :... • Couldn't match type ‘7 + i0’ with ‘6’ arising from a use of ‘slice’ The type variable ‘i0’ is ambiguous • In the expression: slice d6 d4 (7 :: Unsigned 6) In an equation for ‘it’: it = slice d6 d4 (7 :: Unsigned 6) #endif -} slice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => SNat m -> SNat n -> a -> BitVector (m + 1 - n) slice m n v = slice# (pack v) m n {-# INLINE split #-} -- | Split a value of a bit size @m + n@ into a tuple of values with size @m@ -- and size @n@. -- -- >>> pack (7 :: Unsigned 6) -- 0b00_0111 -- >>> split (7 :: Unsigned 6) :: (BitVector 2, BitVector 4) -- (0b00,0b0111) split :: (BitPack a, BitSize a ~ (m + n), KnownNat n) => a -> (BitVector m, BitVector n) split v = split# (pack v) {-# INLINE replaceBit #-} -- | Set the bit at the specified index -- -- __NB__: Bit indices are __DESCENDING__. -- -- >>> pack (-5 :: Signed 6) -- 0b11_1011 -- >>> replaceBit 4 0 (-5 :: Signed 6) -- -21 -- >>> pack (-21 :: Signed 6) -- 0b10_1011 -- >>> replaceBit 5 0 (-5 :: Signed 6) -- 27 -- >>> pack (27 :: Signed 6) -- 0b01_1011 -- >>> replaceBit 6 0 (-5 :: Signed 6) -- *** Exception: replaceBit: 6 is out of range [5..0] -- ... replaceBit :: (BitPack a, Enum i) => i -> Bit -> a -> a replaceBit i b v = unpack (replaceBit# (pack v) (fromEnum i) b) {-# INLINE setSlice #-} {- | Set the bits between bit index @m@ and bit index @n@. __NB__: Bit indices are __DESCENDING__. >>> pack (-5 :: Signed 6) 0b11_1011 >>> setSlice d4 d3 0 (-5 :: Signed 6) -29 >>> pack (-29 :: Signed 6) 0b10_0011 #if __GLASGOW_HASKELL__ == 906 >>> setSlice d6 d5 0 (-5 :: Signed 6) :... • Couldn't match type ‘7 + i0’ with ‘6’ arising from a use of ‘setSlice’ The type variable ‘i0’ is ambiguous • In the expression: setSlice d6 d5 0 (- 5 :: Signed 6) In an equation for ‘it’: it = setSlice d6 d5 0 (- 5 :: Signed 6) #else >>> setSlice d6 d5 0 (-5 :: Signed 6) :... • Couldn't match type ‘7 + i0’ with ‘6’ arising from a use of ‘setSlice’ The type variable ‘i0’ is ambiguous • In the expression: setSlice d6 d5 0 (- 5 :: Signed 6) In an equation for ‘it’: it = setSlice d6 d5 0 (- 5 :: Signed 6) #endif -} setSlice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => SNat m -> SNat n -> BitVector (m + 1 - n) -> a -> a setSlice m n w v = unpack (setSlice# SNat (pack v) m n w) {-# INLINE msb #-} -- | Get the most significant bit. -- -- >>> pack (-4 :: Signed 6) -- 0b11_1100 -- >>> msb (-4 :: Signed 6) -- 1 -- >>> pack (4 :: Signed 6) -- 0b00_0100 -- >>> msb (4 :: Signed 6) -- 0 msb :: BitPack a => a -> Bit msb v = msb# (pack v) {-# INLINE lsb #-} -- | Get the least significant bit. -- -- >>> pack (-9 :: Signed 6) -- 0b11_0111 -- >>> lsb (-9 :: Signed 6) -- 1 -- >>> pack (-8 :: Signed 6) -- 0b11_1000 -- >>> lsb (-8 :: Signed 6) -- 0 lsb :: BitPack a => a -> Bit lsb v = lsb# (pack v) clash-prelude-1.8.1/src/Clash/Class/BitPack/BitReduction.hs0000644000000000000000000000335507346545000021602 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Class.BitPack.BitReduction where import Clash.Class.BitPack.Internal (BitPack (..)) import Clash.Sized.Internal.BitVector (Bit, reduceAnd#, reduceOr#, reduceXor#) {- $setup >>> :set -XDataKinds >>> import Clash.Prelude -} {-# INLINE reduceAnd #-} -- | Are all bits set to '1'? -- -- >>> pack (-2 :: Signed 6) -- 0b11_1110 -- >>> reduceAnd (-2 :: Signed 6) -- 0 -- >>> pack (-1 :: Signed 6) -- 0b11_1111 -- >>> reduceAnd (-1 :: Signed 6) -- 1 -- -- Zero width types will evaluate to '1': -- -- >>> reduceAnd (0 :: Unsigned 0) -- 1 reduceAnd :: BitPack a => a -> Bit reduceAnd v = reduceAnd# (pack v) {-# INLINE reduceOr #-} -- | Is there at least one bit set to '1'? -- -- >>> pack (5 :: Signed 6) -- 0b00_0101 -- >>> reduceOr (5 :: Signed 6) -- 1 -- >>> pack (0 :: Signed 6) -- 0b00_0000 -- >>> reduceOr (0 :: Signed 6) -- 0 -- -- Zero width types will evaluate to '0': -- -- >>> reduceOr (0 :: Unsigned 0) -- 0 reduceOr :: BitPack a => a -> Bit reduceOr v = reduceOr# (pack v) {-# INLINE reduceXor #-} -- | Is the number of bits set to '1' uneven? -- -- >>> pack (5 :: Signed 6) -- 0b00_0101 -- >>> reduceXor (5 :: Signed 6) -- 0 -- >>> pack (28 :: Signed 6) -- 0b01_1100 -- >>> reduceXor (28 :: Signed 6) -- 1 -- >>> pack (-5 :: Signed 6) -- 0b11_1011 -- >>> reduceXor (-5 :: Signed 6) -- 1 -- -- Zero width types will evaluate to '0': -- -- >>> reduceXor (0 :: Unsigned 0) -- 0 reduceXor :: BitPack a => a -> Bit reduceXor v = reduceXor# (pack v) clash-prelude-1.8.1/src/Clash/Class/BitPack/Internal.hs0000644000000000000000000003673007346545000020766 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2021-2023 QBayLogic B.V., 2022, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Trustworthy #-} {-# 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.BitPack.Internal where import Prelude hiding (map) import Control.Exception (catch, evaluate) import Data.Binary.IEEE754 (doubleToWord, floatToWord, wordToDouble, wordToFloat) import Data.Complex (Complex) import Data.Functor.Compose (Compose) import Data.Functor.Const (Const) import Data.Functor.Identity (Identity) import Data.Functor.Product (Product) import Data.Functor.Sum (Sum) import Data.Int import Data.Ord (Down) import Data.Word import Foreign.C.Types (CUShort) import GHC.Generics import GHC.TypeLits (KnownNat, Nat, type (+), type (-)) import GHC.TypeLits.Extra (CLog, Max) import Numeric.Half (Half (..)) import System.IO.Unsafe (unsafeDupablePerformIO) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack.Internal.TH (deriveBitPackTuples) import Clash.Class.Resize (zeroExtend, resize) import Clash.Promoted.Nat (SNat(..), snatToNum) import Clash.Sized.Internal.BitVector (pack#, split#, checkUnpackUndef, undefined#, unpack#, unsafeToNatural, isLike#, BitVector, Bit, (++#)) import Clash.XException {- $setup >>> :m -Prelude >>> :set -XDataKinds >>> import Clash.Prelude -} -- | Convert data to/from a 'BitVector'. This allows functions to be defined -- on the underlying representation of data, while exposing a nicer API using -- 'pack' / 'unpack' at the boundaries. For example: -- -- @ -- f :: forall a b. (BitPack a, BitPack b) => a -> b -- f = unpack . go . pack -- where -- go :: BitVector (BitSize a) -> BitVector (BitSize b) -- go = _ -- A function on the underlying bit vector -- @ -- -- A type should only implement this class if it has a statically known size, -- as otherwise it is not possible to determine how many bits are needed to -- represent values. This means that types such as @[a]@ cannot have @BitPack@ -- instances, as even if @a@ has a statically known size, the length of the -- list cannot be known in advance. -- -- It is not possible to give data a custom bit representation by providing a -- @BitPack@ instance. A @BitPack@ instance allows no creativity and should -- always accurately reflect the bit representation of the data in HDL. You -- should always @derive ('Generic', BitPack)@ unless you use a custom data -- representation, in which case you should use -- 'Clash.Annotations.BitRepresentation.Deriving.deriveBitPack'. Custom -- encodings can be created with "Clash.Annotations.BitRepresentation" and -- "Clash.Annotations.BitRepresentation.Deriving". -- -- If the @BitPack@ instance does not accurately match the bit representation of -- the data in HDL, Clash designs will exhibit incorrect behavior in various -- places. -- -- Clash provides some generic functions on packable types in the prelude, such -- as indexing into packable stuctures (see "Clash.Class.BitPack.BitIndex") and -- bitwise reduction of packable data (see "Clash.Class.BitPack.BitReduction"). -- class KnownNat (BitSize a) => BitPack a where -- | Number of 'Clash.Sized.BitVector.Bit's needed to represents elements -- of type @a@ -- -- Can be derived using `GHC.Generics`: -- -- > import Clash.Prelude -- > import GHC.Generics -- > -- > data MyProductType = MyProductType { a :: Int, b :: Bool } -- > deriving (Generic, BitPack) type BitSize a :: Nat type BitSize a = (CLog 2 (GConstructorCount (Rep a))) + (GFieldSize (Rep a)) -- | Convert element of type @a@ to a 'BitVector' -- -- >>> pack (-5 :: Signed 6) -- 0b11_1011 pack :: a -> BitVector (BitSize a) default pack :: ( Generic a , GBitPack (Rep a) , KnownNat (BitSize a) , KnownNat constrSize , KnownNat fieldSize , constrSize ~ CLog 2 (GConstructorCount (Rep a)) , fieldSize ~ GFieldSize (Rep a) , (constrSize + fieldSize) ~ BitSize a ) => a -> BitVector (BitSize a) pack = packXWith go where go a = resize (pack sc) ++# packedFields where (sc, packedFields) = gPackFields 0 (from a) -- | Convert a 'BitVector' to an element of type @a@ -- -- >>> pack (-5 :: Signed 6) -- 0b11_1011 -- >>> let x = pack (-5 :: Signed 6) -- >>> unpack x :: Unsigned 6 -- 59 -- >>> pack (59 :: Unsigned 6) -- 0b11_1011 unpack :: BitVector (BitSize a) -> a default unpack :: ( Generic a , GBitPack (Rep a) , KnownNat constrSize , KnownNat fieldSize , constrSize ~ CLog 2 (GConstructorCount (Rep a)) , fieldSize ~ GFieldSize (Rep a) , (constrSize + fieldSize) ~ BitSize a ) => BitVector (BitSize a) -> a unpack b = to (gUnpack sc 0 bFields) where (checkUnpackUndef unpack . resize -> sc, bFields) = split# b packXWith :: KnownNat n => (a -> BitVector n) -> a -> BitVector n packXWith f = xToBV . f {-# INLINE packXWith #-} xToBV :: KnownNat n => BitVector n -> BitVector n xToBV x = unsafeDupablePerformIO (catch (evaluate x) (\(XException _) -> return undefined#)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE xToBV #-} {-# ANN xToBV hasBlackBox #-} -- | Pack both arguments to a 'BitVector' and use -- 'Clash.Sized.Internal.BitVector.isLike#' to compare them. This is a more -- lentiant comparison than '(==)', behaving more like (but not necessarily -- exactly the same as) @std_match@ in VHDL or @casez@ in Verilog. -- -- Unlike '(==)', isLike is not symmetric. The reason for this is that a -- defined bit is said to be like an undefined bit, but not vice-versa: -- -- >>> isLike (12 :: Signed 8) undefined -- True -- >>> isLike undefined (12 :: Signed 8) -- False -- -- However, it is still trivially reflexive and transitive: -- -- >>> :set -XTemplateHaskell -- >>> let x1 = $(bLit "0010") -- >>> let x2 = $(bLit "0.10") -- >>> let x3 = $(bLit "0.1.") -- >>> isLike x1 x1 -- True -- >>> isLike x1 x2 -- True -- >>> isLike x2 x3 -- True -- >>> isLike x1 x3 -- True -- -- __NB__: Not synthesizable -- isLike :: (BitPack a) => a -> a -> Bool isLike x y = isLike# (pack x) (pack y) {-# INLINE[1] bitCoerce #-} -- | Coerce a value from one type to another through its bit representation. -- -- >>> pack (-5 :: Signed 6) -- 0b11_1011 -- >>> bitCoerce (-5 :: Signed 6) :: Unsigned 6 -- 59 -- >>> pack (59 :: Unsigned 6) -- 0b11_1011 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) -- 0b1111_1111_1111_1111_1111_1111_1111_1011 -- >>> bitCoerceMap @(Vec 4 (BitVector 8)) (replace 1 0) (-5 :: Signed 32) -- -16711685 -- >>> pack (-16711685 :: Signed 32) -- 0b1111_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 unpack = checkUnpackUndef $ \bv -> if bv == 1 then True else False instance KnownNat n => BitPack (BitVector n) where type BitSize (BitVector n) = n pack = packXWith id unpack v = v instance BitPack Bit where type BitSize Bit = 1 pack = packXWith pack# unpack = unpack# instance BitPack Int where type BitSize Int = WORD_SIZE_IN_BITS pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Int8 where type BitSize Int8 = 8 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Int16 where type BitSize Int16 = 16 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Int32 where type BitSize Int32 = 32 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Int64 where type BitSize Int64 = 64 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Word where type BitSize Word = WORD_SIZE_IN_BITS pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Word8 where type BitSize Word8 = 8 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Word16 where type BitSize Word16 = 16 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Word32 where type BitSize Word32 = 32 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Word64 where type BitSize Word64 = 64 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Float where type BitSize Float = 32 pack = packXWith packFloat# unpack = checkUnpackUndef unpackFloat# packFloat# :: Float -> BitVector 32 packFloat# = fromIntegral . floatToWord -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE packFloat# #-} {-# ANN packFloat# hasBlackBox #-} unpackFloat# :: BitVector 32 -> Float unpackFloat# (unsafeToNatural -> w) = wordToFloat (fromIntegral w) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unpackFloat# #-} {-# ANN unpackFloat# hasBlackBox #-} instance BitPack Double where type BitSize Double = 64 pack = packXWith packDouble# unpack = checkUnpackUndef unpackDouble# packDouble# :: Double -> BitVector 64 packDouble# = fromIntegral . doubleToWord -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE packDouble# #-} {-# ANN packDouble# hasBlackBox #-} unpackDouble# :: BitVector 64 -> Double unpackDouble# (unsafeToNatural -> w) = wordToDouble (fromIntegral w) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unpackDouble# #-} {-# ANN unpackDouble# hasBlackBox #-} instance BitPack CUShort where type BitSize CUShort = 16 pack = packXWith fromIntegral unpack = checkUnpackUndef fromIntegral instance BitPack Half where type BitSize Half = 16 pack (Half x) = pack x unpack = checkUnpackUndef $ \x -> Half (unpack x) instance BitPack () where type BitSize () = 0 pack _ = minBound unpack _ = () -- | __NB__: The documentation only shows instances up to /3/-tuples. By -- default, instances up to and including /12/-tuples will exist. If the flag -- @large-tuples@ is set instances up to the GHC imposed limit will exist. The -- GHC imposed limit is either 62 or 64 depending on the GHC version. 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 unpack ab = let (a,b) = split# ab in (unpack a, unpack b) class GBitPack f where -- | Size of fields. If multiple constructors exist, this is the maximum of -- the sum of each of the constructors fields. type GFieldSize f :: Nat -- | Number of constructors this type has. Indirectly indicates how many bits -- are needed to represent the constructor. type GConstructorCount f :: Nat -- | Pack fields of a type. Caller should pack and prepend the constructor bits. gPackFields :: Int -- ^ Current constructor -> f a -- ^ Data to pack -> (Int, BitVector (GFieldSize f)) -- ^ (Constructor number, Packed fields) -- | Unpack whole type. gUnpack :: Int -- ^ Construct with constructor /n/ -> Int -- ^ Current constructor -> BitVector (GFieldSize f) -- ^ BitVector containing fields -> f a -- ^ Unpacked result instance GBitPack a => GBitPack (M1 m d a) where type GFieldSize (M1 m d a) = GFieldSize a type GConstructorCount (M1 m d a) = GConstructorCount a gPackFields cc (M1 m1) = gPackFields cc m1 gUnpack c cc b = M1 (gUnpack c cc b) instance ( KnownNat (GFieldSize g) , KnownNat (GFieldSize f) , KnownNat (GConstructorCount f) , GBitPack f , GBitPack g ) => GBitPack (f :+: g) where type GFieldSize (f :+: g) = Max (GFieldSize f) (GFieldSize g) type GConstructorCount (f :+: g) = GConstructorCount f + GConstructorCount g gPackFields cc (L1 l) = let (sc, packed) = gPackFields cc l in let padding = undefined# :: BitVector (Max (GFieldSize f) (GFieldSize g) - GFieldSize f) in (sc, packed ++# padding) gPackFields cc (R1 r) = let cLeft = snatToNum (SNat @(GConstructorCount f)) in let (sc, packed) = gPackFields (cc + cLeft) r in let padding = undefined# :: BitVector (Max (GFieldSize f) (GFieldSize g) - GFieldSize g) in (sc, packed ++# padding) gUnpack c cc b = let cLeft = snatToNum (SNat @(GConstructorCount f)) in if c < cc + cLeft then L1 (gUnpack c cc f) else R1 (gUnpack c (cc + cLeft) g) where -- It's a thing of beauty, if I may say so myself! (f, _ :: BitVector (Max (GFieldSize f) (GFieldSize g) - GFieldSize f)) = split# b (g, _ :: BitVector (Max (GFieldSize f) (GFieldSize g) - GFieldSize g)) = split# b instance (KnownNat (GFieldSize g), KnownNat (GFieldSize f), GBitPack f, GBitPack g) => GBitPack (f :*: g) where type GFieldSize (f :*: g) = GFieldSize f + GFieldSize g type GConstructorCount (f :*: g) = 1 gPackFields cc fg = (cc, packXWith go fg) where go (l0 :*: r0) = let (_, l1) = gPackFields cc l0 in let (_, r1) = gPackFields cc r0 in l1 ++# r1 gUnpack c cc b = gUnpack c cc front :*: gUnpack c cc back where (front, back) = split# b instance BitPack c => GBitPack (K1 i c) where type GFieldSize (K1 i c) = BitSize c type GConstructorCount (K1 i c) = 1 gPackFields cc (K1 i) = (cc, pack i) gUnpack _c _cc b = K1 (unpack b) instance GBitPack U1 where type GFieldSize U1 = 0 type GConstructorCount U1 = 1 gPackFields cc U1 = (cc, 0) gUnpack _c _cc _b = U1 -- Instances derived using Generic instance BitPack Ordering instance ( BitPack a , BitPack b ) => BitPack (Either a b) instance BitPack a => BitPack (Maybe a) instance BitPack a => BitPack (Complex a) instance BitPack a => BitPack (Down a) instance BitPack a => BitPack (Identity a) instance BitPack a => BitPack (Const a b) instance (BitPack (f a), BitPack (g a)) => BitPack (Product f g a) instance (BitPack (f a), BitPack (g a)) => BitPack (Sum f g a) instance BitPack (f (g a)) => BitPack (Compose f g a) -- | Zero-extend a 'Bool'ean value to a 'BitVector' of the appropriate size. -- -- >>> boolToBV True :: BitVector 6 -- 0b00_0001 -- >>> boolToBV False :: BitVector 6 -- 0b00_0000 boolToBV :: KnownNat n => Bool -> BitVector (n + 1) boolToBV = zeroExtend . pack -- | Convert a Bool to a Bit boolToBit :: Bool -> Bit boolToBit = bitCoerce -- | Convert a Bit to a Bool bitToBool :: Bit -> Bool bitToBool = bitCoerce -- Derive the BitPack instance for tuples of size 3 to maxTupleSize deriveBitPackTuples ''BitPack ''BitSize 'pack 'unpack clash-prelude-1.8.1/src/Clash/Class/BitPack/Internal/0000755000000000000000000000000007346545000020421 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/BitPack/Internal/TH.hs0000644000000000000000000000656307346545000021302 0ustar0000000000000000{-| Copyright : (C) 2019, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Clash.Class.BitPack.Internal.TH where import Clash.CPP (maxTupleSize) import Language.Haskell.TH.Compat (mkTySynInstD,mkTupE) import Control.Monad (replicateM) import Data.List (foldl') import GHC.TypeLits (KnownNat) import Language.Haskell.TH -- | Contruct all the tuple (starting at size 3) instances for BitPack. deriveBitPackTuples :: Name -- ^ BitPack -> Name -- ^ BitSize -> Name -- ^ pack -> Name -- ^ unpack -> DecsQ deriveBitPackTuples bitPackName bitSizeName packName unpackName = do let bitPack = ConT bitPackName bitSize = ConT bitSizeName knownNat = ConT ''KnownNat plus = ConT $ mkName "+" allNames <- replicateM maxTupleSize (newName "a") retupName <- newName "retup" x <- newName "x" y <- newName "y" tup <- newName "tup" pure $ flip map [3..maxTupleSize] $ \tupleNum -> let names = take tupleNum allNames (v,vs) = case map VarT names of (z:zs) -> (z,zs) _ -> error "maxTupleSize <= 3" tuple xs = foldl' AppT (TupleT $ length xs) xs -- Instance declaration context = [ bitPack `AppT` v , knownNat `AppT` (bitSize `AppT` v) , bitPack `AppT` tuple vs , knownNat `AppT` (bitSize `AppT` tuple vs) ] instTy = AppT bitPack $ tuple (v:vs) -- Associated type BitSize bitSizeType = mkTySynInstD bitSizeName [tuple (v:vs)] $ plus `AppT` (bitSize `AppT` v) `AppT` (bitSize `AppT` foldl AppT (TupleT $ tupleNum - 1) vs) pack = FunD packName [ Clause [VarP tup] (NormalB (AppE (VarE packName) (AppE (VarE retupName) (VarE tup)))) [FunD retupName [ Clause [ TupP $ map VarP names ] ( let (e,es) = case map VarE names of (z:zs) -> (z,zs) _ -> error "maxTupleSize <= 3" in NormalB (mkTupE [e,mkTupE es]) ) [] ] ] ] unpack = FunD unpackName [ Clause [ VarP x ] ( NormalB $ let (p,ps) = case map VarP names of (z:zs) -> (z,zs) _ -> error "maxTupleSize <= 3" in LetE [ ValD ( TupP [ p, VarP y ] ) ( NormalB $ VarE unpackName `AppE` VarE x ) [] , ValD ( TupP ps ) ( NormalB $ VarE unpackName `AppE` VarE y ) [] ] ( mkTupE $ map VarE names ) ) [] ] in InstanceD Nothing context instTy [bitSizeType, pack, unpack] clash-prelude-1.8.1/src/Clash/Class/Counter.hs0000644000000000000000000000260707346545000017310 0ustar0000000000000000{-| Copyright : (C) 2021 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Utilities for wrapping counters consisting of multiple individual counters -} module Clash.Class.Counter ( Counter , countSucc , countPred ) where import Clash.Class.Counter.Internal -- $setup -- >>> import Clash.Class.Counter -- >>> import Clash.Sized.BitVector (BitVector) -- >>> import Clash.Sized.Index (Index) -- >>> import Clash.Sized.Signed (Signed) -- >>> import Clash.Sized.Unsigned (Unsigned) -- | Successor of a counter. -- -- Examples: -- -- >>> type T = (Unsigned 2, Unsigned 2) -- >>> countSucc @T (1, 1) -- (1,2) -- >>> countSucc @T (1, 2) -- (1,3) -- >>> countSucc @T (1, 3) -- (2,0) -- >>> countSucc @T (3, 3) -- (0,0) -- >>> countSucc @(Index 9, Index 2) (0, 1) -- (1,0) -- >>> countSucc @(Either (Index 9) (Index 9)) (Left 8) -- Right 0 countSucc :: Counter a => a -> a countSucc = snd . countSuccOverflow -- | Predecessor of a counter -- -- Examples: -- -- >>> type T = (Unsigned 2, Unsigned 2) -- >>> countPred @T (1, 2) -- (1,1) -- >>> countPred @T (1, 3) -- (1,2) -- >>> countPred @T (2, 0) -- (1,3) -- >>> countPred @T (0, 0) -- (3,3) -- >>> countPred @(Index 9, Index 2) (1, 0) -- (0,1) -- >>> countPred @(Either (Index 9) (Index 9)) (Right 0) -- Left 8 countPred :: Counter a => a -> a countPred = snd . countPredOverflow clash-prelude-1.8.1/src/Clash/Class/Counter/0000755000000000000000000000000007346545000016747 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/Counter/Internal.hs0000644000000000000000000001246207346545000021064 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Clash.Class.Counter.Internal where import Clash.CPP (maxTupleSize) import Clash.Class.Counter.TH (genTupleInstances) import Clash.Sized.BitVector (BitVector) import Clash.Sized.Index (Index) import Clash.Sized.Signed (Signed) import Clash.Sized.Unsigned (Unsigned) import Data.Bifunctor (bimap) import GHC.TypeLits (KnownNat, type (<=)) -- $setup -- >>> import Clash.Class.Counter -- >>> import Clash.Sized.BitVector (BitVector) -- >>> import Clash.Sized.Index (Index) -- >>> import Clash.Sized.Signed (Signed) -- >>> import Clash.Sized.Unsigned (Unsigned) -- | t'Clash.Class.Counter.Counter' is a class that composes multiple counters -- into a single one. It is similar to odometers found in olds cars, -- once all counters reach their maximum they reset to zero - i.e. odometer -- rollover. See 'Clash.Class.Counter.countSucc' and 'Clash.Class.Counter.countPred' -- for API usage examples. -- -- Example use case: when driving a monitor through VGA you would like to keep -- track at least two counters: one counting a horizontal position, and one -- vertical. Perhaps a fancy VGA driver would also like to keep track of the -- number of drawn frames. To do so, the three counters are setup with different -- types. On each /round/ of the horizontal counter the vertical counter should -- be increased. On each /round/ of the vertical counter the frame counter should -- be increased. With this class you could simply use the type: -- -- @ -- (FrameCount, VerticalCount, HorizontalCount) -- @ -- -- and have 'Clash.Class.Counter.countSucc' work as described. -- -- __NB__: This class exposes four functions 'countMin', 'countMax', -- 'countSuccOverflow', and 'countPredOverflow'. These functions are considered -- an internal API. Users are encouraged to use 'Clash.Class.Counter.countSucc' -- and 'Clash.Class.Counter.countPred'. -- class Counter a where -- | Value counter wraps around to on a 'countSuccOverflow' overflow countMin :: a default countMin :: Bounded a => a countMin = minBound -- | Value counter wraps around to on a 'countPredOverflow' overflow countMax :: a default countMax :: Bounded a => a countMax = maxBound -- | Gets the successor of @a@. If it overflows, the first part of the tuple -- will be set to True and the second part wraps around to `countMin`. countSuccOverflow :: a -> (Bool, a) default countSuccOverflow :: (Eq a, Enum a, Bounded a) => a -> (Bool, a) countSuccOverflow a | a == maxBound = (True, countMin) | otherwise = (False, succ a) -- | Gets the predecessor of @a@. If it underflows, the first part of the tuple -- will be set to True and the second part wraps around to `countMax`. countPredOverflow :: a -> (Bool, a) default countPredOverflow :: (Eq a, Enum a, Bounded a) => a -> (Bool, a) countPredOverflow a | a == minBound = (True, countMax) | otherwise = (False, pred a) instance (1 <= n, KnownNat n) => Counter (Index n) instance KnownNat n => Counter (Unsigned n) instance KnownNat n => Counter (Signed n) instance KnownNat n => Counter (BitVector n) -- | Counter instance that flip-flops between 'Left' and 'Right'. Examples: -- -- >>> type T = Either (Index 2) (Unsigned 2) -- >>> countSucc @T (Left 0) -- Left 1 -- >>> countSucc @T (Left 1) -- Right 0 -- >>> countSucc @T (Right 0) -- Right 1 instance (Counter a, Counter b) => Counter (Either a b) where countMin = Left countMin countMax = Right countMax countSuccOverflow e = case bimap countSuccOverflow countSuccOverflow e of Left (overflow, a) -> (False, if overflow then Right countMin else Left a) Right (overflow, b) -> (overflow, if overflow then Left countMin else Right b) countPredOverflow e = case bimap countPredOverflow countPredOverflow e of Left (overflow, a) -> (overflow, if overflow then Right countMax else Left a) Right (overflow, b) -> (False, if overflow then Left countMax else Right b) -- | Counters on tuples increment from right-to-left. This makes sense from the -- perspective of LSB/MSB; MSB is on the left-hand-side and LSB is on the -- right-hand-side in other Clash types. -- -- >>> type T = (Unsigned 2, Index 2, Index 2) -- >>> countSucc @T (0, 0, 0) -- (0,0,1) -- >>> countSucc @T (0, 0, 1) -- (0,1,0) -- >>> countSucc @T (0, 1, 0) -- (0,1,1) -- >>> countSucc @T (0, 1, 1) -- (1,0,0) -- -- __NB__: The documentation only shows the instances up to /3/-tuples. By -- default, instances up to and including /12/-tuples will exist. If the flag -- @large-tuples@ is set instances up to the GHC imposed limit will exist. The -- GHC imposed limit is either 62 or 64 depending on the GHC version. instance (Counter a0, Counter a1) => Counter (a0, a1) where -- a0/a1 instead of a/b to be consistent with TH generated instances countMin = (countMin, countMin) countMax = (countMax, countMax) countSuccOverflow (a0, b0) = if overflowB then (overflowA, (a1, b1)) else (overflowB, (a0, b1)) where (overflowB, b1) = countSuccOverflow b0 (overflowA, a1) = countSuccOverflow a0 countPredOverflow (a0, b0) = if overflowB then (overflowA, (a1, b1)) else (overflowB, (a0, b1)) where (overflowB, b1) = countPredOverflow b0 (overflowA, a1) = countPredOverflow a0 genTupleInstances maxTupleSize clash-prelude-1.8.1/src/Clash/Class/Counter/TH.hs0000644000000000000000000000453007346545000017620 0ustar0000000000000000{-# LANGUAGE CPP #-} module Clash.Class.Counter.TH where import Language.Haskell.TH counterName, countMinName, countMaxName, countSuccName, countPredName :: Name counterName = mkName "Counter" countMinName = mkName "countMin" countMaxName = mkName "countMax" countSuccName = mkName "countSuccOverflow" countPredName = mkName "countPredOverflow" mkTupTy :: [Type] -> Type mkTupTy names@(length -> n) = foldl AppT (TupleT n) names mkTup :: [Exp] -> Exp #if MIN_VERSION_template_haskell(2,16,0) mkTup = TupE . map Just #else mkTup = TupE #endif genTupleInstances :: Int -> Q [Dec] genTupleInstances maxTupleSize = mapM genTupleInstance [3..maxTupleSize] genTupleInstance :: Int -> Q Dec genTupleInstance tupSize = do typeVars <- mapM (\n -> VarT <$> newName ("a" <> show n)) [0..tupSize-1] succOverflowBody <- genCountOverflow countSuccName tupSize predOverflowBody <- genCountOverflow countPredName tupSize let minBody = genCount countMinName tupSize maxBody = genCount countMaxName tupSize ctx = map (ConT counterName `AppT`) typeVars typ = ConT counterName `AppT` mkTupTy typeVars decls = [ FunD countMinName [minBody] , FunD countMaxName [maxBody] , FunD (mkName "countSuccOverflow") [succOverflowBody] , FunD (mkName "countPredOverflow") [predOverflowBody] ] pure (InstanceD Nothing ctx typ decls) genCount :: Name -> Int -> Clause genCount nm n = Clause [] (NormalB (mkTup (replicate n (VarE nm)))) [] genCountOverflow :: Name -> Int -> Q Clause genCountOverflow nm tupSize = do varNms <- mapM (\n -> newName ("a" <> show n)) [0..tupSize-1] let vars = map VarE varNms overflowLastNm <- newName "overflowLast" lastNm <- newName "last" overflowInitNm <- newName "overflowInit" initNms <- mapM (\n -> newName ("a" <> show n)) [0..tupSize-2] let body = CondE (VarE overflowLastNm) (mkTup [VarE overflowInitNm, mkTup (map VarE (initNms <> [lastNm]))]) (mkTup [VarE overflowLastNm, mkTup (init vars <> [VarE lastNm])]) decs = [ ValD (TupP [VarP overflowLastNm, VarP lastNm]) (NormalB (VarE nm `AppE` last vars)) [] , ValD (TupP [VarP overflowInitNm, TupP (map VarP initNms)]) (NormalB (VarE nm `AppE` mkTup (init vars))) [] ] pure (Clause [TupP (map VarP varNms)] (NormalB body) decs) clash-prelude-1.8.1/src/Clash/Class/Exp.hs0000644000000000000000000000466307346545000016431 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} module Clash.Class.Exp (Exp, ExpResult, (^)) where import qualified Prelude as P import Prelude hiding ((^)) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Promoted.Nat (SNat(..), snatToInteger) import Clash.Sized.Internal.Index (Index) import Clash.Sized.Internal.Signed (Signed) import Clash.Sized.Internal.Unsigned (Unsigned) import GHC.TypeLits (KnownNat, Nat, type (^), type (*)) import GHC.TypeLits.Extra (Max) -- | Type class implementing exponentiation with explicitly resizing results. class Exp a where type ExpResult a (n :: Nat) -- | Exponentiation with known exponent. (^) :: a -- ^ Base -> SNat n -- ^ Exponent -> ExpResult a n -- ^ Resized result, guaranteed to not have overflown instance KnownNat m => Exp (Index m) where type ExpResult (Index m) n = Index (Max 2 (m ^ n)) (^) = expIndex# {-# INLINE (^) #-} instance KnownNat m => Exp (Signed m) where type ExpResult (Signed m) n = Signed (Max 2 (m * n)) (^) = expSigned# {-# INLINE (^) #-} instance KnownNat m => Exp (Unsigned m) where type ExpResult (Unsigned m) n = Unsigned (Max 1 (m * n)) (^) = expUnsigned# {-# INLINE (^) #-} expIndex# :: KnownNat m => Index m -> SNat n -> Index (Max 2 (m ^ n)) expIndex# b e@SNat = fromInteger (toInteger b P.^ snatToInteger e) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE expIndex# #-} {-# ANN expIndex# hasBlackBox #-} expSigned# :: KnownNat m => Signed m -> SNat n -> Signed (Max 2 (m * n)) expSigned# b e@SNat = fromInteger (toInteger b P.^ snatToInteger e) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE expSigned# #-} {-# ANN expSigned# hasBlackBox #-} expUnsigned# :: KnownNat m => Unsigned m -> SNat n -> Unsigned (Max 1 (m * n)) expUnsigned# b e@SNat = fromInteger (toInteger b P.^ snatToInteger e) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE expUnsigned# #-} {-# ANN expUnsigned# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Class/HasDomain.hs0000644000000000000000000000046207346545000017531 0ustar0000000000000000module Clash.Class.HasDomain ( WithSpecificDomain , WithSingleDomain , HasDomain , TryDomain , TryDomainResult(..) , DomEq ) where -- Compilation is split across modules to maximize GHC parallelism import Clash.Class.HasDomain.HasSingleDomain import Clash.Class.HasDomain.HasSpecificDomain clash-prelude-1.8.1/src/Clash/Class/HasDomain/0000755000000000000000000000000007346545000017173 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Class/HasDomain/CodeGen.hs0000644000000000000000000000377107346545000021043 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} module Clash.Class.HasDomain.CodeGen ( mkTryDomainTuples , mkHasDomainTuples ) where import Language.Haskell.TH.Syntax import Clash.CPP (maxTupleSize) import Language.Haskell.TH.Compat (mkTySynInstD) mkTup :: [Type] -> Type mkTup names@(length -> n) = foldl AppT (TupleT n) names -- | Creates an instance of the form: -- -- type instance TryDomain t (a, b, c, d, e) = Merge t a (b, c, d, e) -- -- With /n/ number of variables on the LHS. mkTryDomainTupleInstance :: Name -> Name -> Int -> Dec mkTryDomainTupleInstance tryDomainName mergeName n = mkTySynInstD tryDomainName [t, tupPat] tupBody where bcde = map (VarT . mkName . ("a"++) . show) [1..n-1] a = VarT (mkName "a0") t = VarT (mkName "t") -- Merge t a (b, c, d, e) tupBody = ConT mergeName `AppT` t `AppT` a `AppT` (mkTup bcde) -- (a, b, c, d, e) tupPat = mkTup (a : bcde) mkTryDomainTuples :: Name -> Name -> Q [Dec] mkTryDomainTuples tryDomainName mergeName = pure (map (mkTryDomainTupleInstance tryDomainName mergeName) [3..maxTupleSize]) -- | Creates an instance of the form: -- -- type instance HasDomain' dom (a, b, c, d, e) = -- Merge' (HasDomain' dom a) (HasDomain' dom (b, c, d, e)) -- -- With /n/ number of variables on the LHS. mkHasDomainTupleInstance :: Name -> Name -> Int -> Dec mkHasDomainTupleInstance hasDomainName mergeName n = mkTySynInstD hasDomainName [dom, tupPat] merge where bcde = map (VarT . mkName . ("a"++) . show) [1..n-1] a = VarT (mkName "a0") dom = VarT (mkName "dom") -- Merge dom a (b, c, d, e) merge = ConT mergeName `AppT` dom `AppT` a `AppT` mkTup bcde -- (a, b, c, d, e) tupPat = mkTup (a : bcde) mkHasDomainTuples :: Name -> Name -> Q [Dec] mkHasDomainTuples hasDomainName mergeName = pure (map (mkHasDomainTupleInstance hasDomainName mergeName) [3..maxTupleSize]) clash-prelude-1.8.1/src/Clash/Class/HasDomain/Common.hs0000644000000000000000000000232707346545000020763 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} module Clash.Class.HasDomain.Common ( Unlines , (:<<>>:) , (:$$$:) , (:++:) -- * Internal , ToEM ) where import GHC.TypeLits (Symbol) import Type.Errors (ErrorMessage(Text, ShowType, (:<>:), (:$$:))) type family ToEM (k :: t) :: ErrorMessage where ToEM (k :: Symbol) = 'Text k ToEM (k :: ErrorMessage) = k ToEM (k :: t) = 'ShowType k infixl 5 :<<>>: type (:<<>>:) (k1 :: t1) (k2 :: t2) = ToEM k1 ':<>: ToEM k2 infixl 4 :$$$: type (:$$$:) (k1 :: t1) (k2 :: t2) = ToEM k1 ':$$: ToEM k2 {- | Combine multiple lines with line break. Type-level version of the @unlines@ function but for ErrorMessage. -} type family Unlines (ln :: [k]) :: ErrorMessage where Unlines '[] = 'Text "" Unlines ((x :: Symbol) ': xs) = 'Text x ':$$: Unlines xs Unlines ((x :: ErrorMessage) ': xs) = x ':$$: Unlines xs infixl 4 :++: type family (:++:) (as :: [k]) (bs :: [k]) :: [k] where (:++:) a '[] = a (:++:) '[] b = b (:++:) (a ': as) bs = a ': (as :++: bs) clash-prelude-1.8.1/src/Clash/Class/HasDomain/HasSingleDomain.hs0000644000000000000000000001675307346545000022550 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Internals for "Clash.Class.HasDomain" -} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-methods #-} {-# OPTIONS_HADDOCK not-home #-} module Clash.Class.HasDomain.HasSingleDomain where import Clash.Class.HasDomain.Common import Clash.Class.HasDomain.CodeGen (mkTryDomainTuples) import Clash.Sized.Vector (Vec) import Clash.Sized.RTree (RTree) import Clash.Sized.Index (Index) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Signed (Signed) import Clash.Sized.BitVector (BitVector, Bit) import Clash.Sized.Fixed (Fixed) import Clash.Signal.Internal (Signal, Domain, Clock, Reset, Enable) import Clash.Signal.Delayed.Internal (DSignal) import Numeric.Natural (Natural) import Data.Kind (Type) import Data.Proxy (Proxy) import GHC.TypeLits (type (+)) import Type.Errors (DelayError, TypeError, IfStuck, Pure) type MissingInstance = "This might happen if an instance for TryDomain is missing. Try to determine" :$$$: "which of the types miss an instance, and add them. Example implementations:" :$$$: "" :$$$: " * type instance TryDomain t (MyVector n a) = TryDomain t a" :$$$: " * type instance TryDomain t (MyCircuit dom a) = Found dom" :$$$: " * type instance TryDomain t Terminal = NotFound" :$$$: "" :$$$: "Alternatively, use one of the withSpecific* functions." type Outro = "" :$$$: "------" :$$$: "" :$$$: "You tried to apply an explicitly routed clock, reset, or enable line" :$$$: "to a construct with, possibly, an implicitly routed one. Clash failed to" :$$$: "unambigously determine a single domain and could therefore not route it." :$$$: "You possibly used one of these sets of functions:" :$$$: "" :$$$: " * with{ClockResetEnable,Clock,Reset,Enable}" :$$$: " * expose{ClockResetEnable,Clock,Reset,Enable}" :$$$: "" :$$$: "These functions are suitable for components defined over a single domain" :$$$: "only. If you want to use multiple domains, use the following instead:" :$$$: "" :$$$: " * withSpecific{ClockResetEnable,Clock,Reset,Enable}" :$$$: " * exposeSpecific{ClockResetEnable,Clock,Reset,Enable}" :$$$: "" type NotFoundError (t :: Type) = "Could not find a non-ambiguous domain in the following type:" :$$$: "" :$$$: " " :<<>>: t :$$$: "" :$$$: MissingInstance :$$$: Outro type AmbiguousError (t :: Type) (dom1 :: Domain) (dom2 :: Domain) = "Could not determine that the domain '" :<<>>: dom1 :<<>>: "'" :$$$: "was equal to the domain '" :<<>>: dom2 :<<>>: "' in the type:" :$$$: "" :$$$: " " :<<>>: t :$$$: "" :$$$: "This is usually resolved by adding explicit type signatures." :$$$: Outro type StuckErrorMsg (orig :: Type) (n :: Type) = "Could not determine whether the following type contained a non-ambiguous domain:" :$$$: "" :$$$: " " :<<>>: n :$$$: "" :$$$: "In the full type:" :$$$: "" :$$$: " " :<<>>: orig :$$$: "" :$$$: "Does it contain one?" :$$$: "" :$$$: "------" :$$$: "" :$$$: MissingInstance :$$$: Outro -- | Type that forces /dom/ to be the same in all subtypes of /r/ that might -- contain a domain. If given a polymorphic domain not tied to /r/, GHC will -- be allowed to infer that that domain is equal to the one in /r/ on the -- condition that /r/ contains just a single domain. type WithSingleDomain dom r = (HasSingleDomain r, dom ~ GetDomain r) data TryDomainResult = NotFound | Ambiguous Domain Domain | Found Domain -- | Type family to resolve type conflicts (if any) type family Merge' (n :: TryDomainResult) (m :: TryDomainResult) :: TryDomainResult where Merge' 'NotFound b = b Merge' ('Ambiguous dom1 dom2) b = 'Ambiguous dom1 dom2 Merge' a 'NotFound = a Merge' a ('Ambiguous dom1 dom2) = 'Ambiguous dom1 dom2 Merge' ('Found dom) ('Found dom) = 'Found dom Merge' ('Found dom1) ('Found dom2) = 'Ambiguous dom1 dom2 -- | Same as Merge', but will insert a type error if Merge' got stuck. type family Merge (orig :: Type) (n :: Type) (m :: Type) :: TryDomainResult where Merge orig n m = IfStuck (TryDomain orig n) (DelayError (StuckErrorMsg orig n)) (Pure (IfStuck (TryDomain orig m) (DelayError (StuckErrorMsg orig m)) (Pure (Merge' (TryDomain orig n) (TryDomain orig m))) )) type family ErrOnConflict (t :: Type) (n :: TryDomainResult) :: Domain where ErrOnConflict t 'NotFound = TypeError (NotFoundError t) ErrOnConflict t ('Ambiguous dom1 dom2) = TypeError (AmbiguousError t dom1 dom2) ErrOnConflict t ('Found dom) = dom type family TryDomain (orig :: Type) (n :: Type) :: TryDomainResult type instance TryDomain t (DSignal dom delay a) = 'Found dom type instance TryDomain t (Signal dom a) = 'Found dom type instance TryDomain t (Clock dom) = 'Found dom type instance TryDomain t (Reset dom) = 'Found dom type instance TryDomain t (Enable dom) = 'Found dom type instance TryDomain t (Proxy dom) = 'Found dom type instance TryDomain t (Vec n a) = TryDomain t a type instance TryDomain t (RTree d a) = TryDomain t a type instance TryDomain t (Index n) = 'NotFound type instance TryDomain t (Unsigned n) = 'NotFound type instance TryDomain t (Signed n) = 'NotFound type instance TryDomain t (BitVector n) = 'NotFound type instance TryDomain t Bit = 'NotFound type instance TryDomain t (Fixed a n m) = TryDomain t (a (n + m)) type instance TryDomain t (a -> b) = Merge t a b type instance TryDomain t (a, b) = Merge t a b type instance TryDomain t () = 'NotFound type instance TryDomain t Bool = 'NotFound type instance TryDomain t Integer = 'NotFound type instance TryDomain t Natural = 'NotFound type instance TryDomain t Int = 'NotFound type instance TryDomain t Float = 'NotFound type instance TryDomain t Double = 'NotFound type instance TryDomain t (Maybe a) = TryDomain t a type instance TryDomain t (Either a b) = Merge t a b -- | Type family that searches a type and checks whether all subtypes that can -- contain a domain (for example, Signal) contain the /same/ domain. Its -- associated type, GetDomain, will yield a type error if that doesn't hold OR -- if it can't check it. class HasSingleDomain (r :: Type) where type GetDomain r :: Domain type GetDomain r = -- Handle types not in TryDomain type family IfStuck (TryDomain r r) (DelayError (StuckErrorMsg r r)) (Pure (ErrOnConflict r (TryDomain r r))) instance HasSingleDomain a mkTryDomainTuples ''TryDomain ''Merge clash-prelude-1.8.1/src/Clash/Class/HasDomain/HasSpecificDomain.hs0000644000000000000000000001356407346545000023051 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Internals for "Clash.Class.HasDomain" -} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-methods #-} {-# OPTIONS_HADDOCK not-home #-} module Clash.Class.HasDomain.HasSpecificDomain where import Clash.Class.HasDomain.CodeGen (mkHasDomainTuples) import Clash.Class.HasDomain.Common import Clash.Sized.Vector (Vec) import Clash.Signal.Internal (Signal, Domain, Clock, Reset, Enable) import Clash.Signal.Delayed.Internal (DSignal) import Data.Proxy (Proxy) import Data.Kind (Type) import Type.Errors (IfStuck, DelayError, Pure, ErrorMessage(ShowType)) type Outro = "" :$$$: "------" :$$$: "" :$$$: "You tried to apply an explicitly routed clock, reset, or enable line" :$$$: "to a construct with, possibly, an implicitly routed one. Clash failed to" :$$$: "unambigously link the given domain (by passing in a 'Clock', 'Reset', or" :$$$: "'Enable') to the component passed in." :$$$: "" type NotFoundError (dom :: Domain) (t :: Type) = "Could not find domain '" :<<>>: 'ShowType dom :<<>>: "' in the following type:" :$$$: "" :$$$: " " :<<>>: t :$$$: "" :$$$: "If that type contains that domain anyway, you might need to provide an" :$$$: "additional type instance of HasDomain. Example implementations:" :$$$: "" :$$$: " * type instance HasDomain dom (MyVector n a) = HasDomain dom a" :$$$: " * type instance HasDomain dom1 (MyCircuit dom2 a) = DomEq dom1 dom2" :$$$: " * type instance HasDomain dom1 (MyTuple a b) = Merge dom a b" :$$$: "" :$$$: Outro -- | Type that forces /dom/ to be present in /r/ at least once. Will resolve to -- a type error if it doesn't. It will always fail if given /dom/ is completely -- polymorphic and can't be tied to /r/ in any way. type WithSpecificDomain dom r = (HasSpecificDomain dom r, dom ~ GetDomain dom r) -- TODO: Extend HasDomainWrapperResult such that it keeps track of what it found / -- TODO: which types are stuck, so that we can report better errors. data HasDomainWrapperResult = NotFound -- ^ No domain found | Found -- ^ Found the specific domain caller was looking for -- | Merge two 'HasDomainWrapperResult's according to the semantics of 'HasDomain. type family MergeWorker (n :: HasDomainWrapperResult) (m :: HasDomainWrapperResult) :: HasDomainWrapperResult where MergeWorker 'Found b = 'Found MergeWorker a 'Found = 'Found MergeWorker 'NotFound 'NotFound = 'NotFound type Merge (dom :: Domain) (n :: Type) (m :: Type) = MergeWorker (HasDomainWrapper dom n) (HasDomainWrapper dom m) type family DomEqWorker (n :: Domain) (m :: Domain) :: HasDomainWrapperResult where DomEqWorker n n = 'Found DomEqWorker n m = 'NotFound -- | Check domain for equality. Return @'Found@ if so, return @'NotFound@ if not. -- The reason d'etre for this type family is that _open_ type families don't -- allow overlapping types. We therefore defer equality checking to a closed -- type family. type DomEq (n :: Domain) (m :: Domain) = IfStuck (DomEqWorker n m) ('NotFound) (Pure (DomEqWorker n m)) -- | Type family that searches a type and checks whether a specific domain is -- present. Will result in either "domain not found, and no others either", -- "domain not found, but found another", or "found domain". type family HasDomain (dom :: Domain) (n :: Type) :: HasDomainWrapperResult type instance HasDomain dom1 (Proxy dom2) = DomEq dom1 dom2 type instance HasDomain dom1 (Signal dom2 a) = DomEq dom1 dom2 type instance HasDomain dom1 (DSignal dom2 delay a) = DomEq dom1 dom2 type instance HasDomain dom1 (Clock dom2) = DomEq dom1 dom2 type instance HasDomain dom1 (Reset dom2) = DomEq dom1 dom2 type instance HasDomain dom1 (Enable dom2) = DomEq dom1 dom2 type instance HasDomain dom (Vec n a) = HasDomain dom a type instance HasDomain dom (a, b) = Merge dom a b type instance HasDomain dom (a -> b) = Merge dom a b type family ErrOnNotFound (dom :: Domain) (n :: HasDomainWrapperResult) (t :: Type) :: Domain where ErrOnNotFound dom 'NotFound t = DelayError (NotFoundError dom t) ErrOnNotFound dom 'Found t = dom -- | Wrapper that checks for stuckness and returns @'NotFound@ if so type family HasDomainWrapper (dom :: Domain) (n :: Type) :: HasDomainWrapperResult where HasDomainWrapper dom n = IfStuck (HasDomain dom n) ('NotFound) (Pure (HasDomain dom n)) -- | Helper function for HasSpecificDomain class (I don't really understand -- why this one is necessary. HasDomainWrapper _should_ check for stuckness -- and does so according to tests.. type family ResolveOrErr (dom :: Domain) (t :: Type) :: Domain where ResolveOrErr dom t = IfStuck (HasDomainWrapper dom t) (ErrOnNotFound dom 'NotFound t) (Pure (ErrOnNotFound dom (HasDomainWrapper dom t) t)) -- | Type class that specifies that a certain domain, /dom/, needs to be present -- in some other type, /r/. This is used to disambiguate what hidden clock, -- reset, and enable lines should be exposed in functions such as -- 'Clash.Signal.withSpecificReset'. -- -- Functions in need of this class should use 'WithSpecificDomain' though, to -- force Clash to display an error instead of letting it silently pass. class HasSpecificDomain (dom :: Domain) (r :: Type) where type GetDomain dom r :: Domain type GetDomain dom r = ResolveOrErr dom r instance HasSpecificDomain dom a mkHasDomainTuples ''HasDomain ''Merge clash-prelude-1.8.1/src/Clash/Class/Num.hs0000644000000000000000000000677607346545000016443 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Class.Num ( -- * Arithmetic functions for arguments and results of different precision ExtendingNum (..) -- * Saturating arithmetic functions , SaturationMode (..) , SaturatingNum (..) , boundedAdd , boundedSub , boundedMul ) where -- * Arithmetic functions for arguments and results of different precision -- | Adding, subtracting, and multiplying values of two different (sub-)types. class ExtendingNum a b where -- | Type of the result of the addition or subtraction type AResult a b -- | Add values of different (sub-)types, return a value of a (sub-)type -- that is potentially different from either argument. add :: a -> b -> AResult a b -- | Subtract values of different (sub-)types, return a value of a (sub-)type -- that is potentially different from either argument. sub :: a -> b -> AResult a b -- | Type of the result of the multiplication type MResult a b -- | Multiply values of different (sub-)types, return a value of a (sub-)type -- that is potentially different from either argument. mul :: a -> b -> MResult a b -- * Saturating arithmetic functions -- | Determine how overflow and underflow are handled by the functions in -- 'SaturatingNum' data SaturationMode = SatWrap -- ^ Wrap around on overflow and underflow | SatBound -- ^ Become 'maxBound' on overflow, and 'minBound' on underflow | SatZero -- ^ Become @0@ on overflow and underflow | SatSymmetric -- ^ Become 'maxBound' on overflow, and (@'minBound' + 1@) on -- underflow for signed numbers, and 'minBound' for unsigned -- numbers. | SatError -- ^ Become an XException on overflow and underflow deriving (Show, Eq, Enum, Bounded) -- | 'Num' operators in which overflow and underflow behavior can be specified -- using 'SaturationMode'. class (Bounded a, Num a) => SaturatingNum a where -- | Addition with parameterizable over- and underflow behavior satAdd :: SaturationMode -> a -> a -> a -- | Subtraction with parameterizable over- and underflow behavior satSub :: SaturationMode -> a -> a -> a -- | Multiplication with parameterizable over- and underflow behavior satMul :: SaturationMode -> a -> a -> a -- | Get successor of (or in other words, add 1 to) given number satSucc :: SaturationMode -> a -> a -- Default method suitable for types that can represent the number 1 satSucc s n = satAdd s n 1 {-# INLINE satSucc #-} -- | Get predecessor of (or in other words, subtract 1 from) given number satPred :: SaturationMode -> a -> a -- Default method suitable for types that can represent the number 1 satPred s n = satSub s n 1 {-# INLINE satPred #-} -- | Addition that clips to 'maxBound' on overflow, and 'minBound' on underflow boundedAdd :: SaturatingNum a => a -> a -> a boundedAdd = satAdd SatBound {-# INLINE boundedAdd #-} -- | Subtraction that clips to 'maxBound' on overflow, and 'minBound' on -- underflow boundedSub :: SaturatingNum a => a -> a -> a boundedSub = satSub SatBound {-# INLINE boundedSub #-} -- | Multiplication that clips to 'maxBound' on overflow, and 'minBound' on -- underflow boundedMul :: SaturatingNum a => a -> a -> a boundedMul = satMul SatBound {-# INLINE boundedMul #-} clash-prelude-1.8.1/src/Clash/Class/Parity.hs0000644000000000000000000000454507346545000017144 0ustar0000000000000000{-| Copyright : (C) 2019, QBayLogic License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# 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 >>> :m -Prelude >>> import Clash.Prelude >>> import Clash.Class.Parity -} -- | 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 clash-prelude-1.8.1/src/Clash/Class/Resize.hs0000644000000000000000000000765607346545000017143 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente 2020, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Class.Resize ( Resize(..) -- * Resize helpers , checkedResize , checkedFromIntegral , checkedTruncateB ) where import Data.Kind (Type) import Data.Proxy (Proxy(Proxy)) import GHC.Stack (HasCallStack) import GHC.TypeLits (Nat, KnownNat, type (+)) -- | Coerce a value to be represented by a different number of bits class Resize (f :: Nat -> Type) where -- | A sign-preserving resize operation -- -- * For signed datatypes: Increasing the size of the number replicates the -- sign bit to the left. Truncating a number to length L keeps the sign bit -- and the rightmost L-1 bits. -- -- * For unsigned datatypes: Increasing the size of the number extends with -- zeros to the left. Truncating a number of length N to a length L just -- removes the left (most significant) N-L bits. resize :: (KnownNat a, KnownNat b) => f a -> f b -- | Perform a 'zeroExtend' for unsigned datatypes, and 'signExtend' for a -- signed datatypes extend :: (KnownNat a, KnownNat b) => f a -> f (b + a) extend = resize -- | Add extra zero bits in front of the MSB zeroExtend :: (KnownNat a, KnownNat b) => f a -> f (b + a) -- | Add extra sign bits in front of the MSB signExtend :: (KnownNat a, KnownNat b) => f a -> f (b + a) signExtend = resize -- | Remove bits from the MSB truncateB :: KnownNat a => f (a + b) -> f a -- | Helper function of 'checkedFromIntegral', 'checkedResize' and 'checkedTruncateB' checkIntegral :: forall a b. HasCallStack => (Integral a, Integral b, Bounded b) => Proxy b -> a -> () checkIntegral Proxy v = if toInteger v > toInteger (maxBound @b) || toInteger v < toInteger (minBound @b) then error $ "Given integral " <> show (toInteger v) <> " is out of bounds for" <> " target type. Bounds of target type are: [" <> show (toInteger (minBound @b)) <> ".." <> show (toInteger (maxBound @b)) <> "]." else () -- | Like 'fromIntegral', but errors if /a/ is out of bounds for /b/. Useful when -- you "know" /a/ can't be out of bounds, but would like to have your assumptions -- checked. -- -- * __NB__: Check only affects simulation. I.e., no checks will be inserted -- into the generated HDL -- * __NB__: 'fromIntegral' is not well suited for Clash as it will go through -- 'Integer' which is arbitrarily bounded in HDL. Instead use -- 'Clash.Class.BitPack.bitCoerce' and the 'Resize' class. checkedFromIntegral :: forall a b. HasCallStack => (Integral a, Integral b, Bounded b) => a -> b checkedFromIntegral v = checkIntegral (Proxy @b) v `seq` fromIntegral v -- | Like 'resize', but errors if /f a/ is out of bounds for /f b/. Useful when -- you "know" /f a/ can't be out of bounds, but would like to have your -- assumptions checked. -- -- __NB__: Check only affects simulation. I.e., no checks will be inserted -- into the generated HDL checkedResize :: forall a b f. ( HasCallStack , Resize f , KnownNat a, Integral (f a) , KnownNat b, Integral (f b), Bounded (f b) ) => f a -> f b checkedResize v = checkIntegral (Proxy @(f b)) v `seq` resize v -- | Like 'truncateB', but errors if /f (a + b)/ is out of bounds for /f a/. Useful -- when you "know" /f (a + b)/ can't be out of bounds, but would like to have your -- assumptions checked. -- -- __NB__: Check only affects simulation. I.e., no checks will be inserted -- into the generated HDL checkedTruncateB :: forall a b f. ( HasCallStack , Resize f , KnownNat b, Integral (f (a + b)) , KnownNat a, Integral (f a), Bounded (f a) ) => f (a + b) -> f a checkedTruncateB v = checkIntegral (Proxy @(f a)) v `seq` truncateB v clash-prelude-1.8.1/src/Clash/Clocks.hs0000644000000000000000000000206007346545000016033 0ustar0000000000000000{-| Copyright : (C) 2018, Google Inc 2019, Myrtle Software Ltd 2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Generic clock related utilities. -} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC "-Wno-orphans" #-} module Clash.Clocks ( Clocks(..) , ClocksSync(..) , ClocksSyncCxt , NumOutClocksSync ) where import Clash.Clocks.Internal (Clocks(..), ClocksSync(..), deriveClocksInstances, deriveClocksSyncInstances) import Clash.Signal.Internal (Domain, KnownDomain) deriveClocksInstances type ClocksSyncCxt t (domIn :: Domain) = ( KnownDomain domIn , ClocksSync t , ClocksResetSynchronizerCxt t , Clocks (ClocksSyncClocksInst t domIn) , ClocksCxt (ClocksSyncClocksInst t domIn) ) type NumOutClocksSync t (domIn :: Domain) = NumOutClocks (ClocksSyncClocksInst t domIn) deriveClocksSyncInstances clash-prelude-1.8.1/src/Clash/Clocks/0000755000000000000000000000000007346545000015501 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Clocks/Internal.hs0000644000000000000000000001231007346545000017606 0ustar0000000000000000{-| Copyright : (C) 2018-2022, Google Inc 2019, Myrtle Software Ltd 2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Clash.Clocks.Internal ( Clocks(..) , deriveClocksInstances , ClocksSync(..) , deriveClocksSyncInstances ) where import Control.Monad.Extra (concatMapM) import Data.Kind (Constraint, Type) import GHC.TypeLits (Nat) import Language.Haskell.TH hiding (Type) import Clash.CPP (haddockOnly) import Clash.Explicit.Reset (resetSynchronizer) import Clash.Explicit.Signal (unsafeSynchronizer) import Clash.Magic (setName) import Clash.Promoted.Symbol (SSymbol(..)) import Clash.Signal.Internal (clockGen, Clock(..), Domain, KnownDomain, Reset, Signal, unsafeFromActiveLow, unsafeToActiveLow) -- | __NB__: The documentation only shows instances up to /3/ output clocks. By -- default, instances up to and including /18/ clocks will exist. class Clocks t where type ClocksCxt t :: Constraint type NumOutClocks t :: Nat clocks :: (KnownDomain domIn, ClocksCxt t) => Clock domIn -> Reset domIn -> t -- Derive instance for /n/ clocks deriveClocksInstance :: Int -> DecsQ deriveClocksInstance n = [d| instance Clocks $instType where type ClocksCxt $instType = $cxtType type NumOutClocks $instType = $numOutClocks clocks (Clock _ Nothing) $(varP rst) = $funcImpl clocks _ _ = error "clocks: dynamic clocks unsupported" {-# CLASH_OPAQUE clocks #-} |] where clkTyVar m = varT $ mkName $ "c" <> show m clkTypes = map (\m -> [t| Clock $(clkTyVar m) |]) [1..n] lockTyVar = varT $ mkName "pllLock" -- (Clock c1, Clock c2, ..., Signal pllLock Bool) instType = foldl appT (tupleT $ n + 1) $ clkTypes <> [ [t| Signal $lockTyVar Bool |] ] clkKnownDoms = map (\m -> [t| KnownDomain $(clkTyVar m) |]) [1..n] -- (KnownDomain c1, KnownDomain c2, ..., KnownDomain pllLock) cxtType = foldl appT (tupleT $ n + 1) $ clkKnownDoms <> [ [t| KnownDomain $lockTyVar |] ] numOutClocks = litT . numTyLit $ toInteger n -- 'clocks' function rst = mkName "rst" lockImpl = [| unsafeSynchronizer clockGen clockGen (unsafeToActiveLow $(varE rst)) |] clkImpls = replicate n [| Clock SSymbol Nothing |] funcImpl = tupE $ clkImpls <> [lockImpl] -- Derive instances for up to and including 18 clocks, except when we are -- generating Haddock deriveClocksInstances :: DecsQ deriveClocksInstances = concatMapM deriveClocksInstance [1..n] where n | haddockOnly = 3 | otherwise = 18 -- | __NB__: The documentation only shows instances up to /3/ output clocks. By -- default, instances up to and including /18/ clocks will exist. class ClocksSync t where type ClocksSyncClocksInst t (domIn :: Domain) :: Type type ClocksResetSynchronizerCxt t :: Constraint clocksResetSynchronizer :: ( KnownDomain domIn , ClocksResetSynchronizerCxt t ) => ClocksSyncClocksInst t domIn -> Clock domIn -> t -- Derive instance for /n/ clocks deriveClocksSyncInstance :: Int -> DecsQ deriveClocksSyncInstance n = [d| instance ClocksSync $instType where type ClocksSyncClocksInst $instType $domInTyVar = $clocksInstType type ClocksResetSynchronizerCxt $instType = $cxtType clocksResetSynchronizer pllOut $(varP clkIn) = let $pllPat = pllOut in $funcImpl |] where clkVarName m = mkName $ "c" <> show m clkTyVar :: Int -> TypeQ clkTyVar = varT . clkVarName clkAndRstTy m = [ [t| Clock $(clkTyVar m) |] , [t| Reset $(clkTyVar m) |] ] -- (Clock c1, Reset c1, Clock c2, Reset c2, ...) instType = foldl appT (tupleT $ n * 2) $ concatMap clkAndRstTy [1..n] domInTyVar = varT $ mkName "domIn" clkTypes = map (\m -> [t| Clock $(clkTyVar m) |]) [1..n] -- (Clock c1, Clock c2, ..., Signal domIn Bool) clocksInstType = foldl appT (tupleT $ n + 1) $ clkTypes <> [ [t| Signal $domInTyVar Bool |] ] -- (KnownDomain c1, KnownDomain c2, ...) cxtType | n == 1 = [t| KnownDomain $(clkTyVar 1) |] | otherwise = foldl appT (tupleT n) $ map (\m -> [t| KnownDomain $(clkTyVar m) |]) [1..n] -- 'clocksResetSynchronizer' function clkIn = mkName "clkIn" pllLock = mkName "pllLock" -- (c1, c2, ..., pllLock) pllPat = tupP $ map (varP . clkVarName) [1..n] <> [varP pllLock] syncImpl m = [| setName @"resetSynchronizer" (resetSynchronizer $(varE $ clkVarName m) (unsafeFromActiveLow (unsafeSynchronizer $(varE clkIn) $(varE $ clkVarName m) $(varE pllLock)))) |] clkAndRstExp m = [ varE $ clkVarName m , syncImpl m ] -- (c1, r1, c2, r2, ...) where rN is the synchronized reset for clock N funcImpl = tupE $ concatMap clkAndRstExp [1..n] -- Derive instances for up to and including 18 clocks, except when we are -- generating Haddock deriveClocksSyncInstances :: DecsQ deriveClocksSyncInstances = concatMapM deriveClocksSyncInstance [1..n] where n | haddockOnly = 3 | otherwise = 18 clash-prelude-1.8.1/src/Clash/Examples.hs0000644000000000000000000002244207346545000016401 0ustar0000000000000000{-| Copyright : © 2015-2016, Christiaan Baaij, 2017 , Google Inc. 2019 , Myrtle Software Ltd Licence : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/) -} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-unused-imports #-} module Clash.Examples ( -- * Decoders and Encoders -- $decoders_and_encoders -- * Counters -- $counters -- * Parity and CRC -- $parity_and_crc -- * UART model -- $uart ) where import Clash.Prelude import Control.Lens import Control.Monad import Control.Monad.Trans.State {- $setup >>> :set -XDataKinds >>> import Clash.Prelude >>> import Test.QuickCheck ((===)) >>> import Clash.Examples.Internal -} {- $decoders_and_encoders = Decoder Using a @case@ statement: @ decoderCase :: Bool -> BitVector 4 -> BitVector 16 decoderCase enable binaryIn | enable = case binaryIn of 0x0 -> 0x0001 0x1 -> 0x0002 0x2 -> 0x0004 0x3 -> 0x0008 0x4 -> 0x0010 0x5 -> 0x0020 0x6 -> 0x0040 0x7 -> 0x0080 0x8 -> 0x0100 0x9 -> 0x0200 0xA -> 0x0400 0xB -> 0x0800 0xC -> 0x1000 0xD -> 0x2000 0xE -> 0x4000 0xF -> 0x8000 decoderCase _ _ = 0 @ Using the `shiftL` function: @ decoderShift :: Bool -> BitVector 4 -> BitVector 16 decoderShift enable binaryIn = if enable then 1 ``shiftL`` ('fromIntegral' binaryIn) else 0 @ Examples: >>> decoderCase True 3 0b0000_0000_0000_1000 >>> decoderShift True 7 0b0000_0000_1000_0000 The following property holds: prop> \enable binaryIn -> decoderShift enable binaryIn === decoderCase enable binaryIn = Encoder Using a @case@ statement: @ encoderCase :: Bool -> BitVector 16 -> BitVector 4 encoderCase enable binaryIn | enable = case binaryIn of 0x0001 -> 0x0 0x0002 -> 0x1 0x0004 -> 0x2 0x0008 -> 0x3 0x0010 -> 0x4 0x0020 -> 0x5 0x0040 -> 0x6 0x0080 -> 0x7 0x0100 -> 0x8 0x0200 -> 0x9 0x0400 -> 0xA 0x0800 -> 0xB 0x1000 -> 0xC 0x2000 -> 0xD 0x4000 -> 0xE 0x8000 -> 0xF encoderCase _ _ = 0 @ The following property holds: prop> \en decIn -> en ==> (encoderCase en (decoderCase en decIn) === decIn) -} {- $counters = 8-bit Simple Up Counter Using `register`: @ upCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (Unsigned 8) upCounter enable = s where s = `register` 0 (`mux` enable (s + 1) s) @ = 8-bit Up Counter With Load Using `mealy`: @ upCounterLd :: HiddenClockResetEnable dom => Signal dom (Bool,Bool,Unsigned 8) -> Signal dom (Unsigned 8) upCounterLd = `mealy` upCounterLdT 0 upCounterLdT s (ld,en,dIn) = (s',s) where s' | ld = dIn | en = s + 1 | otherwise = s @ = 8-bit Up-Down counter Using `register` and `mux`: @ upDownCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (Unsigned 8) upDownCounter upDown = s where s = `register` 0 (`mux` upDown (s + 1) (s - 1)) @ The following property holds: prop> \en -> en ==> testFor 1000 (upCounter (pure en) .==. upDownCounter (pure en) :: Signal "System" Bool) = LFSR External/Fibonacci LFSR, for @n=16@ and using the primitive polynominal @1 + x^11 + x^13 + x^14 + x^16@ @ lfsrF' :: BitVector 16 -> BitVector 16 lfsrF' s = 'pack' feedback '++#' 'slice' d15 d1 s where feedback = s'!'5 ``xor`` s'!'3 ``xor`` s'!'2 ``xor`` s'!'0 lfsrF :: HiddenClockResetEnable dom => BitVector 16 -> Signal dom Bit lfsrF seed = 'msb' '<$>' r where r = 'register' seed (lfsrF' '<$>' r) @ We can also build a internal/Galois LFSR which has better timing characteristics. We first define a Galois LFSR parameterizable in its filter taps: @ lfsrGP taps regs = 'zipWith' xorM taps (fb '+>>' regs) where fb = 'last' regs xorM i x | i = x ``xor`` fb | otherwise = x @ Then we can instantiate a 16-bit LFSR as follows: @ lfsrG :: HiddenClockResetEnable dom => BitVector 16 -> Signal dom Bit lfsrG seed = 'last' ('unbundle' r) where r = 'register' ('unpack' seed) (lfsrGP ('unpack' 0b0011010000000000) '<$>' r) @ The following property holds: prop> testFor 100 (lfsrF 0xACE1 .==. lfsrG 0x4645 :: Signal "System" Bool) = Gray counter Using the previously defined @upCounter@: @ grayCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (BitVector 8) grayCounter en = gray '<$>' upCounter en where gray xs = 'pack' ('msb' xs) '++#' 'xor' ('slice' d7 d1 xs) ('slice' d6 d0 xs) @ = One-hot counter Basically a barrel-shifter: @ oneHotCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (BitVector 8) oneHotCounter enable = s where s = 'register' 1 ('mux' enable ('rotateL' '<$>' s '<*>' 1) s) @ -} {- $parity_and_crc = Parity Just 'reduceXor': @ parity :: Unsigned 8 -> Bit parity data_in = `reduceXor` data_in @ = Serial CRC * Width = 16 bits * Truncated polynomial = 0x1021 * Initial value = 0xFFFF * Input data is NOT reflected * Output CRC is NOT reflected * No XOR is performed on the output CRC @ crcT bv dIn = 'replaceBit' 0 dInXor $ 'replaceBit' 5 (bv'!'4 ``xor`` dInXor) $ 'replaceBit' 12 (bv'!'11 ``xor`` dInXor) rotated where dInXor = dIn ``xor`` fb rotated = 'rotateL' bv 1 fb = 'msb' bv crc :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Bool -> Signal dom Bit -> Signal dom (BitVector 16) crc enable ld dIn = s where s = 'register' 0xFFFF ('mux' enable ('mux' ld 0xFFFF (crcT '<$>' s '<*>' dIn)) s) @ -} {- $uart @ {\-\# LANGUAGE RecordWildCards \#-\} module UART (uart) where import Clash.Prelude import Control.Lens import Control.Monad import Control.Monad.Trans.State -- UART RX Logic data RxReg = RxReg { _rx_reg :: BitVector 8 , _rx_data :: BitVector 8 , _rx_sample_cnt :: Unsigned 4 , _rx_cnt :: Unsigned 4 , _rx_frame_err :: Bool , _rx_over_run :: Bool , _rx_empty :: Bool , _rx_d1 :: Bit , _rx_d2 :: Bit , _rx_busy :: Bool } deriving (Generic, NFDataX) makeLenses ''RxReg uartRX r\@(RxReg {..}) rx_in uld_rx_data rx_enable = 'flip' 'execState' r $ do -- Synchronize the async signal rx_d1 '.=' rx_in rx_d2 '.=' _rx_d1 -- Uload the rx data 'when' uld_rx_data $ do rx_data '.=' _rx_reg rx_empty '.=' True -- Receive data only when rx is enabled if rx_enable then do -- Check if just received start of frame 'when' (not _rx_busy && _rx_d2 == 0) $ do rx_busy '.=' True rx_sample_cnt '.=' 1 rx_cnt '.=' 0 -- Star of frame detected, Proceed with rest of data 'when' _rx_busy $ do rx_sample_cnt '+=' 1 -- Logic to sample at middle of data 'when' (_rx_sample_cnt == 7) $ do if _rx_d1 == 1 && _rx_cnt == 0 then rx_busy '.=' False else do rx_cnt '+=' 1 -- start storing the rx data 'when' (_rx_cnt > 0 && _rx_cnt < 9) $ do rx_reg '%=' 'replaceBit' (_rx_cnt - 1) _rx_d2 'when' (_rx_cnt == 9) $ do rx_busy .= False -- Check if End of frame received correctly if _rx_d2 == 0 then rx_frame_err '.=' True else do rx_empty '.=' False rx_frame_err '.=' False -- Check if last rx data was not unloaded rx_over_run '.=' not _rx_empty else do rx_busy .= False -- UART TX Logic data TxReg = TxReg { _tx_reg :: BitVector 8 , _tx_empty :: Bool , _tx_over_run :: Bool , _tx_out :: Bit , _tx_cnt :: Unsigned 4 } deriving (Generic, NFDataX) makeLenses ''TxReg uartTX t\@(TxReg {..}) ld_tx_data tx_data tx_enable = 'flip' 'execState' t $ do 'when' ld_tx_data $ do if not _tx_empty then tx_over_run '.=' False else do tx_reg '.=' tx_data tx_empty '.=' False 'when' (tx_enable && not _tx_empty) $ do tx_cnt '+=' 1 'when' (_tx_cnt == 0) $ tx_out '.=' 0 'when' (_tx_cnt > 0 && _tx_cnt < 9) $ tx_out '.=' _tx_reg '!' (_tx_cnt - 1) 'when' (_tx_cnt == 9) $ do tx_out '.=' 1 tx_cnt '.=' 0 tx_empty '.=' True 'unless' tx_enable $ tx_cnt '.=' 0 -- Combine RX and TX logic uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable = ( _tx_out '<$>' txReg , _tx_empty '<$>' txReg , _rx_data '<$>' rxReg , _rx_empty '<$>' rxReg ) where rxReg = register rxRegInit (uartRX '<$>' rxReg '<*>' rx_in '<*>' uld_rx_data '<*>' rx_enable) rxRegInit = RxReg { _rx_reg = 0 , _rx_data = 0 , _rx_sample_cnt = 0 , _rx_cnt = 0 , _rx_frame_err = False , _rx_over_run = False , _rx_empty = True , _rx_d1 = 1 , _rx_d2 = 1 , _rx_busy = False } txReg = register txRegInit (uartTX '<$>' txReg '<*>' ld_tx_data '<*>' tx_data '<*>' tx_enable) txRegInit = TxReg { _tx_reg = 0 , _tx_empty = True , _tx_over_run = False , _tx_out = 1 , _tx_cnt = 0 } @ -} clash-prelude-1.8.1/src/Clash/Examples/0000755000000000000000000000000007346545000016041 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Examples/Internal.hs0000644000000000000000000001703107346545000020153 0ustar0000000000000000{-| Copyright : © 2015-2016, Christiaan Baaij, 2017 , Google Inc. 2019 , Myrtle Software Ltd Licence : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/) -} {-# 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 #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module Clash.Examples.Internal where import Clash.Prelude hiding (feedback) import Control.Lens import Control.Monad import Control.Monad.Trans.State decoderCase :: Bool -> BitVector 4 -> BitVector 16 decoderCase enable binaryIn | enable = case binaryIn of 0x0 -> 0x0001 0x1 -> 0x0002 0x2 -> 0x0004 0x3 -> 0x0008 0x4 -> 0x0010 0x5 -> 0x0020 0x6 -> 0x0040 0x7 -> 0x0080 0x8 -> 0x0100 0x9 -> 0x0200 0xA -> 0x0400 0xB -> 0x0800 0xC -> 0x1000 0xD -> 0x2000 0xE -> 0x4000 0xF -> 0x8000 decoderCase _ _ = 0 decoderShift :: Bool -> BitVector 4 -> BitVector 16 decoderShift enable binaryIn = if enable then 1 `shiftL` (fromIntegral binaryIn) else 0 encoderCase :: Bool -> BitVector 16 -> BitVector 4 encoderCase enable binaryIn | enable = case binaryIn of 0x0001 -> 0x0 0x0002 -> 0x1 0x0004 -> 0x2 0x0008 -> 0x3 0x0010 -> 0x4 0x0020 -> 0x5 0x0040 -> 0x6 0x0080 -> 0x7 0x0100 -> 0x8 0x0200 -> 0x9 0x0400 -> 0xA 0x0800 -> 0xB 0x1000 -> 0xC 0x2000 -> 0xD 0x4000 -> 0xE 0x8000 -> 0xF encoderCase _ _ = 0 upCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (Unsigned 8) upCounter enable = s where s = register 0 (mux enable (s + 1) s) upCounterLdT :: Num a => a -> (Bool, Bool, a) -> (a,a) upCounterLdT s (ld,en,dIn) = (s',s) where s' | ld = dIn | en = s + 1 | otherwise = s upCounterLd :: HiddenClockResetEnable dom => Signal dom (Bool, Bool, Unsigned 8) -> Signal dom (Unsigned 8) upCounterLd = mealy upCounterLdT 0 upDownCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (Unsigned 8) upDownCounter upDown = s where s = register 0 (mux upDown (s + 1) (s - 1)) lfsrF' :: BitVector 16 -> BitVector 16 lfsrF' s = pack feedback ++# slice (SNat @15) d1 s where feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0 lfsrF :: HiddenClockResetEnable dom => BitVector 16 -> Signal dom Bit lfsrF seed = msb <$> r where r = register seed (lfsrF' <$> r) lfsrGP :: (KnownNat (n + 1), Bits a) => Vec (n + 1) Bool -> Vec (n + 1) a -> Vec (n + 1) a lfsrGP taps regs = zipWith xorM taps (fb +>> regs) where fb = last regs xorM i x | i = x `xor` fb | otherwise = x lfsrG :: HiddenClockResetEnable dom => BitVector 16 -> Signal dom Bit lfsrG seed = last (unbundle r) where r = register (unpack seed) (lfsrGP (unpack 0b0011010000000000) <$> r) grayCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (BitVector 8) grayCounter en = gray <$> upCounter en where gray xs = pack (msb xs) ++# xor (slice d7 d1 xs) (slice d6 d0 xs) oneHotCounter :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom (BitVector 8) oneHotCounter enable = s where s = register 1 (mux enable (rotateL <$> s <*> 1) s) crcT :: (Bits a, BitPack a) => a -> Bit -> a crcT bv dIn = replaceBit 0 dInXor $ replaceBit 5 (bv!4 `xor` dInXor) $ replaceBit 12 (bv!11 `xor` dInXor) rotated where dInXor = dIn `xor` fb rotated = rotateL bv 1 fb = msb bv crc :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Bool -> Signal dom Bit -> Signal dom (BitVector 16) crc enable ld dIn = s where s = register 0xFFFF (mux enable (mux ld 0xFFFF (crcT <$> s <*> dIn)) s) data RxReg = RxReg { _rx_reg :: BitVector 8 , _rx_data :: BitVector 8 , _rx_sample_cnt :: Unsigned 4 , _rx_cnt :: Unsigned 4 , _rx_frame_err :: Bool , _rx_over_run :: Bool , _rx_empty :: Bool , _rx_d1 :: Bit , _rx_d2 :: Bit , _rx_busy :: Bool } deriving (Generic, NFDataX) makeLenses ''RxReg data TxReg = TxReg { _tx_reg :: BitVector 8 , _tx_empty :: Bool , _tx_over_run :: Bool , _tx_out :: Bit , _tx_cnt :: Unsigned 4 } deriving (Generic, NFDataX) makeLenses ''TxReg uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do when ld_tx_data $ do if not _tx_empty then tx_over_run .= False else do tx_reg .= tx_data tx_empty .= False when (tx_enable && not _tx_empty) $ do tx_cnt += 1 when (_tx_cnt == 0) $ tx_out .= 0 when (_tx_cnt > 0 && _tx_cnt < 9) $ tx_out .= _tx_reg ! (_tx_cnt - 1) when (_tx_cnt == 9) $ do tx_out .= 1 tx_cnt .= 0 tx_empty .= True unless tx_enable $ tx_cnt .= 0 uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do -- Synchronize the async signal rx_d1 .= rx_in rx_d2 .= _rx_d1 -- Uload the rx data when uld_rx_data $ do rx_data .= _rx_reg rx_empty .= True -- Receive data only when rx is enabled if rx_enable then do -- Check if just received start of frame when (not _rx_busy && _rx_d2 == 0) $ do rx_busy .= True rx_sample_cnt .= 1 rx_cnt .= 0 -- Star of frame detected, Proceed with rest of data when _rx_busy $ do rx_sample_cnt += 1 -- Logic to sample at middle of data when (_rx_sample_cnt == 7) $ do if _rx_d1 == 1 && _rx_cnt == 0 then rx_busy .= False else do rx_cnt += 1 -- start storing the rx data when (_rx_cnt > 0 && _rx_cnt < 9) $ do rx_reg %= replaceBit (_rx_cnt - 1) _rx_d2 when (_rx_cnt == 9) $ do rx_busy .= False -- Check if End of frame received correctly if _rx_d2 == 0 then rx_frame_err .= True else do rx_empty .= False rx_frame_err .= False -- Check if last rx data was not unloaded rx_over_run .= not _rx_empty else do rx_busy .= False uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable = ( _tx_out <$> txReg , _tx_empty <$> txReg , _rx_data <$> rxReg , _rx_empty <$> rxReg ) where rxReg = register rxRegInit (uartRX <$> rxReg <*> rx_in <*> uld_rx_data <*> rx_enable) rxRegInit = RxReg { _rx_reg = 0 , _rx_data = 0 , _rx_sample_cnt = 0 , _rx_cnt = 0 , _rx_frame_err = False , _rx_over_run = False , _rx_empty = True , _rx_d1 = 1 , _rx_d2 = 1 , _rx_busy = False } txReg = register txRegInit (uartTX <$> txReg <*> ld_tx_data <*> tx_data <*> tx_enable) txRegInit = TxReg { _tx_reg = 0 , _tx_empty = True , _tx_over_run = False , _tx_out = 1 , _tx_cnt = 0 } clash-prelude-1.8.1/src/Clash/Explicit/0000755000000000000000000000000007346545000016044 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Explicit/BlockRam.hs0000644000000000000000000013154107346545000020077 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , Google Inc., 2021-2023, QBayLogic B.V., 2022 , Google Inc., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Block RAM primitives = Using RAMs #usingrams# We will show a rather elaborate example on how you can, and why you might want to use block RAMs. We will build a \"small\" CPU + Memory + Program ROM where we will slowly evolve to using block RAMs. Note that the code is /not/ meant as a de-facto standard on how to do CPU design in Clash. We start with the definition of the Instructions, Register names and machine codes: @ {\-\# LANGUAGE RecordWildCards, TupleSections, DeriveAnyClass \#-\} module CPU where import Clash.Explicit.Prelude type InstrAddr = Unsigned 8 type MemAddr = Unsigned 5 type Value = Signed 8 data Instruction = Compute Operator Reg Reg Reg | Branch Reg Value | Jump Value | Load MemAddr Reg | Store Reg MemAddr | Nop deriving (Eq, Show, Generic, NFDataX) data Reg = Zero | PC | RegA | RegB | RegC | RegD | RegE deriving (Eq, Show, Enum, Generic, NFDataX) data Operator = Add | Sub | Incr | Imm | CmpGt deriving (Eq, Show, Generic, NFDataX) data MachCode = MachCode { inputX :: Reg , inputY :: Reg , result :: Reg , aluCode :: Operator , ldReg :: Reg , rdAddr :: MemAddr , wrAddrM :: Maybe MemAddr , jmpM :: Maybe Value } nullCode = MachCode { inputX = Zero , inputY = Zero , result = Zero , aluCode = Imm , ldReg = Zero , rdAddr = 0 , wrAddrM = Nothing , jmpM = Nothing } @ Next we define the CPU and its ALU: @ cpu :: Vec 7 Value -- ^ Register bank -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( Vec 7 Value , (MemAddr, Maybe (MemAddr,Value), InstrAddr) ) cpu regbank (memOut, instr) = (regbank', (rdAddr, (,aluOut) '<$>' wrAddrM, bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank 'Clash.Sized.Vector.!!' PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank 'Clash.Sized.Vector.!!' inputX regY = regbank 'Clash.Sized.Vector.!!' inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers regbank' = 'Clash.Sized.Vector.replace' Zero 0 $ 'Clash.Sized.Vector.replace' PC nextPC $ 'Clash.Sized.Vector.replace' result aluOut $ 'Clash.Sized.Vector.replace' ldReg memOut $ regbank alu Add x y = x + y alu Sub x y = x - y alu Incr x _ = x + 1 alu Imm x _ = x alu CmpGt x y = if x > y then 1 else 0 @ We initially create a memory out of simple registers: @ dataMem :: KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> Signal dom MemAddr -- ^ Read address -> Signal dom (Maybe (MemAddr,Value)) -- ^ (write address, data in) -> Signal dom Value -- ^ data out dataMem clk rst en rd wrM = 'Clash.Explicit.Mealy.mealy' clk rst en dataMemT ('Clash.Sized.Vector.replicate' d32 0) (bundle (rd,wrM)) where dataMemT mem (rd,wrM) = (mem',dout) where dout = mem 'Clash.Sized.Vector.!!' rd mem' = case wrM of Just (wr,din) -> 'Clash.Sized.Vector.replace' wr din mem _ -> mem @ And then connect everything: @ system :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system instrs clk rst en = memOut where memOut = dataMem clk rst en rdAddr dout (rdAddr,dout,ipntr) = 'Clash.Explicit.Mealy.mealyB' clk rst en cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr) instr = 'Clash.Explicit.Prelude.asyncRom' instrs '<$>' ipntr @ Create a simple program that calculates the GCD of 4 and 6: @ -- Compute GCD of 4 and 6 prog = -- 0 := 4 Compute Incr Zero RegA RegA :> replicate d3 (Compute Incr RegA Zero RegA) ++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> replicate d5 (Compute Incr RegA Zero RegA) ++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil @ And test our system: @ >>> sampleN 32 $ system prog systemClockGen resetGen enableGen [0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ to see that our system indeed calculates that the GCD of 6 and 4 is 2. === Improvement 1: using @asyncRam@ As you can see, it's fairly straightforward to build a memory using registers and read ('Clash.Sized.Vector.!!') and write ('Clash.Sized.Vector.replace') logic. This might however not result in the most efficient hardware structure, especially when building an ASIC. Instead it is preferable to use the 'Clash.Prelude.RAM.asyncRam' function which has the potential to be translated to a more efficient structure: @ system2 :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system2 instrs clk rst en = memOut where memOut = 'Clash.Explicit.RAM.asyncRam' clk clk en d32 rdAddr dout (rdAddr,dout,ipntr) = 'Clash.Explicit.Prelude.mealyB' clk rst en cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr) instr = 'Clash.Prelude.ROM.asyncRom' instrs '<$>' ipntr @ Again, we can simulate our system and see that it works. This time however, we need to disregard the first few output samples, because the initial content of an 'Clash.Prelude.RAM.asyncRam' is /undefined/, and consequently, the first few output samples are also /undefined/. We use the utility function 'Clash.XException.printX' to conveniently filter out the undefinedness and replace it with the string @\"undefined\"@ in the first few leading outputs. @ >>> printX $ sampleN 32 $ system2 prog systemClockGen resetGen enableGen [undefined,undefined,undefined,undefined,undefined,undefined,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ === Improvement 2: using @blockRam@ Finally we get to using 'blockRam'. On FPGAs, 'Clash.Prelude.RAM.asyncRam' will be implemented in terms of LUTs, and therefore take up logic resources. FPGAs also have large(r) memory structures called /block RAMs/, which are preferred, especially as the memories we need for our application get bigger. The 'blockRam' function will be translated to such a /block RAM/. One important aspect of block RAMs is that they have a /synchronous/ read port, meaning unlike an 'Clash.Prelude.RAM.asyncRam', the result of a read command given at time @t@ is output at time @t + 1@. For us that means we need to change the design of our CPU. Right now, upon a load instruction we generate a read address for the memory, and the value at that read address is immediately available to be put in the register bank. We will be using a block RAM, so the value is delayed until the next cycle. Thus, we will also need to delay the register address to which the memory address is loaded: @ cpu2 :: (Vec 7 Value,Reg) -- ^ (Register bank, Load reg addr) -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( (Vec 7 Value, Reg) , (MemAddr, Maybe (MemAddr,Value), InstrAddr) ) cpu2 (regbank, ldRegD) (memOut, instr) = ((regbank', ldRegD'), (rdAddr, (,aluOut) '<$>' wrAddrM, bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank 'Clash.Sized.Vector.!!' PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank 'Clash.Sized.Vector.!!' inputX regY = regbank 'Clash.Sized.Vector.!!' inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers ldRegD' = ldReg -- Delay the ldReg by 1 cycle regbank' = 'Clash.Sized.Vector.replace' Zero 0 $ 'Clash.Sized.Vector.replace' PC nextPC $ 'Clash.Sized.Vector.replace' result aluOut $ 'Clash.Sized.Vector.replace' ldRegD memOut $ regbank @ We can now finally instantiate our system with a 'blockRam': @ system3 :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system3 instrs clk rst en = memOut where memOut = 'blockRam' clk en (replicate d32 0) rdAddr dout (rdAddr,dout,ipntr) = 'Clash.Explicit.Prelude.mealyB' clk rst en cpu2 (('Clash.Sized.Vector.replicate' d7 0),Zero) (memOut,instr) instr = 'Clash.Explicit.Prelude.asyncRom' instrs '<$>' ipntr @ We are, however, not done. We will also need to update our program. The reason being that values that we try to load in our registers won't be loaded into the register until the next cycle. This is a problem when the next instruction immediately depends on this memory value. In our example, this was only the case when we loaded the value @6@, which was stored at address @1@, into @RegB@. Our updated program is thus: @ prog2 = -- 0 := 4 Compute Incr Zero RegA RegA :> replicate d3 (Compute Incr RegA Zero RegA) ++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> replicate d5 (Compute Incr RegA Zero RegA) ++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> Nop :> -- Extra NOP -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil @ When we simulate our system we see that it works. This time again, we need to disregard the first sample, because the initial output of a 'blockRam' is /undefined/. We use the utility function 'Clash.XException.printX' to conveniently filter out the undefinedness and replace it with the string @\"undefined\"@. @ >>> printX $ sampleN 34 $ system3 prog2 systemClockGen resetGen enableGen [undefined,0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ This concludes the short introduction to using 'blockRam'. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} -- See [Note: eta port names for trueDualPortBlockRam] {-# OPTIONS_GHC -fno-do-lambda-eta-expansion #-} -- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c -- as to why we need this. {-# OPTIONS_GHC -fno-cpr-anal #-} module Clash.Explicit.BlockRam ( -- * Block RAM synchronized to an arbitrary clock blockRam , blockRamPow2 , blockRamU , blockRam1 , ResetStrategy(..) -- ** Read/write conflict resolution , readNew -- * True dual-port block RAM -- $tdpbram , trueDualPortBlockRam , RamOp(..) -- * Internal , blockRam# , blockRamU# , blockRam1# , trueDualPortBlockRam# ) where import Clash.HaskellPrelude import Control.Exception (catch, throw) import Control.Monad (forM_) import Control.Monad.ST (ST, runST) import Control.Monad.ST.Unsafe (unsafeInterleaveST, unsafeIOToST, unsafeSTToIO) import Data.Array.MArray (newListArray) import Data.List.Infinite (Infinite(..), (...)) import Data.Maybe (isJust) import Data.Sequence (Seq) import Data.String.Interpolate (__i) import GHC.Arr (STArray, unsafeReadSTArray, unsafeWriteSTArray) import GHC.Generics (Generic) import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^), type (<=)) import Unsafe.Coerce (unsafeCoerce) import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), HDL(..), hasBlackBox) import Clash.Class.Num (SaturationMode(SatBound), satSucc) import Clash.Explicit.BlockRam.Model (TdpbramModelConfig(..), tdpbramModel) import Clash.Explicit.Signal (KnownDomain, Enable, register, fromEnable) import Clash.Promoted.Nat (SNat(..)) import Clash.Signal.Bundle (unbundle) import Clash.Signal.Internal (Clock(..), Reset, Signal (..), invertReset, (.&&.), mux) import Clash.Sized.Index (Index) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Vector (Vec, replicate, iterateI) import Clash.XException (maybeIsX, NFDataX(deepErrorX), defaultSeqX, fromJustX, undefined, XException (..), seqX, errorX) import Clash.XException.MaybeX (MaybeX(..), andX) import qualified Data.Sequence as Seq import qualified Data.List as L import qualified Clash.Sized.Vector as CV {- $tdpbram A true dual-port block RAM has two fully independent, fully functional access ports: port A and port B. Either port can do both RAM reads and writes. These two ports can even be on distinct clock domains, but the memory itself is shared between the ports. This also makes a true dual-port block RAM suitable as a component in a domain crossing circuit (but it needs additional logic for it to be safe, see e.g. 'Clash.Explicit.Synchronizer.asyncFIFOSynchronizer'). A version with implicit clocks can be found in "Clash.Prelude.BlockRam". -} -- start benchmark only -- import GHC.Arr (listArray, unsafeThawSTArray) -- end benchmark only {- $setup >>> import Clash.Explicit.Prelude as C >>> import qualified Data.List as L >>> :set -XDataKinds -XRecordWildCards -XTupleSections -XDeriveAnyClass -XDeriveGeneric >>> type InstrAddr = Unsigned 8 >>> type MemAddr = Unsigned 5 >>> type Value = Signed 8 >>> :{ data Reg = Zero | PC | RegA | RegB | RegC | RegD | RegE deriving (Eq,Show,Enum,C.Generic,NFDataX) :} >>> :{ data Operator = Add | Sub | Incr | Imm | CmpGt deriving (Eq, Show, Generic, NFDataX) :} >>> :{ data Instruction = Compute Operator Reg Reg Reg | Branch Reg Value | Jump Value | Load MemAddr Reg | Store Reg MemAddr | Nop deriving (Eq, Show, Generic, NFDataX) :} >>> :{ data MachCode = MachCode { inputX :: Reg , inputY :: Reg , result :: Reg , aluCode :: Operator , ldReg :: Reg , rdAddr :: MemAddr , wrAddrM :: Maybe MemAddr , jmpM :: Maybe Value } :} >>> :{ nullCode = MachCode { inputX = Zero, inputY = Zero, result = Zero, aluCode = Imm , ldReg = Zero, rdAddr = 0, wrAddrM = Nothing , jmpM = Nothing } :} >>> :{ alu Add x y = x + y alu Sub x y = x - y alu Incr x _ = x + 1 alu Imm x _ = x alu CmpGt x y = if x > y then 1 else 0 :} >>> :{ let cpu :: Vec 7 Value -- ^ Register bank -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( Vec 7 Value , (MemAddr,Maybe (MemAddr,Value),InstrAddr) ) cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank C.!! PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank C.!! inputX regY = regbank C.!! inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers regbank' = replace Zero 0 $ replace PC nextPC $ replace result aluOut $ replace ldReg memOut $ regbank :} >>> :{ let dataMem :: KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> Signal dom MemAddr -> Signal dom (Maybe (MemAddr,Value)) -> Signal dom Value dataMem clk rst en rd wrM = mealy clk rst en dataMemT (C.replicate d32 0) (bundle (rd,wrM)) where dataMemT mem (rd,wrM) = (mem',dout) where dout = mem C.!! rd mem' = case wrM of Just (wr,din) -> replace wr din mem Nothing -> mem :} >>> :{ let system :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system instrs clk rst en = memOut where memOut = dataMem clk rst en rdAddr dout (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ -- Compute GCD of 4 and 6 prog = -- 0 := 4 Compute Incr Zero RegA RegA :> C.replicate d3 (Compute Incr RegA Zero RegA) C.++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> C.replicate d5 (Compute Incr RegA Zero RegA) C.++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil :} >>> :{ let system2 :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system2 instrs clk rst en = memOut where memOut = asyncRam clk clk en d32 rdAddr dout (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ let cpu2 :: (Vec 7 Value,Reg) -- ^ (Register bank, Load reg addr) -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( (Vec 7 Value,Reg) , (MemAddr,Maybe (MemAddr,Value),InstrAddr) ) cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank',ldRegD'),(rdAddr,(,aluOut) <$> wrAddrM,bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank C.!! PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank C.!! inputX regY = regbank C.!! inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers ldRegD' = ldReg -- Delay the ldReg by 1 cycle regbank' = replace Zero 0 $ replace PC nextPC $ replace result aluOut $ replace ldRegD memOut $ regbank :} >>> :{ let system3 :: ( KnownDomain dom , KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom -> Enable dom -> Signal dom Value system3 instrs clk rst en = memOut where memOut = blockRam clk en (C.replicate d32 0) rdAddr dout (rdAddr,dout,ipntr) = mealyB clk rst en cpu2 ((C.replicate d7 0),Zero) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ prog2 = -- 0 := 4 Compute Incr Zero RegA RegA :> C.replicate d3 (Compute Incr RegA Zero RegA) C.++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> C.replicate d5 (Compute Incr RegA Zero RegA) C.++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> Nop :> -- Extra NOP -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil :} -} -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'XException' -- -- === See also: -- -- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like -- this: @'readNew' clk rst en ('blockRam' clk inits) rd wrM@. -- * A large 'Vec' for the initial content may be too inefficient, depending -- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFile' and -- 'Clash.Explicit.BlockRam.Blob.blockRamBlob' for different approaches that -- scale well. -- -- === __Example__ -- @ -- bram40 -- :: 'Clock' dom -- -> 'Enable' dom -- -> 'Signal' dom ('Unsigned' 6) -- -> 'Signal' dom (Maybe ('Unsigned' 6, 'Clash.Sized.BitVector.Bit')) -- -> 'Signal' dom 'Clash.Sized.BitVector.Bit' -- bram40 clk en = 'blockRam' clk en ('Clash.Sized.Vector.replicate' d40 1) -- @ blockRam :: ( KnownDomain dom , HasCallStack , NFDataX a , Enum addr , NFDataX addr ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec n a -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam = \clk gen content rd wrM -> let en = isJust <$> wrM (wr,din) = unbundle (fromJustX <$> wrM) in withFrozenCallStack (blockRam# clk gen content (fromEnum <$> rd) en (fromEnum <$> wr) din) {-# INLINE blockRam #-} -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like -- this: @'readNew' clk rst en ('blockRamPow2' clk inits) rd wrM@. -- * A large 'Vec' for the initial content may be too inefficient, depending -- on how it is constructed. See 'Clash.Explicit.BlockRam.File.blockRamFilePow2' -- and 'Clash.Explicit.BlockRam.Blob.blockRamBlobPow2' for different approaches -- that scale well. -- -- === __Example__ -- @ -- bram32 -- :: 'Clock' dom -- -> 'Enable' dom -- -> 'Signal' dom ('Unsigned' 5) -- -> 'Signal' dom (Maybe ('Unsigned' 5, 'Clash.Sized.BitVector.Bit')) -- -> 'Signal' dom 'Clash.Sized.BitVector.Bit' -- bram32 clk en = 'blockRamPow2' clk en ('Clash.Sized.Vector.replicate' d32 1) -- @ blockRamPow2 :: ( KnownDomain dom , HasCallStack , NFDataX a , KnownNat n ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec (2^n) a -- ^ Initial content of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, a)) -- ^ (Write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamPow2 = \clk en cnt rd wrM -> withFrozenCallStack (blockRam clk en cnt rd wrM) {-# INLINE blockRamPow2 #-} data ResetStrategy (r :: Bool) where ClearOnReset :: ResetStrategy 'True NoClearOnReset :: ResetStrategy 'False -- | A version of 'blockRam' that has no default values set. May be cleared to -- an arbitrary state using a reset function. blockRamU :: forall n dom a r addr . ( KnownDomain dom , HasCallStack , NFDataX a , Enum addr , NFDataX addr , 1 <= n ) => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom -- ^ 'Reset' line. This needs to be asserted for at least /n/ cycles in order -- for the BRAM to be reset to its initial state. -> Enable dom -- ^ 'Enable' line -> ResetStrategy r -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or -- not ('NoClearOnReset'). The reset needs to be asserted for at least /n/ -- cycles to clear the BRAM. -> SNat n -- ^ Number of elements in BRAM -> (Index n -> a) -- ^ If applicable (see 'ResetStrategy' argument), reset BRAM using this function -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamU clk rst0 en rstStrategy n@SNat initF rd0 mw0 = case rstStrategy of ClearOnReset -> -- Use reset infrastructure blockRamU# clk en n rd1 we1 wa1 w1 NoClearOnReset -> -- Ignore reset infrastructure, pass values unchanged blockRamU# clk en n (fromEnum <$> rd0) we0 (fromEnum <$> wa0) w0 where rstBool = register clk rst0 en True (pure False) rstInv = invertReset rst0 waCounter :: Signal dom (Index n) waCounter = register clk rstInv en 0 (satSucc SatBound <$> waCounter) wa0 = fst . fromJustX <$> mw0 w0 = snd . fromJustX <$> mw0 we0 = isJust <$> mw0 rd1 = mux rstBool 0 (fromEnum <$> rd0) we1 = mux rstBool (pure True) we0 wa1 = mux rstBool (fromInteger . toInteger <$> waCounter) (fromEnum <$> wa0) w1 = mux rstBool (initF <$> waCounter) w0 -- | blockRAMU primitive blockRamU# :: forall n dom a . ( KnownDomain dom , HasCallStack , NFDataX a ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Number of elements in BRAM -> Signal dom Int -- ^ Read address @r@ -> Signal dom Bool -- ^ Write enable -> Signal dom Int -- ^ Write address @w@ -> Signal dom a -- ^ Value to write (at address @w@) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamU# clk en SNat = -- TODO: Generalize to single BRAM primitive taking an initialization function blockRam# clk en (CV.map (\i -> deepErrorX $ "Initial value at index " <> show i <> " undefined.") (iterateI @n succ (0 :: Int))) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE blockRamU# #-} {-# ANN blockRamU# hasBlackBox #-} -- | A version of 'blockRam' that is initialized with the same value on all -- memory positions blockRam1 :: forall n dom a r addr . ( KnownDomain dom , HasCallStack , NFDataX a , Enum addr , NFDataX addr , 1 <= n ) => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom -- ^ 'Reset' line. This needs to be asserted for at least /n/ cycles in order -- for the BRAM to be reset to its initial state. -> Enable dom -- ^ 'Enable' line -> ResetStrategy r -- ^ Whether to clear BRAM on asserted reset ('ClearOnReset') or -- not ('NoClearOnReset'). The reset needs to be asserted for at least /n/ -- cycles to clear the BRAM. -> SNat n -- ^ Number of elements in BRAM -> a -- ^ Initial content of the BRAM (replicated /n/ times) -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam1 clk rst0 en rstStrategy n@SNat a rd0 mw0 = case rstStrategy of ClearOnReset -> -- Use reset infrastructure blockRam1# clk en n a rd1 we1 wa1 w1 NoClearOnReset -> -- Ignore reset infrastructure, pass values unchanged blockRam1# clk en n a (fromEnum <$> rd0) we0 (fromEnum <$> wa0) w0 where rstBool = register clk rst0 en True (pure False) rstInv = invertReset rst0 waCounter :: Signal dom (Index n) waCounter = register clk rstInv en 0 (satSucc SatBound <$> waCounter) wa0 = fst . fromJustX <$> mw0 w0 = snd . fromJustX <$> mw0 we0 = isJust <$> mw0 rd1 = mux rstBool 0 (fromEnum <$> rd0) we1 = mux rstBool (pure True) we0 wa1 = mux rstBool (fromInteger . toInteger <$> waCounter) (fromEnum <$> wa0) w1 = mux rstBool (pure a) w0 -- | blockRAM1 primitive blockRam1# :: forall n dom a . ( KnownDomain dom , HasCallStack , NFDataX a ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Number of elements in BRAM -> a -- ^ Initial content of the BRAM (replicated /n/ times) -> Signal dom Int -- ^ Read address @r@ -> Signal dom Bool -- ^ Write enable -> Signal dom Int -- ^ Write address @w@ -> Signal dom a -- ^ Value to write (at address @w@) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam1# clk en n a = -- TODO: Generalize to single BRAM primitive taking an initialization function blockRam# clk en (replicate n a) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE blockRam1# #-} {-# ANN blockRam1# hasBlackBox #-} -- | blockRAM primitive blockRam# :: forall dom a n . ( KnownDomain dom , HasCallStack , NFDataX a ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec n a -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom Int -- ^ Read address @r@ -> Signal dom Bool -- ^ Write enable -> Signal dom Int -- ^ Write address @w@ -> Signal dom a -- ^ Value to write (at address @w@) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam# (Clock _ Nothing) gen content = \rd wen waS wd -> runST $ do ramStart <- newListArray (0,szI-1) contentL -- start benchmark only -- ramStart <- unsafeThawSTArray ramArr -- end benchmark only go ramStart (withFrozenCallStack (deepErrorX "blockRam: intial value undefined")) (fromEnable gen) rd (fromEnable gen .&&. wen) waS wd where contentL = unsafeCoerce content :: [a] szI = L.length contentL -- start benchmark only -- ramArr = listArray (0,szI-1) contentL -- end benchmark only go :: STArray s Int a -> a -> Signal dom Bool -> Signal dom Int -> Signal dom Bool -> Signal dom Int -> Signal dom a -> ST s (Signal dom a) go !ram o ret@(~(re :- res)) rt@(~(r :- rs)) et@(~(e :- en)) wt@(~(w :- wr)) dt@(~(d :- din)) = do o `seqX` (o :-) <$> (ret `seq` rt `seq` et `seq` wt `seq` dt `seq` unsafeInterleaveST (do o' <- unsafeIOToST (catch (if re then unsafeSTToIO (ram `safeAt` r) else pure o) (\err@XException {} -> pure (throw err))) d `defaultSeqX` upd ram e (fromEnum w) d go ram o' res rs en wr din)) upd :: STArray s Int a -> Bool -> Int -> a -> ST s () upd ram we waddr d = case maybeIsX we of Nothing -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> -- Put the XException from `we` as the value at address -- `waddr`. safeUpdate wa (seq we d) ram Just True -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> safeUpdate wa d ram _ -> return () safeAt :: HasCallStack => STArray s Int a -> Int -> ST s a safeAt s i = if (0 <= i) && (i < szI) then unsafeReadSTArray s i else pure $ withFrozenCallStack (deepErrorX ("blockRam: read address " <> show i <> " not in range [0.." <> show szI <> ")")) {-# INLINE safeAt #-} safeUpdate :: HasCallStack => Int -> a -> STArray s Int a -> ST s () safeUpdate i a s = if (0 <= i) && (i < szI) then unsafeWriteSTArray s i a else let d = withFrozenCallStack (deepErrorX ("blockRam: write address " <> show i <> " not in range [0.." <> show szI <> ")")) in forM_ [0..(szI-1)] (\j -> unsafeWriteSTArray s j d) {-# INLINE safeUpdate #-} blockRam# _ _ _ = error "blockRam#: dynamic clocks not supported" {-# ANN blockRam# hasBlackBox #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE blockRam# #-} -- | Create a read-after-write block RAM from a read-before-write one readNew :: ( KnownDomain dom , NFDataX a , Eq addr ) => Clock dom -> Reset dom -> Enable dom -> (Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a) -- ^ The BRAM component -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (Write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle readNew clk rst en ram rdAddr wrM = mux wasSame wasWritten $ ram rdAddr wrM where readNewT rd (Just (wr, wrdata)) = (wr == rd, wrdata) readNewT _ Nothing = (False , undefined) (wasSame,wasWritten) = unbundle (register clk rst en (False, undefined) (readNewT <$> rdAddr <*> wrM)) -- | Port operation data RamOp n a = RamRead (Index n) -- ^ Read from address | RamWrite (Index n) a -- ^ Write data to address | RamNoOp -- ^ No operation deriving (Generic, NFDataX, Show) ramOpAddr :: RamOp n a -> Index n ramOpAddr (RamRead addr) = addr ramOpAddr (RamWrite addr _) = addr ramOpAddr RamNoOp = errorX "Address for No operation undefined" isRamWrite :: RamOp n a -> Bool isRamWrite (RamWrite {}) = True isRamWrite _ = False ramOpWriteVal :: RamOp n a -> Maybe a ramOpWriteVal (RamWrite _ val) = Just val ramOpWriteVal _ = Nothing isOp :: RamOp n a -> Bool isOp RamNoOp = False isOp _ = True -- | Produces vendor-agnostic HDL that will be inferred as a true dual-port -- block RAM -- -- Any value that is being written on a particular port is also the -- value that will be read on that port, i.e. the same-port read/write behavior -- is: WriteFirst. For mixed-port read/write, when port A writes to the address -- port B reads from, the output of port B is undefined, and vice versa. trueDualPortBlockRam :: forall nAddrs domA domB a . ( HasCallStack , KnownNat nAddrs , KnownDomain domA , KnownDomain domB , NFDataX a ) => Clock domA -- ^ Clock for port A -> Clock domB -- ^ Clock for port B -> Signal domA (RamOp nAddrs a) -- ^ RAM operation for port A -> Signal domB (RamOp nAddrs a) -- ^ RAM operation for port B -> (Signal domA a, Signal domB a) -- ^ Outputs data on /next/ cycle. When writing, the data written -- will be echoed. When reading, the read data is returned. {-# INLINE trueDualPortBlockRam #-} trueDualPortBlockRam = \clkA clkB opA opB -> trueDualPortBlockRamWrapper clkA (isOp <$> opA) (isRamWrite <$> opA) (ramOpAddr <$> opA) (fromJustX . ramOpWriteVal <$> opA) clkB (isOp <$> opB) (isRamWrite <$> opB) (ramOpAddr <$> opB) (fromJustX . ramOpWriteVal <$> opB) -- [Note: eta port names for trueDualPortBlockRam] -- -- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC -- option for this module, the generated HDL also contains names based on the -- argument names used here. This greatly improves readability of the HDL. -- [Note: true dual-port blockRAM separate architecture] -- -- A multi-clock true dual-port block RAM is only inferred from the generated HDL -- when it lives in its own Verilog module / VHDL architecture. Add any other -- logic to the module / architecture, and synthesis will no longer infer a -- multi-clock true dual-port block RAM. This wrapper pushes the primitive out -- into its own module / architecture. trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = trueDualPortBlockRam# clkA enA weA addrA datA clkB enB weB addrB datB -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE trueDualPortBlockRamWrapper #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE trueDualPortBlockRam# #-} {-# ANN trueDualPortBlockRam# hasBlackBox #-} {-# ANN trueDualPortBlockRam# ( let bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs :< _knownDomainA :< _knownDomainB :< _nfdataX :< clockA :< enaA :< wenaA :< addrA :< datA :< clockB :< enaB :< wenaB :< addrB :< datB :< _ = ((0 :: Int)...) symBlockName :< symDoutA :< symDoutB :< _ = ((0 :: Int)...) in InlineYamlPrimitive [VHDL] [__i| BlackBox: name: "#{bbName}" kind: Declaration template: |- -- trueDualPortBlockRam begin ~GENSYM[~RESULT_trueDualPortBlockRam][#{symBlockName}] : block -- Shared memory type mem_type is array ( ~LIT[#{knownNatAddrs}]-1 downto 0 ) of ~TYP[#{datA}]; shared variable mem : mem_type; signal ~GENSYM[a_dout][#{symDoutA}] : ~TYP[#{datA}]; signal ~GENSYM[b_dout][#{symDoutB}] : ~TYP[#{datB}]; begin -- Port A process(~ARG[#{clockA}]) begin if(rising_edge(~ARG[#{clockA}])) then if(~ARG[#{enaA}]) then if(~ARG[#{wenaA}]) then mem(~IF~SIZE[~TYP[#{addrA}]]~THENto_integer(~ARG[#{addrA}])~ELSE0~FI) := ~ARG[#{datA}]; end if; ~SYM[#{symDoutA}] <= mem(~IF~SIZE[~TYP[#{addrA}]]~THENto_integer(~ARG[#{addrA}])~ELSE0~FI); end if; end if; end process; -- Port B process(~ARG[#{clockB}]) begin if(rising_edge(~ARG[#{clockB}])) then if(~ARG[#{enaB}]) then if(~ARG[#{wenaB}]) then mem(~IF~SIZE[~TYP[#{addrB}]]~THENto_integer(~ARG[#{addrB}])~ELSE0~FI) := ~ARG[#{datB}]; end if; ~SYM[#{symDoutB}] <= mem(~IF~SIZE[~TYP[#{addrB}]]~THENto_integer(~ARG[#{addrB}])~ELSE0~FI); end if; end if; end process; ~RESULT <= (~SYM[#{symDoutA}], ~SYM[#{symDoutB}]); end block; -- end trueDualPortBlockRam |]) #-} {-# ANN trueDualPortBlockRam# ( let bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs :< knownDomainA :< knownDomainB :< _nfdataX :< clockA :< enaA :< wenaA :< addrA :< datA :< clockB :< enaB :< wenaB :< addrB :< datB :< _ = ((0 :: Int)...) symMem :< symDoutA :< symDoutB :< _ = ((0 :: Int)...) in InlineYamlPrimitive [SystemVerilog] [__i| BlackBox: name: "#{bbName}" kind: Declaration template: |- // trueDualPortBlockRam begin // Shared memory logic [~SIZE[~TYP[#{datA}]]-1:0] ~GENSYM[mem][#{symMem}] [~LIT[#{knownNatAddrs}]-1:0]; ~SIGD[~GENSYM[a_dout][#{symDoutA}]][#{datA}]; ~SIGD[~GENSYM[b_dout][#{symDoutB}]][#{datB}]; // Port A always @(~IF~ACTIVEEDGE[Rising][#{knownDomainA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin if(~ARG[#{enaA}]) begin ~SYM[#{symDoutA}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI]; if(~ARG[#{wenaA}]) begin ~SYM[#{symDoutA}] <= ~ARG[#{datA}]; ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI] <= ~ARG[#{datA}]; end end end // Port B always @(~IF~ACTIVEEDGE[Rising][#{knownDomainB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin if(~ARG[#{enaB}]) begin ~SYM[#{symDoutB}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI]; if(~ARG[#{wenaB}]) begin ~SYM[#{symDoutB}] <= ~ARG[#{datB}]; ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI] <= ~ARG[#{datB}]; end end end assign ~RESULT = {~SYM[#{symDoutA}], ~SYM[#{symDoutB}]}; // end trueDualPortBlockRam |]) #-} {-# ANN trueDualPortBlockRam# ( let bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs :< knownDomainA :< knownDomainB :< _nfdataX :< clockA :< enaA :< wenaA :< addrA :< datA :< clockB :< enaB :< wenaB :< addrB :< datB :< _ = ((0 :: Int)...) symMem :< symDoutA :< symDoutB :< _ = ((0 :: Int)...) in InlineYamlPrimitive [Verilog] [__i| BlackBox: name: "#{bbName}" kind: Declaration template: |- // trueDualPortBlockRam begin // Shared memory reg [~SIZE[~TYP[#{datA}]]-1:0] ~GENSYM[mem][#{symMem}] [~LIT[#{knownNatAddrs}]-1:0]; reg ~SIGD[~GENSYM[a_dout][#{symDoutA}]][#{datA}]; reg ~SIGD[~GENSYM[b_dout][#{symDoutB}]][#{datB}]; // Port A always @(~IF~ACTIVEEDGE[Rising][#{knownDomainA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin if(~ARG[#{enaA}]) begin ~SYM[#{symDoutA}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI]; if(~ARG[#{wenaA}]) begin ~SYM[#{symDoutA}] <= ~ARG[#{datA}]; ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI] <= ~ARG[#{datA}]; end end end // Port B always @(~IF~ACTIVEEDGE[Rising][#{knownDomainB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin if(~ARG[#{enaB}]) begin ~SYM[#{symDoutB}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI]; if(~ARG[#{wenaB}]) begin ~SYM[#{symDoutB}] <= ~ARG[#{datB}]; ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI] <= ~ARG[#{datB}]; end end end assign ~RESULT = {~SYM[#{symDoutA}], ~SYM[#{symDoutB}]}; // end trueDualPortBlockRam |]) #-} -- | Primitive for 'trueDualPortBlockRam' -- trueDualPortBlockRam#, trueDualPortBlockRamWrapper :: forall nAddrs domA domB a . ( HasCallStack , KnownNat nAddrs , KnownDomain domA , KnownDomain domB , NFDataX a ) => Clock domA -> -- | Enable Signal domA Bool -> -- | Write enable Signal domA Bool -> -- | Address Signal domA (Index nAddrs) -> -- | Write data Signal domA a -> Clock domB -> -- | Enable Signal domB Bool -> -- | Write enable Signal domB Bool -> -- | Address Signal domB (Index nAddrs) -> -- | Write data Signal domB a -> (Signal domA a, Signal domB a) trueDualPortBlockRam# clkA enA weA addrA datA clkB enB weB addrB datB = tdpbramModel TdpbramModelConfig { tdpIsActiveWriteEnable = id , tdpMergeWriteEnable = andX , tdpUpdateRam = updateRam } clkA enA addrA weA datA clkB enB addrB weB datB where updateRam :: Int -> MaybeX Bool -> a -> Seq a -> Seq a updateRam addr writeEnable dat mem = case writeEnable of IsDefined False -> mem IsDefined True -> Seq.update addr dat mem IsX msg -> Seq.update addr dat $ deepErrorX $ "Write enable unknown; position" <> show addr <> "\nWrite enable error message: " <> msg clash-prelude-1.8.1/src/Clash/Explicit/BlockRam/0000755000000000000000000000000007346545000017536 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Explicit/BlockRam/Blob.hs0000644000000000000000000003176707346545000020766 0ustar0000000000000000{-| Copyright : (C) 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Efficient bundling of initial RAM content with the compiled code Leveraging Template Haskell, the initial content for the block RAM components in this module is stored alongside the compiled Haskell code. It covers use cases where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be problematically slow. The data is stored efficiently, with very little overhead (worst-case 7%, often no overhead at all). Unlike "Clash.Explicit.BlockRam.File", "Clash.Explicit.BlockRam.Blob" generates practically the same HDL as "Clash.Explicit.BlockRam" and is compatible with all tools consuming the generated HDL. -} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.BlockRam.Blob ( -- * Block RAMs initialized with a 'MemBlob' blockRamBlob , blockRamBlobPow2 -- * Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- * Internal , blockRamBlob# ) where import Control.Exception (catch, throw) import Control.Monad (forM_) import Control.Monad.ST (ST, runST) import Control.Monad.ST.Unsafe (unsafeInterleaveST, unsafeIOToST, unsafeSTToIO) import Data.Array.MArray (newListArray) import qualified Data.ByteString.Lazy as L import Data.Maybe (isJust) import GHC.Arr (STArray, unsafeReadSTArray, unsafeWriteSTArray) import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Language.Haskell.TH (DecsQ, ExpQ, integerL, litE, litT, mkName, normalB, numTyLit, sigD, stringPrimL, valD, varP) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack.Internal (BitPack, BitSize) import Clash.Explicit.BlockRam.Internal (MemBlob(..), packBVs, unpackMemBlob, unpackMemBlob0) import Clash.Explicit.Signal (KnownDomain, Enable, fromEnable) import Clash.Promoted.Nat (natToInteger, natToNum) import Clash.Signal.Bundle (unbundle) import Clash.Signal.Internal (Clock, Signal(..), (.&&.)) import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..)) import Clash.Sized.Internal.Unsigned (Unsigned) import Clash.XException (maybeIsX, deepErrorX, defaultSeqX, fromJustX, NFDataX, XException (..), seqX) -- $setup -- >>> :set -XTemplateHaskell -- >>> :set -fplugin GHC.TypeLits.Normalise -- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver -- >>> :m -Prelude -- >>> import Clash.Explicit.Prelude -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining -- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' -- clk rst en ('blockRamBlob' clk en content) rd wrM@. blockRamBlob :: forall dom addr m n . ( KnownDomain dom , Enum addr , NFDataX addr ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob n m -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamBlob = \clk gen content@MemBlob{} rd wrM -> let en = isJust <$> wrM (wr,din) = unbundle (fromJustX <$> wrM) in blockRamBlob# clk gen content (fromEnum <$> rd) en (fromEnum <$> wr) din {-# INLINE blockRamBlob #-} -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining -- write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' -- clk rst en ('blockRamBlobPow2' clk en content) rd wrM@. blockRamBlobPow2 :: forall dom m n . ( KnownDomain dom , KnownNat n ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob (2^n) m -- ^ Initial content of the BRAM, also determines the size, 2^@n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamBlobPow2 = blockRamBlob {-# INLINE blockRamBlobPow2 #-} -- | blockRAMBlob primitive blockRamBlob# :: forall dom m n . KnownDomain dom => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob n m -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom Int -- ^ Read address @r@ -> Signal dom Bool -- ^ Write enable -> Signal dom Int -- ^ Write address @w@ -> Signal dom (BitVector m) -- ^ Value to write (at address @w@) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamBlob# !_ gen content@MemBlob{} = \rd wen waS wd -> runST $ do bvList <- unsafeIOToST (unpackMemBlob0 content) ramStart <- newListArray (0,szI-1) bvList go ramStart (withFrozenCallStack (deepErrorX "blockRamBlob: intial value undefined")) (fromEnable gen) rd (fromEnable gen .&&. wen) waS wd where szI = natToNum @n @Int go :: STArray s Int (BitVector m) -> BitVector m -> Signal dom Bool -> Signal dom Int -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m) -> ST s (Signal dom (BitVector m)) go !ram o ret@(~(re :- res)) rt@(~(r :- rs)) et@(~(e :- en)) wt@(~(w :- wr)) dt@(~(d :- din)) = do o `seqX` (o :-) <$> (ret `seq` rt `seq` et `seq` wt `seq` dt `seq` unsafeInterleaveST (do o' <- unsafeIOToST (catch (if re then unsafeSTToIO (ram `safeAt` r) else pure o) (\err@XException {} -> pure (throw err))) d `defaultSeqX` upd ram e w d go ram o' res rs en wr din)) upd :: STArray s Int (BitVector m) -> Bool -> Int -> BitVector m -> ST s () upd ram we waddr d = case maybeIsX we of Nothing -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> -- Put the XException from `we` as the value at address -- `waddr`. safeUpdate wa (seq we d) ram Just True -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> safeUpdate wa d ram _ -> return () safeAt :: STArray s Int (BitVector m) -> Int -> ST s (BitVector m) safeAt s i = if (0 <= i) && (i < szI) then unsafeReadSTArray s i else pure $ withFrozenCallStack (deepErrorX ("blockRamBlob: read address " <> show i <> " not in range [0.." <> show szI <> ")")) {-# INLINE safeAt #-} safeUpdate :: Int -> BitVector m -> STArray s Int (BitVector m) -> ST s () safeUpdate i a s = if (0 <= i) && (i < szI) then unsafeWriteSTArray s i a else let d = withFrozenCallStack (deepErrorX ("blockRam: write address " <> show i <> " not in range [0.." <> show szI <> ")")) in forM_ [0..(szI-1)] (\j -> unsafeWriteSTArray s j d) {-# INLINE safeUpdate #-} {-# ANN blockRamBlob# hasBlackBox #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE blockRamBlob# #-} -- | Create a 'MemBlob' binding from a list of values -- -- Since this uses Template Haskell, nothing in the arguments given to -- 'createMemBlob' can refer to something defined in the same module. -- -- === __Example__ -- -- @ -- 'createMemBlob' "content" 'Nothing' [15 :: Unsigned 8 .. 17] -- -- ram clk en = 'blockRamBlob' clk en content -- @ -- -- The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value -- does not matter. But the bits need a defined value in the memory. Either 0 or -- 1 can be used, and both are valid representations of the data. -- -- >>> import qualified Prelude as P -- >>> let es = [ Nothing, Just (7 :: Unsigned 8), Just 8 ] -- >>> :{ -- createMemBlob "content0" (Just 0) es -- createMemBlob "content1" (Just 1) es -- x = 1 -- :} -- -- >>> let pr = mapM_ (putStrLn . show) -- >>> pr $ P.map pack es -- 0b0_...._.... -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> pr $ unpackMemBlob content0 -- 0b0_0000_0000 -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> pr $ unpackMemBlob content1 -- 0b0_1111_1111 -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> :{ -- createMemBlob "contentN" Nothing es -- x = 1 -- :} -- -- :...: error:... -- packBVs: cannot convert don't care values. Please specify a mapping to a definite value. -- -- Note how we hinted to @clashi@ that our multi-line command was a list of -- declarations by including a dummy declaration @x = 1@. Without this trick, -- @clashi@ would expect an expression and the Template Haskell would not work. createMemBlob :: forall a f . ( Foldable f , BitPack a ) => String -- ^ Name of the binding to generate -> Maybe Bit -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on -- don't care bits. -> f a -- ^ The content for the 'MemBlob' -> DecsQ createMemBlob name care es = case packed of Left err -> fail err Right _ -> sequence [ sigD name0 [t| MemBlob $(n) $(m) |] , valD (varP name0) (normalB [| MemBlob { memBlobRunsLen = $(runsLen) , memBlobRuns = $(runs) , memBlobEndsLen = $(endsLen) , memBlobEnds = $(ends) } |]) [] ] where name0 = mkName name n = litT . numTyLit . toInteger $ len m = litT . numTyLit $ natToInteger @(BitSize a) runsLen = litE . integerL . toInteger $ L.length runsB runs = litE . stringPrimL $ L.unpack runsB endsLen = litE . integerL . toInteger $ L.length endsB ends = litE . stringPrimL $ L.unpack endsB (len, runsB, endsB) = either error id packed packed = packBVs care es -- | Create a 'MemBlob' from a list of values -- -- Since this uses Template Haskell, nothing in the arguments given to -- 'memBlobTH' can refer to something defined in the same module. -- -- === __Example__ -- -- @ -- ram clk en = 'blockRamBlob' clk en $(memBlobTH Nothing [15 :: Unsigned 8 .. 17]) -- @ -- -- The 'Data.Maybe.Maybe' datatype has don't care bits, where the actual value -- does not matter. But the bits need a defined value in the memory. Either 0 or -- 1 can be used, and both are valid representations of the data. -- -- >>> import qualified Prelude as P -- >>> let es = [ Nothing, Just (7 :: Unsigned 8), Just 8 ] -- >>> content0 = $(memBlobTH (Just 0) es) -- >>> content1 = $(memBlobTH (Just 1) es) -- >>> let pr = mapM_ (putStrLn . show) -- >>> pr $ P.map pack es -- 0b0_...._.... -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> pr $ unpackMemBlob content0 -- 0b0_0000_0000 -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> pr $ unpackMemBlob content1 -- 0b0_1111_1111 -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> $(memBlobTH Nothing es) -- -- :...: error:... -- • packBVs: cannot convert don't care values. Please specify a mapping to a definite value. -- • In the untyped splice: $(memBlobTH Nothing es) memBlobTH :: forall a f . ( Foldable f , BitPack a ) => Maybe Bit -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on -- don't care bits. -> f a -- ^ The content for the 'MemBlob' -> ExpQ memBlobTH care es = case packed of Left err -> fail err Right _ -> [| MemBlob { memBlobRunsLen = $(runsLen) , memBlobRuns = $(runs) , memBlobEndsLen = $(endsLen) , memBlobEnds = $(ends) } :: MemBlob $(n) $(m) |] where n = litT . numTyLit . toInteger $ len m = litT . numTyLit $ natToInteger @(BitSize a) runsLen = litE . integerL . toInteger $ L.length runsB runs = litE . stringPrimL $ L.unpack runsB endsLen = litE . integerL . toInteger $ L.length endsB ends = litE . stringPrimL $ L.unpack endsB (len, runsB, endsB) = either error id packed packed = packBVs care es clash-prelude-1.8.1/src/Clash/Explicit/BlockRam/File.hs0000644000000000000000000003610507346545000020756 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Initializing a block RAM with a data file #usingramfiles# Block RAM primitives that can be initialized with a data file. The BNF grammar for this data file is simple: @ FILE = LINE+ LINE = BIT+ BIT = '0' | '1' @ Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: @ 000000111 000001000 000001001 000001010 000001011 000001100 000001101 @ Such a file can be produced with 'memFile': @ writeFile "memory.bin" (memFile Nothing [7 :: Unsigned 9 .. 13]) @ We can instantiate a block RAM using the contents of the file above like so: @ f :: KnownDomain dom => Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) f clk en rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' clk en d7 \"memory.bin\" rd (signal Nothing) @ In the example above, we basically treat the block RAM as a synchronous ROM. We can see that it works as expected: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ f systemClockGen enableGen (fromList [3..5])__ [10,11,12] @ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ g :: KnownDomain dom => Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) g clk en rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' clk en d7 \"memory.bin\" rd (signal Nothing) @ And then we would see: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ g systemClockGen enableGen (fromList [3..5])__ [(1,2),(1,3)(1,-4)] @ -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} -- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c -- as to why we need this. {-# OPTIONS_GHC -fno-cpr-anal #-} module Clash.Explicit.BlockRam.File ( -- * Block RAM synchronized to an arbitrary clock blockRamFile , blockRamFilePow2 -- * Producing files , memFile -- * Internal , blockRamFile# , initMem ) where import Control.Exception (catch, throw) import Control.Monad (forM_) import Control.Monad.ST (ST, runST) import Control.Monad.ST.Unsafe (unsafeInterleaveST, unsafeIOToST, unsafeSTToIO) import Data.Array.MArray (newArray_) import Data.Bits ((.&.), (.|.), shiftL, xor) import Data.Char (digitToInt) import Data.Maybe (isJust, listToMaybe) import GHC.Arr (STArray, unsafeReadSTArray, unsafeWriteSTArray) import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownNat) import Numeric (readInt) import System.IO import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack (BitPack, BitSize, pack) import Clash.Promoted.Nat (SNat (..), pow2SNat, natToNum, snatToNum) import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..), undefined#) import Clash.Signal.Internal (Clock(..), Signal (..), Enable, KnownDomain, fromEnable, (.&&.)) import Clash.Signal.Bundle (unbundle) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (maybeIsX, seqX, fromJustX, NFDataX(..), XException (..)) -- start benchmark only -- import GHC.Arr (unsafeFreezeSTArray, unsafeThawSTArray) -- end benchmark only -- $setup -- >>> :m -Prelude -- >>> :set -fplugin GHC.TypeLits.Normalise -- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver -- >>> import Clash.Prelude -- >>> import Clash.Prelude.BlockRam.File -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' clk rst en (blockRamFilePow2' clk en file) rd wrM@. -- * See "Clash.Explicit.BlockRam.File#usingramfiles" for more information on how -- to instantiate a block RAM with the contents of a data file. -- * See 'memFile' for creating a data file with Clash. -- * See "Clash.Explicit.Fixed#creatingdatafiles" for more ideas on how to -- create your own data files. blockRamFilePow2 :: forall dom n m . (KnownDomain dom, KnownNat m, KnownNat n, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> FilePath -- ^ File describing the initial content of the BRAM -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamFilePow2 = \clk en file rd wrM -> withFrozenCallStack (blockRamFile clk en (pow2SNat (SNat @n)) file rd wrM) {-# INLINE blockRamFilePow2 #-} -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' clk rst en ('blockRamFile' clk en size file) rd wrM@. -- * See "Clash.Explicit.BlockRam.File#usingramfiles" for more information on how -- to instantiate a block RAM with the contents of a data file. -- * See 'memFile' for creating a data file with Clash. -- * See "Clash.Sized.Fixed#creatingdatafiles" for more ideas on how to create -- your own data files. blockRamFile :: (KnownDomain dom, KnownNat m, Enum addr, NFDataX addr, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Size of the BRAM -> FilePath -- ^ File describing the initial content of the BRAM -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamFile = \clk gen sz file rd wrM -> let en = isJust <$> wrM (wr,din) = unbundle (fromJustX <$> wrM) in withFrozenCallStack (blockRamFile# clk gen sz file (fromEnum <$> rd) en (fromEnum <$> wr) din) {-# INLINE blockRamFile #-} -- | Convert data to the 'String' contents of a memory file. -- -- * __NB__: Not synthesizable -- * The following document the several ways to instantiate components with -- files: -- -- * "Clash.Prelude.BlockRam.File#usingramfiles" -- * "Clash.Prelude.ROM.File#usingromfiles" -- * "Clash.Explicit.BlockRam.File#usingramfiles" -- * "Clash.Explicit.ROM.File#usingromfiles" -- -- * See "Clash.Sized.Fixed#creatingdatafiles" for more ideas on how to create -- your own data files. -- -- = Example -- -- The @Maybe@ datatype has don't care bits, where the actual value does not -- matter. But the bits need a defined value in the memory. Either 0 or 1 can be -- used, and both are valid representations of the data. -- -- >>> let es = [ Nothing, Just (7 :: Unsigned 8), Just 8] -- >>> mapM_ (putStrLn . show . pack) es -- 0b0_...._.... -- 0b1_0000_0111 -- 0b1_0000_1000 -- >>> putStr (memFile (Just 0) es) -- 000000000 -- 100000111 -- 100001000 -- >>> putStr (memFile (Just 1) es) -- 011111111 -- 100000111 -- 100001000 -- memFile :: forall a f . ( BitPack a , Foldable f , HasCallStack) => Maybe Bit -- ^ Value to map don't care bits to. 'Nothing' means throwing an error on -- don't care bits. -> f a -- ^ Values to convert -> String -- ^ Contents of the memory file memFile care = foldr (\e -> showsBV $ pack e) "" where showsBV :: BitVector (BitSize a) -> String -> String showsBV (BV mask val) s = if n == 0 then '0' : '\n' : s else case care of Just (Bit 0 0) -> go n (val .&. (mask `xor` fullMask)) ('\n' : s) Just (Bit 0 1) -> go n (val .|. mask) ('\n' : s) _ -> if mask /= 0 then err else go n val ('\n' : s) where n = natToNum @(BitSize a) @Int fullMask = (1 `shiftL` n) - 1 err = withFrozenCallStack $ error $ "memFile: cannot convert don't-care values. " ++ "Please specify mapping to definite value." go 0 _ s0 = s0 go n0 v s0 = let (!v0, !vBit) = quotRem v 2 in if vBit == 0 then go (n0 - 1) v0 $ '0' : s0 else go (n0 - 1) v0 $ '1' : s0 -- | blockRamFile primitive blockRamFile# :: forall m dom n . (KnownDomain dom, KnownNat m, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Size of the BRAM -> FilePath -- ^ File describing the initial content of the BRAM -> Signal dom Int -- ^ Read address @r@ -> Signal dom Bool -- ^ Write enable -> Signal dom Int -- ^ Write address @w@ -> Signal dom (BitVector m) -- ^ Value to write (at address @w@) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamFile# (Clock _ Nothing) ena sz file = \rd wen waS wd -> runST $ do ramStart <- newArray_ (0,szI) unsafeIOToST (withFile file ReadMode (\h -> forM_ [0..(szI-1)] (\i -> do l <- hGetLine h let bv = parseBV l bv `seq` unsafeSTToIO (unsafeWriteSTArray ramStart i bv) ))) -- start benchmark only -- ramStart <- unsafeThawSTArray ramArr -- end benchmark only go ramStart (withFrozenCallStack (deepErrorX "blockRamFile: intial value undefined")) (fromEnable ena) rd (fromEnable ena .&&. wen) waS wd where szI = snatToNum sz :: Int -- start benchmark only -- ramArr = runST $ do -- ram <- newArray_ (0,szI-1) -- 0 -- (error "QQ") -- unsafeIOToST (withFile file ReadMode (\h -> -- forM_ [0..(szI-1)] (\i -> do -- l <- hGetLine h -- let bv = parseBV l -- bv `seq` unsafeSTToIO (unsafeWriteSTArray ram i bv)) -- )) -- unsafeFreezeSTArray ram -- end benchmark only go :: STArray s Int (BitVector m) -> (BitVector m) -> Signal dom Bool -> Signal dom Int -> Signal dom Bool -> Signal dom Int -> Signal dom (BitVector m) -> ST s (Signal dom (BitVector m)) go !ram o ret@(~(re :- res)) rt@(~(r :- rs)) et@(~(e :- en)) wt@(~(w :- wr)) dt@(~(d :- din)) = do o `seqX` (o :-) <$> (ret `seq` rt `seq` et `seq` wt `seq` dt `seq` unsafeInterleaveST (do o' <- unsafeIOToST (catch (if re then unsafeSTToIO (ram `safeAt` r) else pure o) (\err@XException {} -> pure (throw err))) d `seqX` upd ram e (fromEnum w) d go ram o' res rs en wr din)) upd :: STArray s Int (BitVector m) -> Bool -> Int -> (BitVector m) -> ST s () upd ram we waddr d = case maybeIsX we of Nothing -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> -- Put the XException from `we` as the value at address -- `waddr`. safeUpdate wa (seq we d) ram Just True -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. forM_ [0..(szI-1)] (\i -> unsafeWriteSTArray ram i (seq waddr d)) Just wa -> safeUpdate wa d ram _ -> return () safeAt :: HasCallStack => STArray s Int (BitVector m) -> Int -> ST s (BitVector m) safeAt s i = if (0 <= i) && (i < szI) then unsafeReadSTArray s i else pure $ withFrozenCallStack (deepErrorX ("blockRamFile: read address " <> show i <> " not in range [0.." <> show szI <> ")")) {-# INLINE safeAt #-} safeUpdate :: HasCallStack => Int -> BitVector m -> STArray s Int (BitVector m) -> ST s () safeUpdate i a s = if (0 <= i) && (i < szI) then unsafeWriteSTArray s i a else let d = withFrozenCallStack (deepErrorX ("blockRamFile: write address " <> show i <> " not in range [0.." <> show szI <> ")")) in forM_ [0..(szI-1)] (\j -> unsafeWriteSTArray s j d) {-# INLINE safeUpdate #-} parseBV :: String -> BitVector m parseBV s = case parseBV' s of Just i -> fromInteger i Nothing -> undefined# parseBV' = fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt blockRamFile# _ _ _ _ = error "blockRamFile#: dynamic clocks not supported" -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE blockRamFile# #-} {-# ANN blockRamFile# hasBlackBox #-} -- | __NB__: Not synthesizable initMem :: KnownNat n => FilePath -> IO [BitVector n] initMem = fmap (map parseBV . lines) . readFile where parseBV s = case parseBV' s of Just i -> fromInteger i Nothing -> error ("Failed to parse: " ++ s) parseBV' = fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE initMem #-} clash-prelude-1.8.1/src/Clash/Explicit/BlockRam/Internal.hs0000644000000000000000000001441007346545000021646 0ustar0000000000000000{-| Copyright : (C) 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Clash.Explicit.BlockRam.Internal where import Data.Bits ((.&.), (.|.), shiftL, xor) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder (Builder, toLazyByteString, word8, word64BE) import qualified Data.ByteString.Unsafe as B import Data.Foldable (foldl') import Data.Word (Word64) import GHC.Exts (Addr#) import GHC.TypeLits (KnownNat, Nat) import Numeric.Natural (Natural) import System.IO.Unsafe (unsafePerformIO) import Clash.Class.BitPack.Internal (BitPack, BitSize, pack) import Clash.Promoted.Nat (natToNum) import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..)) -- | Efficient storage of memory content -- -- It holds @n@ words of @'BitVector' m@. data MemBlob (n :: Nat) (m :: Nat) where MemBlob :: ( KnownNat n , KnownNat m ) => { memBlobRunsLen :: !Int , memBlobRuns :: Addr# , memBlobEndsLen :: !Int , memBlobEnds :: Addr# } -> MemBlob n m instance Show (MemBlob n m) where showsPrec _ x@MemBlob{} = ("$(memBlobTH @(BitVector " ++) . shows (natToNum @m @Int) . (") Nothing " ++) . shows (unpackMemBlob x) . (')':) -- | Convert a 'MemBlob' back to a list -- -- __NB__: Not synthesizable unpackMemBlob :: forall n m . MemBlob n m -> [BitVector m] unpackMemBlob = unsafePerformIO . unpackMemBlob0 unpackMemBlob0 :: forall n m . MemBlob n m -> IO [BitVector m] unpackMemBlob0 MemBlob{..} = do runsB <- B.unsafePackAddressLen memBlobRunsLen memBlobRuns endsB <- B.unsafePackAddressLen memBlobEndsLen memBlobEnds return $ map (BV 0) $ unpackNats (natToNum @n) (natToNum @m) runsB endsB packBVs :: forall a f . ( Foldable f , BitPack a ) => Maybe Bit -> f a -> Either String (Int, L.ByteString, L.ByteString) packBVs care es = case lenOrErr of Nothing -> Left err Just len -> let (runs, ends) = packAsNats mI (knownBVVal . pack) es in Right (len, runs, ends) where lenOrErr = case care of Just (Bit 0 _) -> Just $ length es _ -> foldl' lenOrErr0 (Just 0) es lenOrErr0 (Just len) (pack -> BV 0 _) = Just $ len + 1 lenOrErr0 _ _ = Nothing knownBVVal bv@(BV _ val) = case care of Just (Bit 0 bm) -> maskBVVal bm bv _ -> val maskBVVal _ (BV 0 val) = val maskBVVal 0 (BV mask val) = val .&. (mask `xor` fullMask) maskBVVal _ (BV mask val) = val .|. mask mI = natToNum @(BitSize a) @Int fullMask = (1 `shiftL` mI) - 1 err = "packBVs: cannot convert don't care values. " ++ "Please specify a mapping to a definite value." packAsNats :: forall a f . Foldable f => Int -> (a -> Natural) -> f a -> (L.ByteString, L.ByteString) packAsNats width trans es = (toLazyByteString runs0, toLazyByteString ends) where (runL, endL) = width `divMod` 8 ends | endC0 > 0 = word64BE endA0 <> ends0 | otherwise = ends0 (runs0, ends0, endC0, endA0) = foldr pack0 (mempty, mempty, 0, 0) es pack0 :: a -> (Builder, Builder, Int, Word64) -> (Builder, Builder, Int, Word64) pack0 val (runs1, ends1, endC1, endA1) = let (ends2, endC2, endA2) = packEnd val2 ends1 endC1 endA1 (val2, runs2) = packRun runL (trans val) runs1 in (runs2, ends2, endC2, endA2) packRun :: Int -> Natural -> Builder -> (Natural, Builder) packRun 0 val1 runs1 = (val1, runs1) packRun runC val1 runs1 = let (val2, runB) = val1 `divMod` 256 runs2 = word8 (fromIntegral runB) <> runs1 in packRun (runC - 1) val2 runs2 packEnd :: Natural -> Builder -> Int -> Word64 -> (Builder, Int, Word64) packEnd val2 ends1 endC1 endA1 | endL == 0 = (ends1, endC1, endA1) | endC2 <= 64 = let endA2 = endA1 * (2 ^ endL) + valEnd in (ends1, endC2, endA2) | otherwise = let ends2 = word64BE endA1 <> ends1 in (ends2, endL, valEnd) where endC2 = endC1 + endL valEnd = fromIntegral val2 unpackNats :: Int -> Int -> B.ByteString -> B.ByteString -> [Natural] unpackNats 0 _ _ _ = [] unpackNats len width runBs endBs | width < 8 = ends | otherwise = case ends of (e0:es) -> go e0 runL runBs es _ -> error ("unpackNats failed for:" <> show (len,width,runBs,endBs)) where (runL, endL) = width `divMod` 8 ends = if endL == 0 then repeat 0 else unpackEnds endL len $ unpackW64s endBs go :: Natural -> Int -> B.ByteString -> [Natural] -> [Natural] go val 0 runBs0 ends0 = let (end0,end0rest) = case ends0 of [] -> error "unpackNats: unexpected end of bytestring" (x:xs) -> (x,xs) in val : go end0 runL runBs0 end0rest go _ _ runBs0 _ | B.null runBs0 = [] go val runC runBs0 ends0 = let (runB, runBs1) = case B.uncons runBs0 of Nothing -> error "unpackNats: unexpected end of bytestring" Just xs -> xs val0 = val * 256 + fromIntegral runB in go val0 (runC - 1) runBs1 ends0 unpackW64s :: B.ByteString -> [Word64] unpackW64s = go 8 0 where go :: Int -> Word64 -> B.ByteString -> [Word64] go 8 _ endBs | B.null endBs = [] go 0 val endBs = val : go 8 0 endBs go n val endBs = let (endB, endBs0) = case B.uncons endBs of Nothing -> error "unpackW64s: unexpeded end of bytestring" Just xs -> xs val0 = val * 256 + fromIntegral endB in go (n - 1) val0 endBs0 unpackEnds :: Int -> Int -> [Word64] -> [Natural] unpackEnds _ _ [] = [] unpackEnds endL len (w:ws) = go endCInit w ws where endPerWord = 64 `div` endL leader = len `mod` endPerWord endCInit | leader == 0 = endPerWord | otherwise = leader go 0 _ [] = [] go 0 _ (w0:ws0) = go endPerWord w0 ws0 go n endA ws0 = let (endA0, valEnd) = endA `divMod` (2 ^ endL) in fromIntegral valEnd : go (n - 1) endA0 ws0 clash-prelude-1.8.1/src/Clash/Explicit/BlockRam/Model.hs0000644000000000000000000002320607346545000021135 0ustar0000000000000000{-| Copyright : (C) 2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Configurable model for true dual-port block RAM -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module Clash.Explicit.BlockRam.Model where #if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2) #endif import Control.Exception (throw) import Data.Sequence (Seq) import GHC.Stack (HasCallStack) import GHC.TypeNats (KnownNat) import Clash.Promoted.Nat (SNat(..), natToNum) import Clash.Signal.Bundle (Bundle(bundle)) import Clash.Signal.Internal (KnownDomain(..), Clock (..), Signal (..), ClockAB (..), clockTicks) import Clash.Sized.Index (Index) import Clash.XException (XException(..), NFDataX(..), seqX) import Clash.XException.MaybeX (MaybeX(..), toMaybeX, andX) import qualified Clash.XException.MaybeX as MaybeX import qualified Data.Sequence as Seq -- | Helper used in 'getConflict' data Conflict = Conflict { cfRWA :: !(MaybeX Bool) -- ^ Read/Write conflict for output A , cfRWB :: !(MaybeX Bool) -- ^ Read/Write conflict for output B , cfWW :: !(MaybeX Bool) -- ^ Write/Write conflict } deriving (Show) -- | Determines whether there was a write-write or read-write conflict. A conflict -- occurs when two ports tried to (potentially, in case of undefined values) -- access the same address and one or both tried to write to it. See documentation -- of 'Conflict' for more information. getConflict :: -- | Port A: enable, write enable, address (MaybeX Bool, MaybeX Bool, MaybeX Int) -> -- | Port B: enable, write enable, address (MaybeX Bool, MaybeX Bool, MaybeX Int) -> -- | 'Just' if there is a (potential) write conflict, otherwise 'Nothing' Maybe Conflict getConflict (enA, wenA, addrA) (enB, wenB, addrB) | IsDefined False <- sameAddrX = Nothing | otherwise = Just conflict where sameAddrX = liftA2 (==) addrA addrB conflict = Conflict { cfRWA = enA `andX` (enB `andX` wenB) , cfRWB = enB `andX` (enA `andX` wenA) , cfWW = (enA `andX` enB) `andX` (wenA `andX` wenB) } -- | Step through a cycle of a TDP block RAM where only one clock is active. Like -- 'accessRam', it accounts for 'Clash.XException.XException' in all values -- supplied by the user of the block RAM. cycleOne :: forall nAddrs a writeEnable . ( HasCallStack , NFDataX a ) => SNat nAddrs -> TdpbramModelConfig writeEnable a -> -- | Previous value a -> -- | Memory Seq a -> -- | Port: enable, address, write enable, write data (MaybeX Bool, MaybeX Int, MaybeX writeEnable, a) -> -- | Updated memory, output value (Seq a, a) cycleOne SNat TdpbramModelConfig{..} prev ram0 = \case -- RAM is disabled, so we do nothing (IsDefined False, _, _, _) -> (ram0, prev) -- RAM is (potentially) enabled, so we run write RAM logic (ena, addr, byteEna0, dat) -> let byteEna1 = tdpMergeWriteEnable ena byteEna0 (out0, !ram1) = accessRam (SNat @nAddrs) tdpIsActiveWriteEnable tdpUpdateRam addr byteEna1 dat ram0 out1 = MaybeX.maybeX (throw . XException) (const out0) ena in (ram1, out1) -- | Step through a cycle of a TDP block RAM where the clock edges of port A and -- port B coincided. Like 'accessRam', it accounts for 'Clash.XException.XException' -- in all values supplied by the user of the block RAM. cycleBoth :: forall nAddrs a writeEnable. ( NFDataX a , HasCallStack ) => SNat nAddrs -> TdpbramModelConfig writeEnable a -> -- | Previous value for port A a -> -- | Previous value for port B a -> -- | Memory Seq a -> -- | Port A: enable, address, write enable, write data (MaybeX Bool, MaybeX Int, MaybeX writeEnable, a) -> -- | Port B: enable, address, write enable, write data (MaybeX Bool, MaybeX Int, MaybeX writeEnable, a) -> -- | Updated memory, output value A, output value B (Seq a, a, a) cycleBoth SNat TdpbramModelConfig{..} prevA prevB ram0 (enAx, addrAx, byteEnaAx0, datA) (enBx, addrBx, byteEnaBx0, datB) = (ram2, outA2, outB2) where conflict = getConflict (enAx, tdpIsActiveWriteEnable byteEnaAx1, addrAx) (enBx, tdpIsActiveWriteEnable byteEnaBx1, addrBx) writeWriteError = deepErrorX "conflicting write/write queries" readWriteError = deepErrorX "conflicting read/write queries" byteEnaAx1 = tdpMergeWriteEnable enAx byteEnaAx0 byteEnaBx1 = tdpMergeWriteEnable enBx byteEnaBx0 (datA1, datB1) = case conflict of Just Conflict{cfWW=IsDefined True} -> (writeWriteError, writeWriteError) Just Conflict{cfWW=IsX _} -> (writeWriteError, writeWriteError) _ -> (datA, datB) (outA0, ram1) = accessRam (SNat @nAddrs) tdpIsActiveWriteEnable tdpUpdateRam addrAx byteEnaAx1 datA1 ram0 (outB0, ram2) = accessRam (SNat @nAddrs) tdpIsActiveWriteEnable tdpUpdateRam addrBx byteEnaBx1 datB1 ram1 outA1 = case conflict of Just Conflict{cfRWA=IsDefined True} -> readWriteError Just Conflict{cfRWA=IsX _} -> readWriteError _ -> outA0 outB1 = case conflict of Just Conflict{cfRWB=IsDefined True} -> readWriteError Just Conflict{cfRWB=IsX _} -> readWriteError _ -> outB0 outA2 = if MaybeX.fromMaybeX enAx then outA1 else prevA outB2 = if MaybeX.fromMaybeX enBx then outB1 else prevB -- | Access a RAM and account for undefined values in the address, write enable, -- and data to write. Return read after write value. accessRam :: forall nAddrs a writeEnable . ( NFDataX a , HasCallStack ) => SNat nAddrs -> -- | Determine whether a write enable is active (MaybeX writeEnable -> MaybeX Bool) -> -- | Update memory with a defined address (Int -> MaybeX writeEnable -> a -> Seq a -> Seq a) -> -- | Address MaybeX Int -> -- | Byte enable MaybeX writeEnable -> -- | Data to write a -> -- | Memory to write to Seq a -> -- | (Read after write value, new memory) (a, Seq a) accessRam SNat tdpIsActiveWriteEnable updateMem addrX byteEnableX dat mem0 -- Read (do nothing) | IsDefined False <- tdpIsActiveWriteEnable byteEnableX = (mem0 `Seq.index` MaybeX.fromMaybeX addrX, mem0) -- Undefined address and write enable or (partially) unknown | IsX addrMsg <- addrX = ( deepErrorX $ "Unknown address" <> "\nAddress error message: " <> addrMsg , Seq.fromFunction (natToNum @nAddrs) (unknownAddr addrMsg) ) -- Write with defined address | IsDefined addr <- addrX , mem1 <- updateMem addr byteEnableX dat mem0 = (mem1 `Seq.index` addr, mem1) where unknownAddr :: String -> Int -> a unknownAddr msg n = deepErrorX ("Write enabled or undefined, but address unknown; position " <> show n <> "\nAddress error message: " <> msg) data TdpbramModelConfig writeEnable a = TdpbramModelConfig { tdpIsActiveWriteEnable :: MaybeX writeEnable -> MaybeX Bool -- ^ Determine whether a write enable is active , tdpMergeWriteEnable :: MaybeX Bool -> MaybeX writeEnable -> MaybeX writeEnable -- ^ Merge global enable with write enable , tdpUpdateRam :: Int -> MaybeX writeEnable -> a -> Seq a -> Seq a -- ^ Update memory with a defined address } -- | Haskell model for a true dual-port block RAM which is polymorphic in its -- write enables -- tdpbramModel :: forall nAddrs domA domB a writeEnable . ( HasCallStack , KnownNat nAddrs , KnownDomain domA , KnownDomain domB , NFDataX a ) => TdpbramModelConfig writeEnable a -> Clock domA -> -- | Enable Signal domA Bool -> -- | Address Signal domA (Index nAddrs) -> -- | Write enable Signal domA writeEnable -> -- | Write data Signal domA a -> Clock domB -> -- | Enable Signal domB Bool -> -- | Address Signal domB (Index nAddrs) -> -- | Write byte enable Signal domB writeEnable -> -- | Write data Signal domB a -> (Signal domA a, Signal domB a) tdpbramModel config clkA enA addrA byteEnaA datA clkB enB addrB byteEnaB datB = ( startA :- outA , startB :- outB ) where (outA, outB) = go (Seq.fromFunction (natToNum @nAddrs) initElement) (clockTicks clkA clkB) (bundle (enA, byteEnaA, fromIntegral <$> addrA, datA)) (bundle (enB, byteEnaB, fromIntegral <$> addrB, datB)) startA startB startA = deepErrorX $ "Port A: First value undefined" startB = deepErrorX $ "Port B: First value undefined" initElement :: Int -> a initElement n = deepErrorX ("Unknown initial element; position " <> show n) go :: Seq a -> [ClockAB] -> Signal domA (Bool, writeEnable, Int, a) -> Signal domB (Bool, writeEnable, Int, a) -> a -> a -> (Signal domA a, Signal domB a) go _ [] _ _ = error "tdpbramModel#.go: `ticks` should have been an infinite list" go ram0 (tick:ticks) as0 bs0 = case tick of ClockA -> goA ClockB -> goB ClockAB -> goBoth where ( toMaybeX -> enAx , toMaybeX -> byteEnaAx , toMaybeX -> addrAx , datA0 ) :- as1 = as0 ( toMaybeX -> enBx , toMaybeX -> byteEnaBx , toMaybeX -> addrBx , datB0 ) :- bs1 = bs0 portA = (enAx, addrAx, byteEnaAx, datA0) portB = (enBx, addrBx, byteEnaBx, datB0) goBoth prevA prevB = outA1 `seqX` outB1 `seqX` (outA1 :- as2, outB1 :- bs2) where (ram1, outA1, outB1) = cycleBoth (SNat @nAddrs) config prevA prevB ram0 portA portB (as2, bs2) = go ram1 ticks as1 bs1 outA1 outB1 goA prevA prevB = out `seqX` (out :- as2, bs2) where (ram1, out) = cycleOne (SNat @nAddrs) config prevA ram0 portA (as2, bs2) = go ram1 ticks as1 bs0 out prevB goB prevA prevB = out `seqX` (as2, out :- bs2) where (ram1, out) = cycleOne (SNat @nAddrs) config prevB ram0 portB (as2, bs2) = go ram1 ticks as0 bs1 prevA out clash-prelude-1.8.1/src/Clash/Explicit/DDR.hs0000644000000000000000000001417207346545000017016 0ustar0000000000000000{-| Copyright : (C) 2017, Google Inc 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij We simulate DDR signal by using 'Signal's which have exactly half the period (or double the speed) of our normal 'Signal's. The primitives in this module can be used to produce or consume DDR signals. DDR signals are not meant to be used internally in a design, but only to communicate with the outside world. In some cases hardware specific DDR IN registers can be inferred by synthesis tools from these generic primitives. But to be sure your design will synthesize to dedicated hardware resources use the functions from "Clash.Intel.DDR" or "Clash.Xilinx.DDR". -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module Clash.Explicit.DDR ( ddrIn , ddrOut -- * Internal , ddrIn# , ddrOut# ) where import GHC.Stack (HasCallStack, withFrozenCallStack) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.Prelude import Clash.Signal.Internal {- $setup >>> :set -XNoImplicitPrelude -XTypeFamilies -XFlexibleInstances >>> import Clash.Explicit.Prelude >>> import Clash.Explicit.DDR >>> :{ instance KnownDomain "Fast" where type KnownConf "Fast" = 'DomainConfiguration "Fast" 5000 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh :} -} -- | DDR input primitive -- -- Consumes a DDR input signal and produces a regular signal containing a pair -- of values. -- -- >>> printX $ sampleN 5 $ ddrIn systemClockGen systemResetGen enableGen (-1,-2,-3) (fromList [0..10] :: Signal "Fast" Int) -- [(-1,-2),(-1,-2),(-3,2),(3,4),(5,6)] ddrIn :: ( HasCallStack , NFDataX a , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) ) => Clock slow -- ^ clock -> Reset slow -- ^ reset -> Enable slow -> (a, a, a) -- ^ reset values -> Signal fast a -- ^ DDR input signal -> Signal slow (a, a) -- ^ normal speed output pairs ddrIn clk rst en (i0,i1,i2) = withFrozenCallStack $ ddrIn# clk rst en i0 i1 i2 -- For details about all the seq's en seqX's -- see the [Note: register strictness annotations] in Clash.Signal.Internal ddrIn# :: forall a slow fast fPeriod polarity edge reset init . ( HasCallStack , NFDataX a , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) ) => Clock slow -> Reset slow -> Enable slow -> a -> a -> a -> Signal fast a -> Signal slow (a,a) ddrIn# (Clock _ Nothing) (unsafeToActiveHigh -> hRst) (fromEnable -> ena) i0 i1 i2 = case resetKind @fast of SAsynchronous -> goAsync ( deepErrorX "ddrIn: initial value 0 undefined" , deepErrorX "ddrIn: initial value 1 undefined" , deepErrorX "ddrIn: initial value 2 undefined" ) hRst ena SSynchronous -> goSync ( deepErrorX "ddrIn: initial value 0 undefined" , deepErrorX "ddrIn: initial value 1 undefined" , deepErrorX "ddrIn: initial value 2 undefined" ) hRst ena where goSync :: (a, a, a) -> Signal slow Bool -> Signal slow Bool -> Signal fast a -> Signal slow (a,a) goSync (o0,o1,o2) rt@(~(r :- rs)) ~(e :- es) as@(~(x0 :- x1 :- xs)) = let (o0',o1',o2') = if r then (i0,i1,i2) else (o2,x0,x1) in o0 `seqX` o1 `seqX` (o0,o1) :- (rt `seq` as `seq` if e then goSync (o0',o1',o2') rs es xs else goSync (o0 ,o1 ,o2) rs es xs) goAsync :: (a, a, a) -> Signal slow Bool -> Signal slow Bool -> Signal fast a -> Signal slow (a, a) goAsync (o0,o1,o2) ~(r :- rs) ~(e :- es) as@(~(x0 :- x1 :- xs)) = let (o0',o1',o2',o3',o4') = if r then (i0,i1,i0,i1,i2) else (o0,o1,o2,x0,x1) in o0' `seqX` o1' `seqX` (o0',o1') :- (as `seq` if e then goAsync (o2',o3',o4') rs es xs else goAsync (o0',o1',o2') rs es xs) ddrIn# _ _ _ _ _ _ = error "ddrIn#: dynamic clocks not supported" -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE ddrIn# #-} {-# ANN ddrIn# hasBlackBox #-} -- | DDR output primitive -- -- Produces a DDR output signal from a normal signal of pairs of input. -- -- >>> sampleN 7 (ddrOut systemClockGen systemResetGen enableGen (-1) (fromList [(0,1),(2,3),(4,5)]) :: Signal "Fast" Int) -- [-1,-1,-1,2,3,4,5] ddrOut :: ( HasCallStack , NFDataX a , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) ) => Clock slow -> Reset slow -> Enable slow -> a -- ^ reset value -> Signal slow (a, a) -- ^ Normal speed input pairs -> Signal fast a -- ^ DDR output signal ddrOut clk rst en i0 = uncurry (withFrozenCallStack $ ddrOut# clk rst en i0) . unbundle ddrOut# :: ( HasCallStack , NFDataX a , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) ) => Clock slow -> Reset slow -> Enable slow -> a -> Signal slow a -> Signal slow a -> Signal fast a ddrOut# clk rst en i0 xs ys = -- We only observe one reset value, because when the mux switches on the -- next clock level, the second register will already be outputting its -- first input. -- -- That is why we drop the first value of the stream. let (_ :- out) = zipSig xs' ys' in out where xs' = register# clk rst en (errorX "ddrOut: unreachable error") i0 xs ys' = register# clk rst en (deepErrorX "ddrOut: initial value undefined") i0 ys zipSig (a :- as) (b :- bs) = a :- b :- zipSig as bs -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE ddrOut# #-} {-# ANN ddrOut# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/Mealy.hs0000644000000000000000000001636707346545000017464 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd 2023 , Alex Mason License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Whereas the output of a Moore machine depends on the /previous state/, the output of a Mealy machine depends on /current transition/. Mealy machines are strictly more expressive, but may impose stricter timing requirements. -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} module Clash.Explicit.Mealy ( -- * Mealy machines with explicit clock and reset ports mealy , mealyS , mealyB , mealySB ) where import Clash.Explicit.Signal (KnownDomain, Bundle (..), Clock, Reset, Signal, Enable, register) import Clash.XException (NFDataX) import Control.Monad.State.Strict (State, runState) {- $setup >>> :set -XDataKinds -XTypeApplications -XDeriveGeneric -XDeriveAnyClass >>> import Clash.Explicit.Prelude as C >>> import Clash.Explicit.Mealy (mealyS) >>> import qualified Data.List as L >>> import Control.Lens (Lens', (%=), (-=), uses, use) >>> import Control.Monad.State.Strict (State) >>> :{ let macT s (x,y) = (s',s) where s' = x * y + s :} >>> mac clk rst en = mealy clk rst en macT 0 >>> :{ data DelayState = DelayState { _history :: Vec 4 Int , _untilValid :: Index 4 } deriving (Generic,NFDataX) :} >>> :{ history :: Lens' DelayState (Vec 4 Int) history f = \(DelayState d u) -> (`DelayState` u) <$> f d :} >>> :{ untilValid :: Lens' DelayState (Index 4) untilValid f = \(DelayState d u) -> DelayState d <$> f u :} >>> :{ delayS :: Int -> State DelayState (Maybe Int) delayS n = do history %= (n +>>) remaining <- use untilValid if remaining > 0 then do untilValid -= 1 return Nothing else do out <- uses history C.last return (Just out) :} >>> let initialDelayState = DelayState (C.repeat 0) maxBound >>> :{ delayTop :: Clock System -> Reset System -> Enable System -> Signal System Int -> Signal System (Maybe Int) delayTop clk rst en = mealyS clk rst en delayS initialDelayState :} -} -- | Create a synchronous function from a combinational function describing -- a mealy machine -- -- @ -- import qualified Data.List as L -- -- macT -- :: Int -- Current state -- -> (Int,Int) -- Input -- -> (Int,Int) -- (Updated state, output) -- macT s (x,y) = (s',s) -- where -- s' = x * y + s -- -- mac -- :: 'KnownDomain' dom -- => 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> 'Signal' dom (Int, Int) -- -> 'Signal' dom Int -- mac clk rst en = 'mealy' clk rst en macT 0 -- @ -- -- >>> simulate (mac systemClockGen systemResetGen enableGen) [(0,0),(1,1),(2,2),(3,3),(4,4)] -- [0,0,1,5,14... -- ... -- -- Synchronous sequential functions can be composed just like their -- combinational counterpart: -- -- @ -- dualMac -- :: 'KnownDomain' dom -- => 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> 'Signal' dom Int -- dualMac clk rst en (a,b) (x,y) = s1 + s2 -- where -- s1 = 'mealy' clk rst en macT 0 ('bundle' (a,x)) -- s2 = 'mealy' clk rst en macT 0 ('bundle' (b,y)) -- @ mealy :: ( KnownDomain dom , NFDataX s ) => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom -> Enable dom -- ^ Global enable -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@ -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealy clk rst en f iS = \i -> let (s',o) = unbundle $ f <$> s <*> i s = register clk rst en iS s' in o {-# INLINABLE mealy #-} -- | Create a synchronous function from a combinational function describing -- a mealy machine using the state monad. This can be particularly useful -- when combined with lenses or optics to replicate imperative algorithms. -- -- @ -- data DelayState = DelayState -- { _history :: Vec 4 Int -- , _untilValid :: Index 4 -- } -- deriving (Generic, NFDataX) -- makeLenses ''DelayState -- -- initialDelayState = DelayState (repeat 0) maxBound -- -- delayS :: Int -> State DelayState (Maybe Int) -- delayS n = do -- history %= (n +>>) -- remaining <- use untilValid -- if remaining > 0 -- then do -- untilValid -= 1 -- return Nothing -- else do -- out <- uses history last -- return (Just out) -- -- delayTop ::'KnownDomain' dom -- => 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int -> 'Signal' dom (Maybe Int)) -- delayTop clk rst en = 'mealyS' clk rst en delayS initialDelayState -- @ -- -- >>> L.take 7 $ simulate (delayTop systemClockGen systemResetGen enableGen) [-100,1,2,3,4,5,6,7,8] -- [Nothing,Nothing,Nothing,Nothing,Just 1,Just 2,Just 3] -- mealyS :: ( KnownDomain dom , NFDataX s ) => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom -> Enable dom -- ^ Global enable -> (i -> State s o) -- ^ Transfer function in mealy machine handling inputs using @Control.Monad.Strict.State s@. -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealyS clk rst en f iS = \i -> let (o,s') = unbundle $ (runState . f) <$> i <*> s s = register clk rst en iS s' in o {-# INLINABLE mealyS #-} -- | A version of 'mealy' that does automatic 'Bundle'ing -- -- Given a function @f@ of type: -- -- @ -- __f__ :: Int -> (Bool,Int) -> (Int,(Int,Bool)) -- @ -- -- When we want to make compositions of @f@ in @g@ using 'mealy', we have to -- write: -- -- @ -- g clk rst en a b c = (b1,b2,i2) -- where -- (i1,b1) = 'unbundle' (mealy clk rst en f 0 ('bundle' (a,b))) -- (i2,b2) = 'unbundle' (mealy clk rst en f 3 ('bundle' (c,i1))) -- @ -- -- Using 'mealyB' however we can write: -- -- @ -- g clk rst en a b c = (b1,b2,i2) -- where -- (i1,b1) = 'mealyB' clk rst en f 0 (a,b) -- (i2,b2) = 'mealyB' clk rst en f 3 (c,i1) -- @ mealyB :: ( KnownDomain dom , NFDataX s , Bundle i , Bundle o ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@ -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealyB clk rst en f iS i = unbundle (mealy clk rst en f iS (bundle i)) {-# INLINE mealyB #-} -- | A version of 'mealyS' that does automatic 'Bundle'ing, see 'mealyB' for details. mealySB :: ( KnownDomain dom , NFDataX s , Bundle i , Bundle o ) => Clock dom -> Reset dom -> Enable dom -> (i -> State s o) -- ^ Transfer function in mealy machine handling inputs using @Control.Monad.Strict.State s@. -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealySB clk rst en f iS i = unbundle (mealyS clk rst en f iS (bundle i)) {-# INLINE mealySB #-} clash-prelude-1.8.1/src/Clash/Explicit/Moore.hs0000644000000000000000000001113307346545000017460 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Whereas the output of a Mealy machine depends on /current transition/, the output of a Moore machine depends on the /previous state/. Moore machines are strictly less expressive, but may impose laxer timing requirements. -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} module Clash.Explicit.Moore ( -- * Moore machines with explicit clock and reset ports moore , mooreB , medvedev , medvedevB ) where import Clash.Explicit.Signal (KnownDomain, Bundle (..), Clock, Reset, Signal, Enable, register) import Clash.XException (NFDataX) {- $setup >>> :set -XDataKinds -XTypeApplications >>> import Clash.Explicit.Prelude >>> let macT s (x,y) = x * y + s >>> let mac clk rst en = moore clk rst en macT id 0 -} -- | Create a synchronous function from a combinational function describing -- a moore machine -- -- @ -- macT -- :: Int -- Current state -- -> (Int,Int) -- Input -- -> (Int,Int) -- Updated state -- macT s (x,y) = x * y + s -- -- mac -- :: 'KnownDomain' dom -- => 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> 'Signal' dom (Int, Int) -- -> 'Signal' dom Int -- mac clk rst en = 'moore' clk rst en macT id 0 -- @ -- -- >>> simulate (mac systemClockGen systemResetGen enableGen) [(0,0),(1,1),(2,2),(3,3),(4,4)] -- [0,0,1,5,14... -- ... -- -- Synchronous sequential functions can be composed just like their -- combinational counterpart: -- -- @ -- dualMac -- :: 'KnownDomain' dom -- => 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> 'Signal' dom Int -- dualMac clk rst en (a,b) (x,y) = s1 + s2 -- where -- s1 = 'moore' clk rst en macT id 0 ('bundle' (a,x)) -- s2 = 'moore' clk rst en macT id 0 ('bundle' (b,y)) -- @ moore :: ( KnownDomain dom , NFDataX s ) => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom -> Enable dom -> (s -> i -> s) -- ^ Transfer function in moore machine form: @state -> input -> newstate@ -> (s -> o) -- ^ Output function in moore machine form: @state -> output@ -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the moore machine moore clk rst en ft fo iS = \i -> let s' = ft <$> s <*> i s = register clk rst en iS s' in fo <$> s {-# INLINABLE moore #-} -- | Create a synchronous function from a combinational function describing -- a moore machine without any output logic medvedev :: ( KnownDomain dom , NFDataX s ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> s) -> s -> (Signal dom i -> Signal dom s) medvedev clk rst en tr st = moore clk rst en tr id st {-# INLINE medvedev #-} -- | A version of 'moore' that does automatic 'Bundle'ing -- -- Given a functions @t@ and @o@ of types: -- -- @ -- __t__ :: Int -> (Bool, Int) -> Int -- __o__ :: Int -> (Int, Bool) -- @ -- -- When we want to make compositions of @t@ and @o@ in @g@ using 'moore', we have to -- write: -- -- @ -- g clk rst en a b c = (b1,b2,i2) -- where -- (i1,b1) = 'unbundle' (moore clk rst en t o 0 ('bundle' (a,b))) -- (i2,b2) = 'unbundle' (moore clk rst en t o 3 ('bundle' (c,i1))) -- @ -- -- Using 'mooreB' however we can write: -- -- @ -- g clk rst en a b c = (b1,b2,i2) -- where -- (i1,b1) = 'mooreB' clk rst en t o 0 (a,b) -- (i2,b2) = 'mooreB' clk rst en t o 3 (c,i1) -- @ mooreB :: ( KnownDomain dom , NFDataX s , Bundle i , Bundle o ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> s) -- ^ Transfer function in moore machine form: -- @state -> input -> newstate@ -> (s -> o) -- ^ Output function in moore machine form: -- @state -> output@ -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the moore machine mooreB clk rst en ft fo iS i = unbundle (moore clk rst en ft fo iS (bundle i)) {-# INLINE mooreB #-} -- | A version of 'medvedev' that does automatic 'Bundle'ing medvedevB :: ( KnownDomain dom , NFDataX s , Bundle i , Bundle s ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> s) -> s -> (Unbundled dom i -> Unbundled dom s) medvedevB clk rst en tr st = mooreB clk rst en tr id st {-# INLINE medvedevB #-} clash-prelude-1.8.1/src/Clash/Explicit/Prelude.hs0000644000000000000000000001644507346545000020012 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2023, QBayLogic B.V., 2022 , Myrtle.ai, License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. This module defines the explicitly clocked counterparts of the functions defined in "Clash.Prelude". -} {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} module Clash.Explicit.Prelude ( -- * Creating synchronous sequential circuits mealy , mealyS , mealyB , mealySB , moore , mooreB , registerB -- * Synchronizer circuits for safe clock domain crossings , dualFlipFlopSynchronizer , asyncFIFOSynchronizer -- * ROMs , asyncRom , asyncRomPow2 , rom , romPow2 -- ** ROMs defined by a 'MemBlob' , asyncRomBlob , asyncRomBlobPow2 , romBlob , romBlobPow2 -- ** ROMs defined by a data file , asyncRomFile , asyncRomFilePow2 , romFile , romFilePow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * Block RAM primitives , blockRam , blockRamPow2 , blockRamU , blockRam1 , ResetStrategy(..) -- ** Block RAM primitives initialized with a 'MemBlob' , blockRamBlob , blockRamBlobPow2 -- *** Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- ** Block RAM primitives initialized with a data file , blockRamFile , blockRamFilePow2 -- ** Block RAM read/write conflict resolution , readNew -- ** True dual-port block RAM , trueDualPortBlockRam , RamOp(..) -- * Utility functions , window , windowD , isRising , isFalling , riseEvery , oscillate -- * Testbench functions , assert , stimuliGenerator , outputVerifier' -- * Tracing -- ** Simple , traceSignal1 , traceVecSignal1 -- ** Tracing in a multi-clock environment , traceSignal , traceVecSignal -- ** VCD dump functions , dumpVCD -- * Exported modules -- ** Synchronous signals , module Clash.Explicit.Reset , module Clash.Explicit.Signal , module Clash.Explicit.Signal.Delayed -- ** Datatypes -- *** Bit vectors , module Clash.Sized.BitVector -- *** Arbitrary-width numbers , module Clash.Sized.Signed , module Clash.Sized.Unsigned , module Clash.Sized.Index -- *** Fixed point numbers , module Clash.Sized.Fixed -- *** Fixed size vectors , module Clash.Sized.Vector -- *** Perfect depth trees , module Clash.Sized.RTree -- ** Annotations , module Clash.Annotations.TopEntity -- ** Generics type-classes , Generic , Generic1 -- ** Type-level natural numbers , module GHC.TypeLits , module GHC.TypeLits.Extra , module Clash.Promoted.Nat , module Clash.Promoted.Nat.Literals , module Clash.Promoted.Nat.TH -- ** Type-level strings , module Clash.Promoted.Symbol -- ** Template Haskell , Lift (..) -- ** Type classes -- *** Clash , module Clash.Class.AutoReg , module Clash.Class.BitPack , module Clash.Class.Exp , module Clash.Class.Num , module Clash.Class.Resize -- *** Other , module Control.Applicative , module Data.Bits , module Data.Default.Class -- ** Exceptions , module Clash.XException -- ** Named types , module Clash.NamedTypes -- ** Magic , module Clash.Magic -- ** Haskell Prelude -- $hiding , module Clash.HaskellPrelude ) where import Control.Applicative import Data.Bits import Data.Default.Class import GHC.TypeLits #if MIN_VERSION_base(4,18,0) hiding (SNat, SSymbol, fromSNat) #endif import GHC.TypeLits.Extra import Language.Haskell.TH.Syntax (Lift(..)) import Clash.HaskellPrelude import Clash.Annotations.TopEntity import Clash.Class.AutoReg import Clash.Class.BitPack import Clash.Class.Exp import Clash.Class.Num import Clash.Class.Resize import Clash.Magic import Clash.NamedTypes import Clash.Explicit.BlockRam import Clash.Explicit.BlockRam.Blob import Clash.Explicit.BlockRam.File import Clash.Explicit.Mealy import Clash.Explicit.Moore import Clash.Explicit.RAM import Clash.Explicit.ROM import Clash.Explicit.ROM.Blob import Clash.Explicit.ROM.File import Clash.Explicit.Prelude.Safe import Clash.Explicit.Reset import Clash.Explicit.Signal import Clash.Explicit.Signal.Delayed import Clash.Explicit.Testbench import Clash.Prelude.ROM.File (asyncRomFile, asyncRomFilePow2) import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals import Clash.Promoted.Symbol import Clash.Signal.Trace 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 hiding (fromList, unsafeFromList) import Clash.XException {- $setup >>> :set -XDataKinds -XTypeApplications >>> import Clash.Explicit.Prelude >>> let window4 = window @3 >>> let windowD3 = windowD @2 -} {- $hiding "Clash.Explicit.Prelude" re-exports most of the Haskell "Prelude" with the exception of those functions that the Clash API defines to work on 'Vec' from "Clash.Sized.Vector" instead of on lists as the Haskell Prelude does. In addition, for the 'Clash.Class.Parity.odd' and 'Clash.Class.Parity.even' functions a type class called 'Clash.Class.Parity.Parity' is available at "Clash.Class.Parity". -} -- | Give a window over a 'Signal' -- -- @ -- window4 --- :: Clock dom -- -> Reset dom -- -> Enable dom -- -> 'Signal' dom Int -- -> 'Vec' 4 ('Signal' dom Int) -- window4 = 'window' -- @ -- -- >>> simulateB (window4 systemClockGen systemResetGen enableGen) [1::Int,2,3,4,5] :: [Vec 4 Int] -- [1 :> 0 :> 0 :> 0 :> Nil,2 :> 1 :> 0 :> 0 :> Nil,3 :> 2 :> 1 :> 0 :> Nil,4 :> 3 :> 2 :> 1 :> Nil,5 :> 4 :> 3 :> 2 :> Nil,... -- ... window :: ( KnownNat n , KnownDomain dom , NFDataX a , Default a ) => Clock dom -- ^ Clock to the incoming signal is synchronized -> Reset dom -> Enable dom -> Signal dom a -- ^ Signal to create a window over -> Vec (n + 1) (Signal dom a) -- ^ Window of at least size 1 window clk rst en x = res where res = x :> prev prev = case natVal (asNatProxy prev) of 0 -> repeat def _ -> let next = x +>> prev in registerB clk rst en (repeat def) next {-# INLINABLE window #-} -- | Give a delayed window over a 'Signal' -- -- @ -- windowD3 -- :: KnownDomain dom -- -> Clock dom -- -> Enable dom -- -> Reset dom -- -> 'Signal' dom Int -- -> 'Vec' 3 ('Signal' dom Int) -- windowD3 = 'windowD' -- @ -- -- >>> simulateB (windowD3 systemClockGen resetGen enableGen) [1::Int,1,2,3,4] :: [Vec 3 Int] -- [0 :> 0 :> 0 :> Nil,0 :> 0 :> 0 :> Nil,1 :> 0 :> 0 :> Nil,2 :> 1 :> 0 :> Nil,3 :> 2 :> 1 :> Nil,4 :> 3 :> 2 :> Nil,... -- ... windowD :: ( KnownNat n , NFDataX a , Default a , KnownDomain dom ) => Clock dom -- ^ Clock to which the incoming signal is synchronized -> Reset dom -> Enable dom -> Signal dom a -- ^ Signal to create a window over -> Vec (n + 1) (Signal dom a) -- ^ Window of at least size 1 windowD clk rst en x = let prev = registerB clk rst en (repeat def) next next = x +>> prev in prev {-# INLINABLE windowD #-} clash-prelude-1.8.1/src/Clash/Explicit/Prelude/0000755000000000000000000000000007346545000017444 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Explicit/Prelude/Safe.hs0000644000000000000000000001666607346545000020675 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. __This is the API only of "Clash.Explicit.Prelude"__ This module defines the explicitly clocked counterparts of the functions defined in "Clash.Prelude". -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} module Clash.Explicit.Prelude.Safe ( -- * Creating synchronous sequential circuits mealy , mealyB , moore , mooreB , registerB -- * Synchronizer circuits for safe clock domain crossing , dualFlipFlopSynchronizer , asyncFIFOSynchronizer -- * ROMs , asyncRom , asyncRomPow2 , rom , romPow2 -- ** ROMs defined by a 'MemBlob' , asyncRomBlob , asyncRomBlobPow2 , romBlob , romBlobPow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * Block RAM primitives , blockRam , blockRamPow2 -- ** Block RAM primitives initialized with a 'MemBlob' , blockRamBlob , blockRamBlobPow2 -- *** Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- ** Block RAM read/write conflict resolution , readNew -- ** True dual-port block RAM , trueDualPortBlockRam , RamOp(..) -- * Utility functions , isRising , isFalling , riseEvery , oscillate -- * Exported modules -- ** Synchronous signals , module Clash.Explicit.Signal , module Clash.Explicit.Signal.Delayed -- ** Datatypes -- *** Bit vectors , module Clash.Sized.BitVector -- *** Arbitrary-width numbers , module Clash.Sized.Signed , module Clash.Sized.Unsigned , module Clash.Sized.Index -- *** Fixed point numbers , module Clash.Sized.Fixed -- *** Fixed size vectors , module Clash.Sized.Vector -- *** Perfect depth trees , module Clash.Sized.RTree -- ** Annotations , module Clash.Annotations.TopEntity -- ** Generics type-classes , Generic , Generic1 -- ** Type-level natural numbers , module GHC.TypeLits , module GHC.TypeLits.Extra , module Clash.Promoted.Nat , module Clash.Promoted.Nat.Literals , module Clash.Promoted.Nat.TH -- ** Type-level strings , module Clash.Promoted.Symbol -- ** Type classes -- *** Clash , module Clash.Class.BitPack , module Clash.Class.Num , module Clash.Class.Resize -- *** Other , module Control.Applicative , module Data.Bits -- ** Exceptions , module Clash.XException -- ** Named types , module Clash.NamedTypes -- ** Haskell Prelude -- $hiding , module Clash.HaskellPrelude ) where import Control.Applicative import Data.Bits import GHC.Generics (Generic, Generic1) import GHC.TypeLits #if MIN_VERSION_base(4,18,0) hiding (SNat, SSymbol, fromSNat) #endif import GHC.TypeLits.Extra import Clash.HaskellPrelude import qualified Prelude import Clash.Annotations.TopEntity import Clash.Class.BitPack import Clash.Class.Num import Clash.Class.Resize import Clash.NamedTypes import Clash.Explicit.BlockRam import Clash.Explicit.BlockRam.Blob import Clash.Explicit.Mealy import Clash.Explicit.Moore import Clash.Explicit.RAM import Clash.Explicit.ROM import Clash.Explicit.ROM.Blob import Clash.Explicit.Signal import Clash.Explicit.Signal.Delayed import Clash.Explicit.Synchronizer (dualFlipFlopSynchronizer, asyncFIFOSynchronizer) import Clash.Prelude.ROM.Blob (asyncRomBlob, asyncRomBlobPow2) import Clash.Prelude.ROM (asyncRom, asyncRomPow2) import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals import Clash.Promoted.Symbol 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 hiding (fromList, unsafeFromList) import Clash.XException {- $setup >>> :set -XDataKinds >>> :m -Prelude >>> import Clash.Explicit.Prelude.Safe >>> let rP clk rst en = registerB clk rst en (8::Int,8::Int) -} {- $hiding "Clash.Explicit.Prelude.Safe" re-exports most of the Haskell "Prelude" with the exception of those functions that the Clash API defines to work on 'Vec' from "Clash.Sized.Vector" instead of on lists as the Haskell Prelude does. In addition, for the 'Clash.Class.Parity.odd' and 'Clash.Class.Parity.even' functions a type class called 'Clash.Class.Parity.Parity' is available at "Clash.Class.Parity". -} -- | Create a 'register' function for product-type like signals (e.g. -- @('Signal' a, 'Signal' b)@) -- -- @ -- rP :: Clock dom -> Reset dom -> Enable dom -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> ('Signal' dom Int, 'Signal' dom Int) -- rP clk rst en = 'registerB' clk rst en (8,8) -- @ -- -- >>> simulateB (rP systemClockGen systemResetGen enableGen) [(1,1),(1,1),(2,2),(3,3)] :: [(Int,Int)] -- [(8,8),(8,8),(1,1),(2,2),(3,3)... -- ... registerB :: ( KnownDomain dom , NFDataX a , Bundle a ) => Clock dom -> Reset dom -> Enable dom -> a -> Unbundled dom a -> Unbundled dom a registerB clk rst en i = unbundle Prelude.. register clk rst en i Prelude.. bundle {-# INLINE registerB #-} -- | Give a pulse when the 'Signal' goes from 'minBound' to 'maxBound' isRising :: ( KnownDomain dom , NFDataX a , Bounded a , Eq a ) => Clock dom -> Reset dom -> Enable dom -> a -- ^ Starting value -> Signal dom a -> Signal dom Bool isRising clk rst en is s = liftA2 edgeDetect prev s where prev = register clk rst en is s edgeDetect old new = old == minBound && new == maxBound {-# INLINABLE isRising #-} -- | Give a pulse when the 'Signal' goes from 'maxBound' to 'minBound' isFalling :: ( KnownDomain dom , NFDataX a , Bounded a , Eq a ) => Clock dom -> Reset dom -> Enable dom -> a -- ^ Starting value -> Signal dom a -> Signal dom Bool isFalling clk rst en is s = liftA2 edgeDetect prev s where prev = register clk rst en is s edgeDetect old new = old == maxBound && new == minBound {-# INLINABLE isFalling #-} -- | Give a pulse every @n@ clock cycles. This is a useful helper function when -- combined with functions like @'Clash.Explicit.Signal.regEn'@ or -- @'Clash.Explicit.Signal.mux'@, in order to delay a register by a known amount. riseEvery :: forall dom n . KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> SNat n -> Signal dom Bool riseEvery clk rst en SNat = moore clk rst en transfer output 0 (pure ()) where output :: Index n -> Bool output = (== maxBound) transfer :: Index n -> () -> Index n transfer s _ = if (s == maxBound) then 0 else s+1 {-# INLINEABLE riseEvery #-} -- | Oscillate a @'Bool'@ for a given number of cycles, given the starting state. oscillate :: forall dom n . KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> Bool -> SNat n -> Signal dom Bool oscillate clk rst en begin SNat = moore clk rst en transfer snd (0, begin) (pure ()) where transfer :: (Index n, Bool) -> () -> (Index n, Bool) transfer (s, i) _ = if s == maxBound then (0, not i) -- reset state and oscillate output else (s+1, i) -- hold current output {-# INLINEABLE oscillate #-} clash-prelude-1.8.1/src/Clash/Explicit/RAM.hs0000644000000000000000000001576207346545000017032 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. RAM primitives with a combinational read port. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} -- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c -- as to why we need this. {-# OPTIONS_GHC -fno-cpr-anal #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.RAM ( -- * RAM synchronized to an arbitrary clock asyncRam , asyncRamPow2 -- * Internal , asyncRam# ) where import Data.Maybe (isJust) import GHC.Stack (HasCallStack, withFrozenCallStack) import GHC.TypeLits (KnownNat) import qualified Data.Sequence as Seq import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.Signal (unbundle, KnownDomain, andEnable) import Clash.Promoted.Nat (SNat (..), snatToNum, pow2SNat) import Clash.Signal.Internal (Clock (..), ClockAB (..), Signal (..), Enable, fromEnable, clockTicks) import Clash.Signal.Internal.Ambiguous (clockPeriod) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (defaultSeqX, deepErrorX, fromJustX, maybeIsX, NFDataX) -- | Create a RAM with space for 2^@n@ elements -- -- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- RAM. asyncRamPow2 :: forall wdom rdom n a . ( KnownNat n , HasCallStack , KnownDomain wdom , KnownDomain rdom , NFDataX a ) => Clock wdom -- ^ 'Clock' to which the write port of the RAM is synchronized -> Clock rdom -- ^ 'Clock' to which the read address signal, @r@, is synchronized -> Enable wdom -- ^ 'Enable' line for the write port -> Signal rdom (Unsigned n) -- ^ Read address @r@ -> Signal wdom (Maybe (Unsigned n, a)) -- ^ (write address @w@, value to write) -> Signal rdom a -- ^ Value of the RAM at address @r@ asyncRamPow2 = \wclk rclk en rd wrM -> withFrozenCallStack (asyncRam wclk rclk en (pow2SNat (SNat @n)) rd wrM) {-# INLINE asyncRamPow2 #-} -- | Create a RAM with space for @n@ elements -- -- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a -- RAM. asyncRam :: ( Enum addr , NFDataX addr , HasCallStack , KnownDomain wdom , KnownDomain rdom , NFDataX a ) => Clock wdom -- ^ 'Clock' to which the write port of the RAM is synchronized -> Clock rdom -- ^ 'Clock' to which the read address signal, @r@, is synchronized -> Enable wdom -- ^ 'Enable' line for the write port -> SNat n -- ^ Size @n@ of the RAM -> Signal rdom addr -- ^ Read address @r@ -> Signal wdom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal rdom a -- ^ Value of the RAM at address @r@ asyncRam = \wclk rclk gen sz rd wrM -> let en = isJust <$> wrM (wr,din) = unbundle (fromJustX <$> wrM) in withFrozenCallStack (asyncRam# wclk rclk gen sz (fromEnum <$> rd) en (fromEnum <$> wr) din) {-# INLINE asyncRam #-} -- | RAM primitive asyncRam# :: forall wdom rdom n a . ( HasCallStack , KnownDomain wdom , KnownDomain rdom , NFDataX a ) => Clock wdom -- ^ 'Clock' to which the write port of the RAM is synchronized -> Clock rdom -- ^ 'Clock' to which the read address signal, @r@, is synchronized -> Enable wdom -- ^ 'Enable' line for the write port -> SNat n -- ^ Size @n@ of the RAM -> Signal rdom Int -- ^ Read address @r@ -> Signal wdom Bool -- ^ Write enable -> Signal wdom Int -- ^ Write address @w@ -> Signal wdom a -- ^ Value to write (at address @w@) -> Signal rdom a -- ^ Value of the RAM at address @r@ asyncRam# wClk rClk en sz rd we wr din = dout where ramI = Seq.replicate szI (withFrozenCallStack (deepErrorX "asyncRam: initial value undefined")) en0 = fromEnable (andEnable en we) dout = if rPeriod == wPeriod then goSingle ramI rd en0 wr din else go (clockTicks wClk rClk) ramI rd en0 wr din rPeriod = snatToNum (clockPeriod @rdom) :: Int wPeriod = snatToNum (clockPeriod @wdom) :: Int szI = snatToNum sz :: Int goSingle :: Seq.Seq a -> Signal rdom Int -> Signal wdom Bool -> Signal wdom Int -> Signal wdom a -> Signal rdom a goSingle !ram (r :- rs) ~(e :- es) wt@(~(w :- ws)) dt@(~(d :- ds)) = let ram0 = upd ram e w d o = ram `safeAt` r in o :- (o `defaultSeqX` wt `seq` dt `seq` goSingle ram0 rs es ws ds) go :: [ClockAB] -> Seq.Seq a -> Signal rdom Int -> Signal wdom Bool -> Signal wdom Int -> Signal wdom a -> Signal rdom a go [] _ _ _ _ _ = error "asyncRam#.go: `ticks` should have been an infinite list" go (tick:ticks) !ram rt@(~(r :- rs)) et@(~(e :- es)) wt@(~(w :- ws)) dt@(~(d :- ds)) = case tick of ClockA -> let ram0 = upd ram e w d in wt `seq` dt `seq` go ticks ram0 rt es ws ds ClockB -> let o = ram `safeAt` r in o :- (o `defaultSeqX` go ticks ram rs et wt dt) ClockAB -> go (ClockB:ClockA:ticks) ram rt et wt dt upd ram we0 waddr d = case maybeIsX we0 of Nothing -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. seq waddr d <$ ram Just wa -> -- Put the XException from `we` as the value at address -- `waddr`. safeUpdate wa (seq we0 d) ram Just True -> case maybeIsX waddr of Nothing -> -- Put the XException from `waddr` as the value in all -- locations of `ram`. seq waddr d <$ ram Just wa -> d `defaultSeqX` safeUpdate wa d ram _ -> ram safeAt :: HasCallStack => Seq.Seq a -> Int -> a safeAt s i = if (0 <= i) && (i < szI) then Seq.index s i else withFrozenCallStack (deepErrorX ("asyncRam: read address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) {-# INLINE safeAt #-} safeUpdate :: HasCallStack => Int -> a -> Seq.Seq a -> Seq.Seq a safeUpdate i a s = if (0 <= i) && (i < szI) then Seq.update i a s else let d = withFrozenCallStack (deepErrorX ("asyncRam: write address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) in d <$ s {-# INLINE safeUpdate #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE asyncRam# #-} {-# ANN asyncRam# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/ROM.hs0000644000000000000000000001053607346545000017042 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. ROMs -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.ROM ( -- * Synchronous ROM synchronized to an arbitrary clock rom , romPow2 -- * Internal , rom# ) where import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding (length) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Internal (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Vector (Vec, length, toList) import Clash.XException (deepErrorX, seqX, NFDataX) -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Explicit.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Explicit.ROM.File.romFilePow2' and -- 'Clash.Explicit.ROM.Blob.romBlobPow2' for different approaches that scale -- well. romPow2 :: (KnownDomain dom, KnownNat n, NFDataX a) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec (2^n) a -- ^ ROM content -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom a -- ^ The value of the ROM at address @r@ from the previous clock cycle romPow2 = rom {-# INLINE romPow2 #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Explicit.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Explicit.ROM.File.romFile' and -- 'Clash.Explicit.ROM.Blob.romBlob' for different approaches that scale well. rom :: (KnownDomain dom, KnownNat n, NFDataX a, Enum addr) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec n a -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom a -- ^ The value of the ROM at address @r@ from the previous clock cycle rom = \clk en content rd -> rom# clk en content (fromEnum <$> rd) {-# INLINE rom #-} -- | ROM primitive rom# :: forall dom n a . (KnownDomain dom, KnownNat n, NFDataX a) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> Vec n a -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom Int -- ^ Read address @rd@ -> Signal dom a -- ^ The value of the ROM at address @rd@ from the previous clock cycle rom# !_ en content = go (withFrozenCallStack (deepErrorX "rom: initial value undefined")) (fromEnable en) where szI = length content arr = listArray (0,szI-1) (toList content) go o (e :- es) rd@(~(r :- rs)) = let o1 = if e then safeAt r else o -- See [Note: register strictness annotations] in o `seqX` o :- (rd `seq` go o1 es rs) safeAt :: Int -> a safeAt i = if (0 <= i) && (i < szI) then unsafeAt arr i else withFrozenCallStack (deepErrorX ("rom: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) {-# INLINE safeAt #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE rom# #-} {-# ANN rom# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/ROM/0000755000000000000000000000000007346545000016501 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Explicit/ROM/Blob.hs0000644000000000000000000001113107346545000017710 0ustar0000000000000000{-| Copyright : (C) 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Efficient bundling of ROM content with the compiled code Leveraging Template Haskell, the content for the ROM components in this module is stored alongside the compiled Haskell code. It covers use cases where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be problematically slow. The data is stored efficiently, with very little overhead (worst-case 7%, often no overhead at all). Unlike "Clash.Explicit.ROM.File", "Clash.Explicit.ROM.Blob" generates practically the same HDL as "Clash.Explicit.ROM" and is compatible with all tools consuming the generated HDL. -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.ROM.Blob ( -- * ROMs defined by a 'MemBlob' romBlob , romBlobPow2 -- * Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- * Internal , romBlob# ) where import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH) import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob) import Clash.Promoted.Nat (natToNum) import Clash.Signal.Internal (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) import Clash.Sized.Internal.BitVector (BitVector) import Clash.Sized.Internal.Unsigned (Unsigned) import Clash.XException (deepErrorX, seqX) -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlob :: forall dom addr m n . ( KnownDomain dom , Enum addr ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob n m -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romBlob = \clk en content rd -> romBlob# clk en content (fromEnum <$> rd) {-# INLINE romBlob #-} -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlobPow2 :: forall dom m n . ( KnownDomain dom , KnownNat n ) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob (2^n) m -- ^ ROM content, also determines the size, 2^@n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romBlobPow2 = romBlob {-# INLINE romBlobPow2 #-} -- | ROM primitive romBlob# :: forall dom m n . KnownDomain dom => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> MemBlob n m -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom Int -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romBlob# !_ en content@MemBlob{} = go (withFrozenCallStack (deepErrorX "romBlob: initial value undefined")) (fromEnable en) where szI = natToNum @n @Int arr = listArray (0,szI-1) $ unpackMemBlob content go o (e :- es) rd@(~(r :- rs)) = let o1 = if e then safeAt r else o -- See [Note: register strictness annotations] in o `seqX` o :- (rd `seq` go o1 es rs) safeAt :: Int -> BitVector m safeAt i = if (0 <= i) && (i < szI) then unsafeAt arr i else withFrozenCallStack (deepErrorX ("romBlob: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) {-# INLINE safeAt #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE romBlob# #-} {-# ANN romBlob# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/ROM/File.hs0000644000000000000000000001574307346545000017726 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2019 , Myrtle Software Ltd., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Initializing a ROM with a data file #usingromfiles# ROMs initialized with a data file. The BNF grammar for this data file is simple: @ FILE = LINE+ LINE = BIT+ BIT = '0' | '1' @ Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: @ 000000111 000001000 000001001 000001010 000001011 000001100 000001101 @ Such a file can be produced with 'memFile': @ writeFile "memory.bin" (memFile Nothing [7 :: Unsigned 9 .. 13]) @ We can instantiate a synchronous ROM using the contents of the file above like so: @ f :: KnownDomain dom => Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) f clk en rd = 'Clash.Class.BitPack.unpack' '<$>' 'romFile' clk en d7 \"memory.bin\" rd @ And see that it works as expected: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ f systemClockGen (fromList [3..5])__ [10,11,12] @ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ g :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) g clk en rd = 'Clash.Class.BitPack.unpack' '<$>' 'romFile' clk en d7 \"memory.bin\" rd @ And then we would see: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ g systemClockGen (fromList [3..5])__ [(1,2),(1,3)(1,-4)] @ -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.ROM.File ( -- * Synchronous ROM synchronized to an arbitrary clock romFile , romFilePow2 -- * Producing files , memFile -- * Internal , romFile# ) where import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.TypeLits (KnownNat) import System.IO.Unsafe (unsafePerformIO) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.File (initMem, memFile) import Clash.Promoted.Nat (SNat (..), pow2SNat, snatToNum) import Clash.Sized.BitVector (BitVector) import Clash.Explicit.Signal (Clock, Enable, Signal, KnownDomain, delay) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (NFDataX(deepErrorX)) -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Explicit.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See 'memFile' for creating a data file with Clash. -- * See "Clash.Sized.Fixed#creatingdatafiles" for more ideas on how to create -- your own data files. romFilePow2 :: forall dom n m . (KnownNat m, KnownNat n, KnownDomain dom) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> FilePath -- ^ File describing the content of the ROM -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romFilePow2 = \clk en -> romFile clk en (pow2SNat (SNat @n)) {-# INLINE romFilePow2 #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Explicit.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See 'memFile' for creating a data file with Clash. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. romFile :: (KnownNat m, Enum addr, KnownDomain dom) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> Signal dom addr -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romFile = \clk en sz file rd -> romFile# clk en sz file (fromEnum <$> rd) {-# INLINE romFile #-} -- | romFile primitive romFile# :: forall m dom n . (KnownNat m, KnownDomain dom) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom -- ^ 'Enable' line -> SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> Signal dom Int -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romFile# clk en sz file rd = delay clk en (deepErrorX "First value of romFile is undefined") (safeAt <$> rd) where mem = unsafePerformIO (initMem file) content = listArray (0,szI-1) mem szI = snatToNum sz safeAt :: Int -> BitVector m safeAt i = if (0 <= i) && (i < szI) then unsafeAt content i else deepErrorX ("romFile: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")") {-# INLINE safeAt #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE romFile# #-} {-# ANN romFile# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/Reset.hs0000644000000000000000000004172107346545000017467 0ustar0000000000000000{-| Copyright : (C) 2020-2023, QBayLogic B.V., 2022-2023, Google LLC License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Utilities to deal with resets. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-} module Clash.Explicit.Reset ( -- Defined in this module resetSynchronizer , resetGlitchFilter , resetGlitchFilterWithReset , unsafeResetGlitchFilter , holdReset , convertReset , noReset , andReset, unsafeAndReset , orReset, unsafeOrReset -- Re-exports , Reset , resetGen , resetGenN , resetKind , systemResetGen , unsafeToReset , unsafeFromReset , unsafeToActiveHigh , unsafeToActiveLow , unsafeFromActiveHigh , unsafeFromActiveLow -- * Deprecated , unsafeFromHighPolarity , unsafeFromLowPolarity , unsafeToHighPolarity , unsafeToLowPolarity ) where import Data.Type.Equality ((:~:)(Refl)) import Clash.Class.Num (satSucc, SaturationMode(SatBound)) import Clash.Explicit.Signal import Clash.Explicit.Synchronizer (dualFlipFlopSynchronizer) import Clash.Promoted.Nat import Clash.Signal.Internal import Clash.Sized.Index (Index) import GHC.Stack (HasCallStack) import GHC.TypeLits (type (+), type (<=)) {- $setup >>> import Clash.Explicit.Prelude -} -- | A reset that is never asserted noReset :: KnownDomain dom => Reset dom noReset = unsafeFromActiveHigh (pure False) -- | Output reset will be asserted when either one of the input resets is -- asserted orReset :: forall dom . HasSynchronousReset dom => Reset dom -> Reset dom -> Reset dom orReset = unsafeOrReset -- | Output reset will be asserted when either one of the input resets is -- asserted. This function is considered unsafe because it can be used on -- domains with components with asynchronous resets, where use of this function -- can introduce glitches triggering a reset. unsafeOrReset :: forall dom. KnownDomain dom => Reset dom -> Reset dom -> Reset dom unsafeOrReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = unsafeToReset $ case resetPolarity @dom of SActiveHigh -> rst0 .||. rst1 SActiveLow -> rst0 .&&. rst1 -- | Output reset will be asserted when both input resets are asserted andReset :: forall dom . HasSynchronousReset dom => Reset dom -> Reset dom -> Reset dom andReset = unsafeAndReset -- | Output reset will be asserted when both input resets are asserted. This -- function is considered unsafe because it can be used on domains with -- components with asynchronous resets, where use of this function can introduce -- glitches triggering a reset. unsafeAndReset :: forall dom. KnownDomain dom => Reset dom -> Reset dom -> Reset dom unsafeAndReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = unsafeToReset $ case resetPolarity @dom of SActiveHigh -> rst0 .&&. rst1 SActiveLow -> rst0 .||. rst1 -- | The resetSynchronizer will synchronize an incoming reset according to -- whether the domain is synchronous or asynchronous. -- -- For asynchronous resets this synchronizer ensures the reset will only -- be de-asserted synchronously but it can still be asserted asynchronously. -- The reset assert is immediate, but reset de-assertion is delayed by two -- cycles. -- -- Normally, asynchronous resets can be both asynchronously asserted and -- de-asserted. Asynchronous de-assertion can induce meta-stability in the -- component which is being reset. To ensure this doesn't happen, -- 'resetSynchronizer' ensures that de-assertion of a reset happens -- synchronously. Assertion of the reset remains asynchronous. -- -- Note that asynchronous assertion does not induce meta-stability in the -- component whose reset is asserted. However, when a component \"A\" in another -- clock or reset domain depends on the value of a component \"B\" being -- reset, then asynchronous assertion of the reset of component \"B"\ can induce -- meta-stability in component \"A\". To prevent this from happening you need -- to use a proper synchronizer, for example one of the synchronizers in -- "Clash.Explicit.Synchronizer". -- -- For synchronous resets this function ensures that the reset is asserted and -- de-asserted synchronously. Both the assertion and de-assertion of the reset -- are delayed by two cycles. -- -- === __Example 1__ -- The circuit below detects a rising bit (i.e., a transition from 0 to 1) in a -- given argument. It takes a reset that is not synchronized to any of the other -- incoming signals and synchronizes it using 'resetSynchronizer'. -- -- @ -- topEntity -- :: Clock System -- -> Reset System -- -> Signal System Bit -- -> Signal System (BitVector 8) -- topEntity clk asyncRst key1 = -- withClockResetEnable clk rst enableGen leds -- where -- rst = 'resetSynchronizer' clk asyncRst -- key1R = isRising 1 key1 -- leds = mealy blinkerT (1, False, 0) key1R -- @ -- -- === __Example 2__ -- Similar to /Example 1/ this circuit detects a rising bit (i.e., a transition -- from 0 to 1) in a given argument. It takes a clock that is not stable yet and -- a reset signal that is not synchronized to any other signals. It stabilizes -- the clock and then synchronizes the reset signal. -- -- -- Note that the function 'Clash.Intel.ClockGen.altpllSync' provides this -- functionality in a convenient form, obviating the need for -- @resetSynchronizer@ for this use case. -- -- @ -- topEntity -- :: Clock System -- -> Reset System -- -> Signal System Bit -- -> Signal System (BitVector 8) -- topEntity clk rst key1 = -- let (pllOut,pllStable) = unsafeAltpll clk rst -- rstSync = 'resetSynchronizer' pllOut (unsafeFromActiveLow pllStable) -- in exposeClockResetEnable leds pllOut rstSync enableGen -- where -- key1R = isRising 1 key1 -- leds = mealy blinkerT (1, False, 0) key1R -- @ -- -- === __Implementation details__ -- 'resetSynchronizer' implements the following circuit for asynchronous domains: -- -- @ -- rst -- --------------------------------------+ -- | | -- +----v----+ +----v----+ -- deasserted | | | | -- ---------------> +-------> +--------> -- | | | | -- +---|> | +---|> | -- | | | | | | -- | +---------+ | +---------+ -- clk | | -- -----------------------------+ -- @ -- -- This corresponds to figure 3d at -- -- For synchronous domains two sequential dflipflops are used: -- -- @ -- +---------+ +---------+ -- rst | | | | -- ---------------> +-------> +--------> -- | | | | -- +---|> | +---|> | -- | | | | | | -- | +---------+ | +---------+ -- clk | | -- -----------------------------+ -- @ -- resetSynchronizer :: forall dom . KnownDomain dom => Clock dom -> Reset dom -> Reset dom resetSynchronizer clk rst = rstOut where isActiveHigh = case resetPolarity @dom of { SActiveHigh -> True; _ -> False } rstOut = case (resetKind @dom) of SAsynchronous -> unsafeToReset $ register clk rst enableGen isActiveHigh $ register clk rst enableGen isActiveHigh $ pure (not isActiveHigh) SSynchronous -> unsafeToReset $ delay clk enableGen isActiveHigh $ delay clk enableGen isActiveHigh $ unsafeFromReset rst -- | Filter glitches from reset signals by only triggering a reset after it has -- been asserted for /glitchlessPeriod/ cycles. Similarly, it will stay -- asserted until a /glitchlessPeriod/ number of deasserted cycles have been -- observed. -- -- This circuit can only be used on platforms supporting initial values. This -- restriction can be worked around by using 'unsafeResetGlitchFilter' but this -- is not recommended. -- -- On platforms without initial values, you should instead use -- 'resetGlitchFilterWithReset' with an additional power-on reset, or -- 'holdReset' if filtering is only needed on deassertion. -- -- At power-on, the reset will be asserted. If the filtered reset input remains -- unasserted, the output reset will deassert after /glitchlessPeriod/ clock -- cycles. -- -- If @resetGlitchFilter@ is used in a domain with asynchronous resets -- ('Asynchronous'), @resetGlitchFilter@ will first synchronize the reset input -- with 'dualFlipFlopSynchronizer'. -- -- === __Example 1__ -- >>> let sampleResetN n = sampleN n . unsafeToActiveHigh -- >>> let resetFromList = unsafeFromActiveHigh . fromList -- >>> let rst = resetFromList [True, True, False, False, True, False, False, True, True, False, True, True] -- >>> sampleResetN 12 (resetGlitchFilter d2 (clockGen @XilinxSystem) rst) -- [True,True,True,True,False,False,False,False,False,True,True,True] resetGlitchFilter :: forall dom glitchlessPeriod . ( HasCallStack , HasDefinedInitialValues dom , 1 <= glitchlessPeriod ) => SNat glitchlessPeriod -- ^ Consider a reset signal to be properly asserted after having seen the -- reset asserted for /glitchlessPeriod/ cycles straight. -> Clock dom -> Reset dom -> Reset dom resetGlitchFilter = unsafeResetGlitchFilter {-# INLINE resetGlitchFilter #-} -- | Filter glitches from reset signals by only triggering a reset after it has -- been asserted for /glitchlessPeriod/ cycles. Similarly, it will stay -- asserted until a /glitchlessPeriod/ number of deasserted cycles have been -- observed. -- -- On platforms without initial values ('Unknown'), 'resetGlitchFilter' cannot -- be used and you should use 'resetGlitchFilterWithReset' with an additional -- power-on reset, or 'holdReset' if filtering is only needed on deassertion. -- -- @unsafeResetGlitchFilter@ allows breaking the requirement of initial values, -- but by doing so it is possible that the design starts up with a period of up -- to /2 * glitchlessPeriod/ clock cycles where the reset output is unasserted -- (or longer in the case of glitches on the filtered reset input). This can -- cause a number of problems. The outputs\/tri-states of the design might -- output random things, including coherent but incorrect streams of data. This -- might have grave repercussions in the design's environment (sending network -- packets, overwriting non-volatile memory, in extreme cases destroying -- controlled equipment or causing harm to living beings, ...). -- -- Without initial values, the synthesized result of @unsafeResetGlitchFilter@ -- eventually correctly outputs a filtered version of the reset input. However, -- in simulation, it will indefinitely output an undefined value. This happens -- both in Clash simulation and in HDL simulation. Therefore, simulation should -- not include the @unsafeResetGlitchFilter@. -- -- If @unsafeResetGlitchFilter@ is used in a domain with asynchronous resets -- ('Asynchronous'), @unsafeResetGlitchFilter@ will first synchronize the reset -- input with 'dualFlipFlopSynchronizer'. unsafeResetGlitchFilter :: forall dom glitchlessPeriod . ( HasCallStack , KnownDomain dom , 1 <= glitchlessPeriod ) => SNat glitchlessPeriod -- ^ Consider a reset signal to be properly asserted after having seen the -- reset asserted for /glitchlessPeriod/ cycles straight. -> Clock dom -> Reset dom -> Reset dom unsafeResetGlitchFilter glitchlessPeriod clk = resetGlitchFilter# glitchlessPeriod reg dffSync where reg = delay clk enableGen dffSync = dualFlipFlopSynchronizer clk clk noReset enableGen {-# INLINE unsafeResetGlitchFilter #-} -- | Filter glitches from reset signals by only triggering a reset after it has -- been asserted for /glitchlessPeriod/ cycles. Similarly, it will stay -- asserted until a /glitchlessPeriod/ number of deasserted cycles have been -- observed. -- -- Compared to 'resetGlitchFilter', this function adds an additional power-on -- reset input. As soon as the power-on reset asserts, the reset output will -- assert, and after the power-on reset deasserts, the reset output will stay -- asserted for another /glitchlessPeriod/ clock cycles. This is identical -- behavior to 'holdReset' where it concerns the power-on reset, and differs -- from the filtered reset, which will only cause an assertion after -- /glitchlessPeriod/ cycles. -- -- If @resetGlitchFilterWithReset@ is used in a domain with asynchronous resets -- ('Asynchronous'), @resetGlitchFilterWithReset@ will first synchronize the -- reset input with 'dualFlipFlopSynchronizer'. resetGlitchFilterWithReset :: forall dom glitchlessPeriod . ( HasCallStack , KnownDomain dom , 1 <= glitchlessPeriod ) => SNat glitchlessPeriod -- ^ Consider a reset signal to be properly asserted after having seen the -- reset asserted for /glitchlessPeriod/ cycles straight. -> Clock dom -> Reset dom -- ^ The power-on reset for the glitch filter itself -> Reset dom -- ^ The reset that will be filtered -> Reset dom resetGlitchFilterWithReset glitchlessPeriod clk ownRst = resetGlitchFilter# glitchlessPeriod reg dffSync where reg = register clk ownRst enableGen dffSync = dualFlipFlopSynchronizer clk clk ownRst enableGen {-# INLINE resetGlitchFilterWithReset #-} resetGlitchFilter# :: forall dom glitchlessPeriod state . ( HasCallStack , KnownDomain dom , 1 <= glitchlessPeriod , state ~ (Bool, Index glitchlessPeriod) ) => SNat glitchlessPeriod -> ( state -> Signal dom state -> Signal dom state ) -> ( Bool -> Signal dom Bool -> Signal dom Bool ) -> Reset dom -> Reset dom resetGlitchFilter# SNat reg dffSync rstIn0 = let s' = go <$> s <*> rstIn2 s = reg (asserted, 0) s' in unsafeToReset $ fst <$> s where rstIn1 = unsafeFromReset rstIn0 rstIn2 = case resetKind @dom of SAsynchronous -> dffSync asserted rstIn1 SSynchronous -> rstIn1 go :: state -> Bool -> state go (state, count) reset | reset == state = (state, 0) | count == maxBound = (not state, 0) | otherwise = (state, count + 1) asserted :: Bool asserted = case resetPolarity @dom of SActiveHigh -> True SActiveLow -> False -- | Hold reset for a number of cycles relative to an incoming reset signal. -- -- Example: -- -- >>> let sampleWithReset = sampleN 8 . unsafeToActiveHigh -- >>> sampleWithReset (holdReset @System clockGen enableGen (SNat @2) (resetGenN (SNat @3))) -- [True,True,True,True,True,False,False,False] -- -- 'holdReset' holds the reset for an additional 2 clock cycles for a total -- of 5 clock cycles where the reset is asserted. 'holdReset' also works on -- intermediate assertions of the reset signal: -- -- >>> let rst = fromList [True, False, False, False, True, False, False, False] -- >>> sampleWithReset (holdReset @System clockGen enableGen (SNat @2) (unsafeFromActiveHigh rst)) -- [True,True,True,False,True,True,True,False] -- holdReset :: forall dom n . KnownDomain dom => Clock dom -> Enable dom -- ^ Global enable -> SNat n -- ^ Hold for /n/ cycles, counting from the moment the incoming reset -- signal becomes deasserted. -> Reset dom -- ^ Reset to extend -> Reset dom holdReset clk en SNat rst = unsafeFromActiveHigh ((/=maxBound) <$> counter) where counter :: Signal dom (Index (n+1)) counter = register clk rst en 0 (satSucc SatBound <$> counter) -- | Convert between different types of reset, adding a synchronizer when -- the domains are not the same. See 'resetSynchronizer' for further details -- about reset synchronization. -- -- If @domA@ has 'Synchronous' resets, a flip-flop is inserted in @domA@ to -- filter glitches. This adds one @domA@ clock cycle delay. convertReset :: forall domA domB . ( KnownDomain domA , KnownDomain domB ) => Clock domA -> Clock domB -> Reset domA -> Reset domB convertReset clkA clkB rstA0 = rstB1 where rstA1 = unsafeFromReset rstA0 rstA2 = case (resetPolarity @domA, resetPolarity @domB) of (SActiveLow, SActiveLow) -> rstA1 (SActiveHigh, SActiveHigh) -> rstA1 _ -> not <$> rstA1 rstA3 = case resetKind @domA of SSynchronous -> delay clkA enableGen assertedA rstA2 _ -> rstA2 rstB0 = unsafeToReset $ unsafeSynchronizer clkA clkB rstA3 rstB1 = case (sameDomain @domA @domB) of Just Refl -> rstA0 Nothing -> resetSynchronizer clkB rstB0 assertedA :: Bool assertedA = case resetPolarity @domA of SActiveHigh -> True SActiveLow -> False clash-prelude-1.8.1/src/Clash/Explicit/Signal.hs0000644000000000000000000007243607346545000017631 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016-2019, Myrtle Software, 2017-2022, Google Inc. 2020 , Ben Gamari, 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Clash has synchronous 'Signal's in the form of: @ 'Signal' (dom :: 'GHC.TypeLits.Symbol') a @ Where /a/ is the type of the value of the 'Signal', for example /Int/ or /Bool/, and /dom/ is the /clock-/ (and /reset-/) domain to which the memory elements manipulating these 'Signal's belong. The type-parameter, /dom/, is of the kind 'Domain' - a simple string. That string refers to a single /synthesis domain/. A synthesis domain describes the behavior of certain aspects of memory elements in it. More specifically, a domain looks like: @ 'DomainConfiguration' { _name:: 'GHC.TypeLits.Symbol' -- ^ Domain name , _period :: 'GHC.TypeLits.Nat' -- ^ Clock period in /ps/ , _edge :: 'ActiveEdge' -- ^ Active edge of the clock , _reset :: 'ResetKind' -- ^ Whether resets are synchronous (edge-sensitive) or asynchronous (level-sensitive) , _init :: 'InitBehavior' -- ^ Whether the initial (or "power up") value of memory elements is -- unknown/undefined, or configurable to a specific value , _polarity :: 'ResetPolarity' -- ^ Whether resets are active high or active low } @ Check the documentation of each of the types to see the various options Clash provides. In order to specify a domain, an instance of 'KnownDomain' should be made. Clash provides a standard implementation, called 'System', that is configured as follows: @ instance KnownDomain "System" where type KnownConf "System" = 'DomainConfiguration "System" 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = 'SDomainConfiguration' SSymbol SNat 'SRising' 'SAsynchronous' 'SDefined' 'SActiveHigh' @ In words, \"System\" is a synthesis domain with a clock running with a period of 10000 /ps/ (100 MHz). Memory elements update their state on the rising edge of the clock, can be reset asynchronously with regards to the clock, and have defined power up values if applicable. In order to create a new domain, you don't have to instantiate it explicitly. Instead, you can have 'createDomain' create a domain for you. You can also use the same function to subclass existing domains. * __NB__: \"Bad things\"™ happen when you actually use a clock period of @0@, so do __not__ do that! * __NB__: You should be judicious using a clock with period of @1@ as you can never create a clock that goes any faster! * __NB__: For the best compatibility make sure your period is divisible by 2, because some VHDL simulators don't support fractions of picoseconds. * __NB__: Whether 'System' has good defaults depends on your target platform. Check out 'IntelSystem' and 'XilinxSystem' too! === Explicit clocks and resets, and meta-stability #metastability# When using multiple clocks and/or reset lines there are ways to accidentally introduce situations that are prone to . These bugs are incredibly hard to debug as they often cannot be simulated, so it's best to prevent them in the first place. This section outlines the situations in which metastability arises and how to prevent it. Two types of resets exist: synchronous and asynchronous resets. These reset types are encoded in a synthesis domain. For the following examples we assume the following exist: @ 'DomainConfiguration' \"SyncExample\" _period _edge 'Synchronous' _init 'DomainConfiguration' \"AsyncExample\" _period _edge 'Asynchronous' _init @ See the previous section on how to use domains. We now go over the clock and reset line combinations and explain when they can potentially introduce situations prone to meta-stability: * /Reset situation 1/: @ f :: 'Reset' \"SyncExample\" -> 'Reset' \"SyncExample\" -> .. f x y = .. @ There are no problems here, because although /x/ and /y/ can have different values, components to these reset lines are reset /synchronously/, and there is no metastability situation. * /Reset situation 2/: @ g :: 'Reset' \"AsyncExample\" -> 'Reset' \"AsyncExample\" -> .. g x y = .. @ This situation can be prone to metastability, because although /x/ and /y/ belong to the same /domain/ according to their domain, there is no guarantee that they actually originate from the same source. This means that one component can enter its reset state asynchronously to another component, inducing metastability in the other component. * /Clock situation/: @ k :: 'Clock' dom -> 'Clock' dom -> .. k x y = .. @ The situation above is potentially prone to metastability, because even though /x/ and /y/ belong to the same /domain/ according to their domain, there is no guarantee that they actually originate from the same source. They could hence be connected to completely unrelated clock sources, and components can then induce metastable states in others. -} {-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# 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(..) , KnownConfiguration , ActiveEdge(..) , SActiveEdge(..) , InitBehavior(..) , SInitBehavior(..) , ResetKind(..) , SResetKind(..) , ResetPolarity(..) , SResetPolarity(..) , DomainConfiguration(..) , SDomainConfiguration(..) -- ** Configuration type families , DomainPeriod , DomainActiveEdge , DomainResetKind , DomainInitBehavior , DomainResetPolarity -- *** Convenience types #conveniencetypes# -- **** Simplifying -- $conveniencetypes , HasSynchronousReset , HasAsynchronousReset , HasDefinedInitialValues -- ** Default domains , System , XilinxSystem , IntelSystem , vSystem , vIntelSystem , vXilinxSystem -- ** Domain utilities , VDomainConfiguration(..) , vDomain , createDomain , knownVDomain , clockPeriod , activeEdge , resetKind , initBehavior , resetPolarity -- ** Enabling , Enable , toEnable , fromEnable , enableGen -- * Clock , Clock , DiffClock , periodToHz , hzToPeriod -- ** Synchronization primitive , unsafeSynchronizer , veryUnsafeSynchronizer -- * Reset , Reset , unsafeToReset , unsafeFromReset , unsafeToActiveHigh , unsafeToActiveLow , unsafeFromActiveHigh , unsafeFromActiveLow -- * Basic circuit functions , andEnable , dflipflop , delay , delayMaybe , delayEn , register , regMaybe , regEn , mux -- * Simulation and testbench functions , clockGen , resetGen , resetGenN , systemClockGen , systemResetGen -- * Boolean connectives , (.&&.), (.||.) -- * Product/Signal isomorphism , Bundle(..) , EmptyTuple(..) , TaggedEmptyTuple(..) -- * Simulation functions (not synthesizable) , simulate , simulateB , simulateWithReset , simulateWithResetN , runUntil -- ** lazy versions , simulate_lazy , simulateB_lazy -- ** Automaton , signalAutomaton -- * List \<-\> Signal conversion (not synthesizable) , sample , sampleN , sampleWithReset , sampleWithResetN , fromList , fromListWithReset -- ** lazy versions , sample_lazy , sampleN_lazy , fromList_lazy -- * QuickCheck combinators , testFor -- * Type classes -- ** 'Eq'-like , (.==.), (./=.) -- ** 'Ord'-like , (.<.), (.<=.), (.>=.), (.>.) -- * Bisignal functions , veryUnsafeToBiSignalIn , readFromBiSignal , writeToBiSignal , mergeBiSignalOuts -- * Deprecated , unsafeFromHighPolarity , unsafeFromLowPolarity , unsafeToHighPolarity , unsafeToLowPolarity ) where import Data.Bifunctor (bimap) import Data.Int (Int64) import Data.List (uncons) import Data.Maybe (isJust) import GHC.TypeLits (type (<=)) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Promoted.Nat (SNat(..), snatToNum) 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 qualified Clash.Sized.Vector import Clash.XException (NFDataX, deepErrorX, fromJustX, seqX, ShowX(..)) {- $setup >>> :set -XDataKinds -XTypeApplications -XFlexibleInstances -XMultiParamTypeClasses -XTypeFamilies >>> :set -fno-warn-deprecations >>> :m -Prelude >>> import Clash.Explicit.Prelude >>> import Clash.Promoted.Nat (SNat(..)) >>> import qualified Data.List as L >>> :{ instance KnownDomain "Dom2" where type KnownConf "Dom2" = 'DomainConfiguration "Dom2" 2 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh :} >>> :{ instance KnownDomain "Dom7" where type KnownConf "Dom7" = 'DomainConfiguration "Dom7" 7 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh :} >>> type Dom2 = "Dom2" >>> type Dom7 = "Dom7" >>> let clk2 = clockGen @Dom2 >>> let clk7 = clockGen @Dom7 >>> let en2 = enableGen @Dom2 >>> let en7 = enableGen @Dom7 >>> let oversampling clkA clkB enA enB dflt = delay clkB enB dflt . unsafeSynchronizer clkA clkB . delay clkA enA dflt >>> let almostId clkA clkB enA enB dflt = delay clkB enB dflt . unsafeSynchronizer clkA clkB . delay clkA enA dflt . unsafeSynchronizer clkB clkA . delay clkB enB dflt >>> let oscillate clk rst en = let s = register clk rst en False (not <$> s) in s >>> let count clk rst en = let s = regEn clk rst en 0 (oscillate clk rst en) (s + 1) in s >>> :{ sometimes1 clk rst en = s where s = register clk rst en Nothing (switch <$> s) switch Nothing = Just 1 switch _ = Nothing :} >>> :{ countSometimes clk rst en = s where s = regMaybe clk rst en 0 (plusM (pure <$> s) (sometimes1 clk rst en)) plusM = liftA2 (liftA2 (+)) :} -} {- $conveniencetypes If you want to write part of your Clash design as domain-polymorphic functions, it can be practical to define a design-wide constraint synonym that captures the characteristics of the clock domains of the design. Such a constraint synonym can be used as a constraint on all domain-polymorphic functions in the design, regardless of whether they actually need the constraints from this section. @ type DesignDomain dom = ( 'HasSynchronousReset' dom , 'HasDefinedInitialValues' dom ) type DesignDomainHidden dom = ( DesignDomain dom , t'Clash.Signal.HiddenClockResetEnable' dom ) myFunc :: DesignDomainHidden dom => 'Signal' dom [...] @ This way, you don't have to think about which constraints the function you're writing has exactly, and the constraint is succinct. -} -- **Clock -- | Clock generator for the 'System' clock domain. -- -- __NB__: Should only be used for simulation, and __not__ for the /testBench/ -- function. For the /testBench/ function, used 'Clash.Explicit.Testbench.tbSystemClockGen' systemClockGen :: Clock System systemClockGen = clockGen -- | Reset generator for use in simulation, for the 'System' clock domain. -- Asserts the reset for a single cycle. -- -- __NB__: While this can be used in the @testBench@ function, it cannot be -- synthesized to hardware. -- -- === __Example__ -- -- @ -- topEntity :: Vec 2 (Vec 3 (Unsigned 8)) -> Vec 6 (Unsigned 8) -- topEntity = concat -- -- testBench :: Signal System Bool -- testBench = done -- where -- testInput = pure ((1 :> 2 :> 3 :> Nil) :> (4 :> 5 :> 6 :> Nil) :> Nil) -- expectedOutput = outputVerifier' ((1:>2:>3:>4:>5:>6:>Nil):>Nil) -- done = exposeClockResetEnable (expectedOutput (topEntity \<$\> testInput)) clk rst -- clk = tbSystemClockGen (not <\$\> done) -- rst = 'systemResetGen' -- @ systemResetGen ::Reset System systemResetGen = resetGen -- ** Synchronization primitive -- | The 'unsafeSynchronizer' function is a primitive that must be used to -- connect one clock domain to the other, and will be synthesized to a (bundle -- of) wire(s) in the eventual circuit. This function should only be used as -- part of a proper synchronization component, such as the following dual -- flip-flop synchronizer: -- -- @ -- dualFlipFlop -- :: Clock domA -- -> Clock domB -- -> Enable domA -- -> Enable domB -- -> Bit -- -> Signal domA Bit -- -> Signal domB Bit -- dualFlipFlop clkA clkB enA enB dflt = -- 'delay' clkB enB dflt . 'delay' clkB enB dflt . 'unsafeSynchronizer' clkA clkB -- @ -- -- The 'unsafeSynchronizer' works in such a way that, given 2 clocks: -- -- @ -- createDomain vSystem{vName=\"Dom7\", vPeriod=7} -- -- clk7 :: 'Clock' Dom7 -- clk7 = 'clockGen' -- -- en7 :: 'Enable' Dom7 -- en7 = 'enableGen' -- @ -- -- and -- -- @ -- createDomain vSystem{vName=\"Dom2\", vPeriod=2} -- -- clk2 :: 'Clock' Dom2 -- clk2 = 'clockGen' -- -- en2 :: 'Enable' Dom2 -- en2 = 'enableGen' -- @ -- -- Oversampling followed by compression is the identity function plus 2 initial -- values: -- -- @ -- 'delay' clkB enB dflt $ -- 'unsafeSynchronizer' clkA clkB $ -- 'delay' clkA enA dflt $ -- 'unsafeSynchronizer' clkB clkA $ -- 'delay' clkB enB s -- -- == -- -- dflt :- dflt :- s -- @ -- -- Something we can easily observe: -- -- @ -- oversampling clkA clkB enA enB dflt = -- 'delay' clkB enB dflt -- . 'unsafeSynchronizer' clkA clkB -- . 'delay' clkA enA dflt -- almostId clkA clkB enA enB dflt = -- 'delay' clkB enB dflt -- . 'unsafeSynchronizer' clkA clkB -- . 'delay' clkA enA dflt -- . 'unsafeSynchronizer' clkB clkA -- . 'delay' clkB enB dflt -- @ -- -- >>> sampleN 37 (oversampling clk7 clk2 en7 en2 0 (fromList [(1::Int)..10])) -- [0,0,1,1,1,2,2,2,2,3,3,3,4,4,4,4,5,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10] -- >>> sampleN 12 (almostId clk2 clk7 en2 en7 0 (fromList [(1::Int)..10])) -- [0,0,1,2,3,4,5,6,7,8,9,10] unsafeSynchronizer :: forall dom1 dom2 a . ( KnownDomain dom1 , KnownDomain dom2 ) => Clock dom1 -- ^ 'Clock' of the incoming signal -> Clock dom2 -- ^ 'Clock' of the outgoing signal -> Signal dom1 a -> Signal dom2 a unsafeSynchronizer clk1 clk2 = go (clockTicks clk1 clk2) where go :: [ClockAB] -> Signal dom1 a -> Signal dom2 a go [] _ = error "unsafeSynchronizer.go: `ticks` should have been an infinite list" go (tick:ticks) ass@(~(a :- as)) = case tick of ClockA -> go ticks as ClockB -> a :- go ticks ass ClockAB -> go (ClockB:ClockA:ticks) ass -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unsafeSynchronizer #-} {-# ANN unsafeSynchronizer hasBlackBox #-} -- | Same as 'unsafeSynchronizer', but with manually supplied clock periods. -- -- Note: this unsafeSynchronizer is defined to be consistent with the vhdl and verilog -- implementations however as only synchronous signals are represented in Clash this -- cannot be done precisely and can lead to odd behavior. For example, -- -- @ -- sample $ unsafeSynchronizer @Dom2 @Dom7 . unsafeSynchronizer @Dom7 @Dom2 $ fromList [0..10] -- > [0,4,4,4,7,7,7,7,11,11,11.. -- @ -- -- is quite different from the identity, -- -- @ -- sample $ fromList [0..10] -- > [0,1,2,3,4,5,6,7,8,9,10.. -- @ -- -- with values appearing from the "future". veryUnsafeSynchronizer :: Either Int (Signal dom1 Int) -- ^ Period of clock belonging to @dom1@. 'Left' if clock has a static period, -- 'Right' if periods are dynamic. -> Either Int (Signal dom2 Int) -- ^ Period of clock belonging to @dom2@. 'Left' if clock has a static period, -- 'Right' if periods are dynamic. -> Signal dom1 a -> Signal dom2 a veryUnsafeSynchronizer t1e t2e = go (clockTicksEither (toInt64 t1e) (toInt64 t2e)) where -- TODO: deprecate 'veryUnsafeSynchronizer' or change its type signature to use -- 'Int64' to prevent issues down the road if/when we switch to represent -- clock periods using femtoseconds. toInt64 :: forall dom . Either Int (Signal dom Int) -> Either Int64 (Signal dom Int64) toInt64 = bimap fromIntegral (fmap fromIntegral) go :: [ClockAB] -> Signal dom1 a -> Signal dom2 a go [] _ = error "veryUnsafeSynchronizer.go: `ticks` should have been an infinite list" go (tick:ticks) ass@(~(a :- as)) = case tick of ClockA -> go ticks as ClockB -> a :- go ticks ass ClockAB -> go (ClockB:ClockA:ticks) ass -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE veryUnsafeSynchronizer #-} {-# ANN veryUnsafeSynchronizer hasBlackBox #-} -- * Basic circuit functions -- | Merge enable signal with signal of bools by applying the boolean AND -- operation. andEnable :: Enable dom -> Signal dom Bool -> Enable dom andEnable e0 e1 = toEnable (fromEnable e0 .&&. e1) {-# INLINE andEnable #-} -- | Special version of 'delay' that doesn't take enable signals of any kind. -- Initial value will be undefined. dflipflop :: ( KnownDomain dom , NFDataX a ) => Clock dom -> Signal dom a -> Signal dom a dflipflop = \clk i -> delay# clk (toEnable (pure True)) (deepErrorX "First value of dflipflop undefined") i {-# INLINE dflipflop #-} -- | \"@'delay' clk s@\" delays the values in 'Signal' /s/ for once cycle, the -- value at time 0 is /dflt/. -- -- >>> sampleN 3 (delay systemClockGen enableGen 0 (fromList [1,2,3,4])) -- [0,1,2] delay :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock -> Enable dom -- ^ Global enable -> a -- ^ Initial value -> Signal dom a -> Signal dom a delay = delay# {-# INLINE delay #-} -- | Version of 'delay' that only updates when its third argument is a 'Just' -- value. -- -- >>> let input = fromList [Just 1, Just 2, Nothing, Nothing, Just 5, Just 6, Just (7::Int)] -- >>> sampleN 7 (delayMaybe systemClockGen enableGen 0 input) -- [0,1,2,2,2,5,6] delayMaybe :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock -> Enable dom -- ^ Global enable -> a -- ^ Initial value -> Signal dom (Maybe a) -> Signal dom a delayMaybe = \clk gen dflt i -> delay# clk (andEnable gen (isJust <$> i)) dflt (fromJustX <$> i) {-# INLINE delayMaybe #-} -- | Version of 'delay' that only updates when its third argument is asserted. -- -- >>> let input = fromList [1,2,3,4,5,6,7::Int] -- >>> let enable = fromList [True,True,False,False,True,True,True] -- >>> sampleN 7 (delayEn systemClockGen enableGen 0 enable input) -- [0,1,2,2,2,5,6] delayEn :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock -> Enable dom -- ^ Global enable -> a -- ^ Initial value -> Signal dom Bool -- ^ Enable -> Signal dom a -> Signal dom a delayEn = \clk gen dflt en i -> delay# clk (andEnable gen en) dflt i {-# INLINE delayEn #-} -- | \"@'register' clk rst en i s@\" delays the values in 'Signal' /s/ for one -- cycle, and sets the value to @i@ the moment the reset becomes 'False'. -- -- >>> sampleN 5 (register systemClockGen resetGen enableGen 8 (fromList [1,1,2,3,4])) -- [8,8,1,2,3] register :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ clock -> Reset dom -- ^ Reset, 'register' outputs the reset value when the reset is active -> Enable dom -- ^ Global enable -> a -- ^ Reset value. If the domain has initial values enabled, the reset value -- will also be the initial value. -> Signal dom a -> Signal dom a register = \clk rst gen initial i -> register# clk rst gen initial initial i {-# INLINE register #-} -- | Version of 'register' that only updates its content when its fourth -- argument is a 'Just' value. So given: -- -- @ -- sometimes1 clk rst en = s where -- s = 'register' clk rst en Nothing (switch '<$>' s) -- -- switch Nothing = Just 1 -- switch _ = Nothing -- -- countSometimes clk rst en = s where -- s = 'regMaybe' clk rst en 0 (plusM ('pure' '<$>' s) (sometimes1 clk rst en)) -- plusM = liftA2 (liftA2 (+)) -- @ -- -- We get: -- -- >>> sampleN 9 (sometimes1 systemClockGen resetGen enableGen) -- [Nothing,Nothing,Just 1,Nothing,Just 1,Nothing,Just 1,Nothing,Just 1] -- >>> sampleN 9 (count systemClockGen resetGen enableGen) -- [0,0,0,1,1,2,2,3,3] regMaybe :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock -> Reset dom -- ^ Reset, 'regMaybe' outputs the reset value when the reset value is active -> Enable dom -- ^ Global enable -> a -- ^ Reset value. If the domain has initial values enabled, the reset value -- will also be the initial value. -> Signal dom (Maybe a) -> Signal dom a regMaybe = \clk rst en initial iM -> register# clk rst (andEnable en (fmap isJust iM)) initial initial (fmap fromJustX iM) {-# INLINE regMaybe #-} -- | Version of 'register' that only updates its content when its fourth -- argument is asserted. So given: -- -- @ -- oscillate clk rst en = let s = 'register' clk rst en False (not \<$\> s) in s -- count clk rst en = let s = 'regEn clk rst en 0 (oscillate clk rst en) (s + 1) in s -- @ -- -- We get: -- -- >>> sampleN 9 (oscillate systemClockGen resetGen enableGen) -- [False,False,True,False,True,False,True,False,True] -- >>> sampleN 9 (count systemClockGen resetGen enableGen) -- [0,0,0,1,1,2,2,3,3] regEn :: ( KnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock -> Reset dom -- ^ Reset, 'regEn' outputs the reset value when the reset value is active -> Enable dom -- ^ Global enable -> a -- ^ Reset value. If the domain has initial values enabled, the reset value -- will also be the initial value. -> Signal dom Bool -- ^ Enable signal -> Signal dom a -> Signal dom a regEn = \clk rst gen initial en i -> register# clk rst (andEnable gen en) initial initial i {-# INLINE regEn #-} -- * Simulation functions -- | Same as 'simulate', but with the reset line asserted for /n/ cycles. Similar -- to 'simulate', 'simulateWithReset' will drop the output values produced while -- the reset is asserted. While the reset is asserted, the first value from -- @[a]@ is fed to the circuit. simulateWithReset :: forall dom a b m . ( KnownDomain dom , NFDataX a , NFDataX b , 1 <= m ) => SNat m -- ^ Number of cycles to assert the reset -> a -- ^ Reset value -> ( KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> Signal dom a -> Signal dom b ) -- ^ Circuit to simulate -> [a] -> [b] simulateWithReset m resetVal f as = drop (snatToNum m) out where inp = replicate (snatToNum m) resetVal ++ as rst = resetGenN @dom m clk = clockGen en = enableGen out = simulate (f clk rst en) inp -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE simulateWithReset #-} -- | Same as 'simulateWithReset', but only sample the first /Int/ output values. simulateWithResetN :: ( KnownDomain dom , NFDataX a , NFDataX b , 1 <= m ) => SNat m -- ^ Number of cycles to assert the reset -> a -- ^ Reset value -> Int -- ^ Number of cycles to simulate (excluding cycle spent in reset) -> ( KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> Signal dom a -> Signal dom b ) -- ^ Circuit to simulate -> [a] -> [b] simulateWithResetN nReset resetVal nSamples f as = take nSamples (simulateWithReset nReset resetVal f as) {-# INLINE simulateWithResetN #-} -- | Simulate a (@'Unbundled' a -> 'Unbundled' b@) function given a list of -- samples of type /a/ -- -- >>> simulateB (unbundle . register systemClockGen resetGen enableGen (8,8) . bundle) [(1,1), (1,1), (2,2), (3,3)] :: [(Int,Int)] -- [(8,8),(8,8),(1,1),(2,2),(3,3)... -- ... -- -- __NB__: This function is not synthesizable simulateB :: (Bundle a, Bundle b, NFDataX a, NFDataX b) => (Unbundled dom1 a -> Unbundled dom2 b) -- ^ The function we want to simulate -> [a] -- ^ Input samples -> [b] simulateB f = simulate (bundle . f . unbundle) -- | /Lazily/ simulate a (@'Unbundled' a -> 'Unbundled' b@) function given a -- list of samples of type /a/ -- -- >>> simulateB (unbundle . register systemClockGen resetGen enableGen (8,8) . bundle) [(1,1), (1,1), (2,2), (3,3)] :: [(Int,Int)] -- [(8,8),(8,8),(1,1),(2,2),(3,3)... -- ... -- -- __NB__: This function is not synthesizable simulateB_lazy :: (Bundle a, Bundle b) => (Unbundled dom1 a -> Unbundled dom2 b) -- ^ The function we want to simulate -> [a] -- ^ Input samples -> [b] simulateB_lazy f = simulate_lazy (bundle . f . unbundle) -- | Like 'fromList', but resets on reset and has a defined reset value. -- -- >>> let rst = unsafeFromActiveHigh (fromList [True, True, False, False, True, False]) -- >>> let res = fromListWithReset @System rst Nothing [Just 'a', Just 'b', Just 'c'] -- >>> sampleN 6 res -- [Nothing,Nothing,Just 'a',Just 'b',Nothing,Just 'a'] -- -- __NB__: This function is not synthesizable fromListWithReset :: forall dom a . (KnownDomain dom, NFDataX a) => Reset dom -> a -> [a] -> Signal dom a fromListWithReset rst resetValue vals = go (unsafeToActiveHigh rst) vals where go (r :- rs) _ | r = resetValue :- go rs vals go (_ :- rs) [] = deepErrorX "fromListWithReset: input ran out" :- go rs [] go (_ :- rs) (a : as) = a :- go rs as -- | 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- | Simulate a component until it matches a condition -- -- It prints a message of the form -- -- @ -- Signal sampled for N cycles until value X -- @ -- -- __NB__: This function is not synthesizable -- -- === __Example with test bench__ -- -- A common usage is with a test bench using -- 'Clash.Explicit.Testbench.outputVerifier'. -- -- __NB__: Since this uses 'Clash.Explicit.Testbench.assert', when using -- @clashi@, read the note at "Clash.Explicit.Testbench#assert-clashi". -- -- @ -- import Clash.Prelude -- import Clash.Explicit.Testbench -- -- topEntity -- :: 'Signal' 'System' Int -- -> 'Signal' 'System' Int -- topEntity = id -- -- testBench -- :: 'Signal' 'System' Bool -- testBench = done -- where -- testInput = 'Clash.Explicit.Testbench.stimuliGenerator' clk rst $('Clash.Sized.Vector.listToVecTH' [1 :: Int .. 10]) -- expectedOutput = -- 'Clash.Explicit.Testbench.outputVerifier'' clk rst $('Clash.Sized.Vector.listToVecTH' $ [1 :: Int .. 9] '<>' [42]) -- done = expectedOutput $ topEntity testInput -- clk = 'Clash.Explicit.Testbench.tbSystemClockGen' (not \<$\> done) -- rst = 'systemResetGen' -- @ -- -- @ -- > runUntil id testBench -- -- -- cycle(\): 10, outputVerifier -- expected value: 42, not equal to actual value: 10 -- Signal sampled for 11 cycles until value True -- @ -- -- When you need to verify multiple test benches, the following invocations come -- in handy: -- -- @ -- > 'mapM_' (runUntil id) [ testBenchA, testBenchB ] -- @ -- -- or when the test benches are in different clock domains: -- -- @ -- testBenchA :: Signal DomA Bool -- testBenchB :: Signal DomB Bool -- @ -- -- @ -- > 'sequence_' [ runUntil id testBenchA, runUntil id testBenchB ] -- @ runUntil :: forall dom a . (KnownDomain dom, NFDataX a, ShowX a) => (a -> Bool) -- ^ Condition checking function, should return @True@ to finish run -> Signal dom a -- ^ 'Signal' we want to sample for the condition -> IO () runUntil check s = -- Ensure invocations of 'trace' are printed before the result message value `seqX` putStrLn msg where msg = ("Signal sampled for " ++) . shows nSamples . (" cycles until value " ++) $ showX value (before, after) = break check $ sample s nSamples = length before value = maybe (error "impossible") fst (uncons after) {-# RULES "sequenceAVecSignal" Clash.Sized.Vector.traverse# (\x -> x) = vecBundle# #-} clash-prelude-1.8.1/src/Clash/Explicit/Signal/0000755000000000000000000000000007346545000017261 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Explicit/Signal/Delayed.hs0000644000000000000000000001667007346545000021176 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd 2021 , LUMI GUIDE FIETSDETECTIE B.V. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.Signal.Delayed ( DSignal -- * Delay-annotated synchronous signals , delayed , delayedI , delayN , delayI , delayedFold , feedback -- * Signal \<-\> DSignal conversion , fromSignal , toSignal -- * List \<-\> DSignal conversion (not synthesizable) , dfromList -- ** lazy versions , dfromList_lazy -- * Experimental , unsafeFromSignal , antiDelay , forward ) where import Prelude ((.), (<$>), (<*>), id, Num(..)) import Data.Coerce (coerce) import Data.Kind (Type) import Data.Proxy (Proxy (..)) import Data.Singletons (Apply, TyFun, type (@@)) import GHC.TypeLits (KnownNat, Nat, type (+), type (^), type (*)) import Clash.Sized.Vector import Clash.Signal.Delayed.Internal (DSignal(..), dfromList, dfromList_lazy, fromSignal, toSignal, unsafeFromSignal, antiDelay, feedback, forward) import Clash.Explicit.Signal (KnownDomain, Clock, Domain, Reset, Signal, Enable, register, delay, bundle, unbundle) import Clash.Promoted.Nat (SNat (..), snatToInteger) import Clash.XException (NFDataX) {- $setup >>> :set -XDataKinds >>> :set -XTypeOperators >>> 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 -> Enable System -> DSignal System 0 Int -> DSignal System 0 Int -> DSignal System 0 Int mac clk rst en x y = feedback (mac' x y) where mac' :: DSignal System 0 Int -> DSignal System 0 Int -> DSignal System 0 Int -> (DSignal System 0 Int, DSignal System 1 Int) mac' a b acc = let acc' = a * b + acc in (acc, delayed clk rst en (singleton 0) acc') :} -} -- TODO: Reimplement with dtfold -- | Delay a 'DSignal' for @d@ periods. -- -- @ -- delay3 -- :: KnownDomain dom -- => Clock dom -- -> Reset dom -- -> Enable dom -- -> 'DSignal' dom n Int -- -> 'DSignal' dom (n + 3) Int -- delay3 clk rst en = 'delayed' clk rst en (-1 ':>' -1 ':>' -1 ':>' 'Nil') -- @ -- -- >>> sampleN 7 (delay3 systemClockGen resetGen enableGen (dfromList [0..])) -- [-1,-1,-1,-1,1,2,3] delayed :: forall dom a n d . ( KnownDomain dom , KnownNat d , NFDataX a ) => Clock dom -> Reset dom -> Enable dom -> Vec d a -- ^ Initial values -> DSignal dom n a -> DSignal dom (n + d) a delayed clk rst en m ds = coerce (delaySignal (coerce ds)) where delaySignal :: Signal dom a -> Signal dom a delaySignal s = case length m of 0 -> s _ -> let (r',o) = shiftInAt0 (unbundle r) (singleton s) r = register clk rst en m (bundle r') in head o -- | Delay a 'DSignal' for @d@ periods, where @d@ is derived from the -- context. -- -- @ -- delay2 -- :: KnownDomain dom -- => Clock dom -- -> Reset dom -- -> Enable dom -- -> Int -- -> 'DSignal' dom n Int -- -> 'DSignal' dom (n + 2) Int -- delay2 = 'delayedI' -- @ -- -- >>> sampleN 7 (delay2 systemClockGen resetGen enableGen (-1) (dfromList ([0..]))) -- [-1,-1,-1,1,2,3,4] -- -- @d@ can also be specified using type application: -- -- >>> :t delayedI @3 -- delayedI @3 -- :: ... => -- Clock dom -- -> Reset dom -- -> Enable dom -- -> a -- -> DSignal dom n a -- -> DSignal dom (n + 3) a delayedI :: ( KnownNat d , KnownDomain dom , NFDataX a ) => Clock dom -> Reset dom -> Enable dom -> a -- ^ Initial value -> 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 (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 (delayI2 (-1) enableGen systemClockGen (dfromList [1..])) -- [-1,-1,1,2,3,4] -- -- You can also use type application to do the same: -- -- >>> sampleN 6 (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 (delayedFold d1 (-1) (+) enableGen systemClockGen countingSignals) -- [-1,-2,0,4,8,12] -- -- >>> printX $ sampleN 8 (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) clash-prelude-1.8.1/src/Clash/Explicit/SimIO.hs0000644000000000000000000002742107346545000017366 0ustar0000000000000000{-| Copyright : (C) 2019, Google Inc., 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. I\/O actions that are translatable to HDL -} {-# LANGUAGE CPP #-} {-# 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) #if __GLASGOW_HASKELL__ < 900 import Data.Coerce #endif import Data.IORef import GHC.TypeLits #if MIN_VERSION_base(4,18,0) hiding (SNat) #endif 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. #if __GLASGOW_HASKELL__ >= 900 data SimIO a = SimIO {unSimIO :: !(IO a)} #else newtype SimIO a = SimIO {unSimIO :: IO a} #endif {-# ANN unSimIO hasBlackBox #-} instance Functor SimIO where fmap = fmapSimIO# fmapSimIO# :: (a -> b) -> SimIO a -> SimIO b fmapSimIO# f (SimIO m) = SimIO (fmap f m) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE fmapSimIO# #-} {-# ANN fmapSimIO# hasBlackBox #-} instance Applicative SimIO where pure = pureSimIO# (<*>) = apSimIO# pureSimIO# :: a -> SimIO a pureSimIO# a = SimIO (pure a) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE pureSimIO# #-} {-# ANN pureSimIO# hasBlackBox #-} apSimIO# :: SimIO (a -> b) -> SimIO a -> SimIO b apSimIO# (SimIO f) (SimIO m) = SimIO (f <*> m) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE apSimIO# #-} {-# ANN apSimIO# hasBlackBox #-} instance Monad SimIO where #if !MIN_VERSION_base(4,16,0) return = pureSimIO# #endif (>>=) = bindSimIO# bindSimIO# :: SimIO a -> (a -> SimIO b) -> SimIO b #if __GLASGOW_HASKELL__ >= 900 bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` unSimIO (k x))) #else bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` coerce k x)) #endif -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE bindSimIO# #-} {-# ANN bindSimIO# hasBlackBox #-} -- | Display a string on /stdout/ display :: String -- ^ String you want to display -> SimIO () display s = SimIO (putStrLn s) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE finish #-} {-# ANN finish hasBlackBox #-} -- | Mutable reference #if __GLASGOW_HASKELL__ >= 900 data Reg a = Reg !(IORef a) #else newtype Reg a = Reg (IORef a) #endif -- | Create a new mutable reference with the given starting value reg :: a -- ^ The starting value -> SimIO (Reg a) reg a = SimIO (Reg <$> newIORef a) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE reg #-} {-# ANN reg hasBlackBox #-} -- | Read value from a mutable reference readReg :: Reg a -> SimIO a readReg (Reg a) = SimIO (readIORef a) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE writeReg #-} {-# ANN writeReg hasBlackBox #-} -- | File handle #if __GLASGOW_HASKELL__ >= 900 data File = File !IO.Handle #else newtype File = File IO.Handle #endif -- | 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 #if __GLASGOW_HASKELL__ >= 900 openFile fp "r" = SimIO $ fmap File (IO.openFile fp IO.ReadMode) openFile fp "w" = SimIO $ fmap File (IO.openFile fp IO.WriteMode) openFile fp "a" = SimIO $ fmap File (IO.openFile fp IO.AppendMode) openFile fp "rb" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadMode) openFile fp "wb" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode) openFile fp "ab" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode) openFile fp "r+" = SimIO $ fmap File (IO.openFile fp IO.ReadWriteMode) openFile fp "w+" = SimIO $ fmap File (IO.openFile fp IO.WriteMode) openFile fp "a+" = SimIO $ fmap File (IO.openFile fp IO.AppendMode) openFile fp "r+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadWriteMode) openFile fp "w+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode) openFile fp "a+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode) openFile fp "rb+" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadWriteMode) openFile fp "wb+" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode) openFile fp "ab+" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode) #else 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) #endif openFile _ m = error ("openFile unknown mode: " ++ show m) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE openFile #-} {-# ANN openFile hasBlackBox #-} -- | Close a file closeFile :: File -> SimIO () closeFile (File fp) = SimIO (IO.hClose fp) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE tell #-} {-# ANN tell hasBlackBox #-} -- | Write any buffered output to file flush :: File -> SimIO () flush (File fp) = SimIO (IO.hFlush fp) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE mealyIO #-} clash-prelude-1.8.1/src/Clash/Explicit/Synchronizer.hs0000644000000000000000000001736607346545000021112 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2016-2019, Myrtle Software Ltd, 2017 , Google Inc., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Synchronizer circuits for safe clock domain crossings -} {-# LANGUAGE CPP #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Extra.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Explicit.Synchronizer ( -- * Bit-synchronizers dualFlipFlopSynchronizer -- * Word-synchronizers , asyncFIFOSynchronizer ) where import Data.Bits (complement, shiftR, xor) import Data.Constraint ((:-)(..), Dict (..)) import Data.Constraint.Nat (leTrans) import Data.Maybe (isJust) import GHC.TypeLits (type (+), type (-), type (<=), type (^), KnownNat) import Clash.Class.BitPack (boolToBV, unpack) import Clash.Class.Resize (truncateB) import Clash.Class.BitPack.BitIndex (slice) import Clash.Explicit.Mealy (mealyB) import Clash.Explicit.BlockRam (RamOp (..), trueDualPortBlockRam) import Clash.Explicit.Signal (Clock, Reset, Signal, Enable, register, unsafeSynchronizer, fromEnable, (.&&.), mux, KnownDomain) import Clash.Promoted.Nat (SNat (..)) import Clash.Promoted.Nat.Literals (d0) import Clash.Sized.BitVector (BitVector, (++#)) import Clash.XException (NFDataX, fromJustX) -- * Dual flip-flop synchronizer -- | Synchronizer based on two sequentially connected flip-flops. -- -- * __NB__: This synchronizer can be used for __bit__-synchronization. -- -- * __NB__: Although this synchronizer does reduce metastability, it does -- not guarantee the proper synchronization of a whole __word__. For -- example, given that the output is sampled twice as fast as the input is -- running, and we have two samples in the input stream that look like: -- -- @[0111,1000]@ -- -- But the circuit driving the input stream has a longer propagation delay -- on __msb__ compared to the __lsb__s. What can happen is an output stream -- that looks like this: -- -- @[0111,0111,0000,1000]@ -- -- Where the level-change of the __msb__ was not captured, but the level -- change of the __lsb__s were. -- -- If you want to have /safe/ __word__-synchronization use -- 'asyncFIFOSynchronizer'. dualFlipFlopSynchronizer :: ( NFDataX a , KnownDomain dom1 , KnownDomain dom2 ) => Clock dom1 -- ^ 'Clock' to which the incoming data is synchronized -> Clock dom2 -- ^ 'Clock' to which the outgoing data is synchronized -> Reset dom2 -- ^ 'Reset' for registers on the outgoing domain -> Enable dom2 -- ^ 'Enable' for registers on the outgoing domain -> a -- ^ Initial value of the two synchronization registers -> Signal dom1 a -- ^ Incoming data -> Signal dom2 a -- ^ Outgoing, synchronized, data dualFlipFlopSynchronizer clk1 clk2 rst en i = register clk2 rst en i . register clk2 rst en i . unsafeSynchronizer clk1 clk2 -- * Asynchronous FIFO synchronizer fifoMem :: forall wdom rdom a addrSize . ( KnownDomain wdom , KnownDomain rdom , NFDataX a , KnownNat addrSize , 1 <= addrSize ) => Clock wdom -> Clock rdom -> Enable wdom -> Enable rdom -> Signal wdom Bool -> Signal rdom (BitVector addrSize) -> Signal wdom (BitVector addrSize) -> Signal wdom (Maybe a) -> Signal rdom a fifoMem wclk rclk wen ren full raddr waddr wdataM = fst $ trueDualPortBlockRam rclk wclk portA portB where portA :: Signal rdom (RamOp (2 ^ addrSize) a) portA = mux (fromEnable ren) (RamRead . unpack <$> raddr) (pure RamNoOp) portB :: Signal wdom (RamOp (2 ^ addrSize) a) portB = mux (fromEnable wen .&&. fmap not full .&&. fmap isJust wdataM) (RamWrite <$> fmap unpack waddr <*> fmap fromJustX wdataM) (pure RamNoOp) readPtrCompareT :: KnownNat addrSize => ( BitVector (addrSize + 1) , BitVector (addrSize + 1) , Bool ) -> ( BitVector (addrSize + 1) , Bool ) -> ( ( BitVector (addrSize + 1) , BitVector (addrSize + 1) , Bool ) , ( Bool , BitVector addrSize , BitVector (addrSize + 1) ) ) readPtrCompareT (bin, ptr, flag) (s_ptr, inc) = ((bin', ptr', flag'), (flag, addr, ptr)) where -- GRAYSTYLE2 pointer bin' = bin + boolToBV (inc && not flag) ptr' = (bin' `shiftR` 1) `xor` bin' addr = truncateB bin' flag' = ptr' == s_ptr writePtrCompareT :: (2 <= addrSize) => SNat addrSize -> ( BitVector (addrSize + 1) , BitVector (addrSize + 1) , Bool ) -> ( BitVector (addrSize + 1) , Bool ) -> ( ( BitVector (addrSize + 1) , BitVector (addrSize + 1) , Bool ) , ( Bool , BitVector addrSize , BitVector (addrSize + 1) ) ) writePtrCompareT addrSize@SNat (bin, ptr, flag) (s_ptr, inc) = ((bin', ptr', flag'), (flag, addr, ptr)) where -- GRAYSTYLE2 pointer bin' = bin + boolToBV (inc && not flag) ptr' = (bin' `shiftR` 1) `xor` bin' addr = truncateB bin flag' = isFull addrSize ptr' s_ptr -- FIFO full: when next pntr == synchronized {~wptr[addrSize:addrSize-1],wptr[addrSize-2:0]} isFull :: forall addrSize . (2 <= addrSize) => SNat addrSize -> BitVector (addrSize + 1) -> BitVector (addrSize + 1) -> Bool isFull addrSize@SNat ptr s_ptr = case leTrans @1 @2 @addrSize of Sub Dict -> let a1 = SNat @(addrSize - 1) a2 = SNat @(addrSize - 2) in ptr == (complement (slice addrSize a1 s_ptr) ++# slice a2 d0 s_ptr) -- | Synchronizer implemented as a FIFO around a synchronous RAM. Based on the -- design described in "Clash.Tutorial#multiclock", which is itself based on the -- design described in . -- However, this FIFO uses a synchronous dual-ported RAM which, unlike those -- designs using RAM with an asynchronous read port, is nearly guaranteed to -- actually synthesize into one of the dual-ported RAMs found on most FPGAs. -- -- __NB__: This synchronizer can be used for __word__-synchronization. -- __NB__: This synchronizer will only work safely when you set up the proper -- bus skew and maximum delay constraints inside your synthesis tool for the -- clock domain crossings of the gray pointers. asyncFIFOSynchronizer :: ( KnownDomain wdom , KnownDomain rdom , 2 <= addrSize , NFDataX a ) => SNat addrSize -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ -- elements. -> Clock wdom -- ^ 'Clock' to which the write port is synchronized -> Clock rdom -- ^ 'Clock' to which the read port is synchronized -> Reset wdom -> Reset rdom -> Enable wdom -> Enable rdom -> Signal rdom Bool -- ^ Read request -> Signal wdom (Maybe a) -- ^ Element to insert -> (Signal rdom a, Signal rdom Bool, Signal wdom Bool) -- ^ (Oldest element in the FIFO, @empty@ flag, @full@ flag) asyncFIFOSynchronizer addrSize@SNat wclk rclk wrst rrst wen ren rinc wdataM = (rdata, rempty, wfull) where s_rptr = dualFlipFlopSynchronizer rclk wclk wrst wen 0 rptr s_wptr = dualFlipFlopSynchronizer wclk rclk rrst ren 0 wptr rdata = fifoMem wclk rclk wen ren wfull raddr waddr wdataM (rempty, raddr, rptr) = mealyB rclk rrst ren readPtrCompareT (0, 0, True) (s_wptr, rinc) (wfull, waddr, wptr) = mealyB wclk wrst wen (writePtrCompareT addrSize) (0, 0, False) (s_rptr, isJust <$> wdataM) clash-prelude-1.8.1/src/Clash/Explicit/Testbench.hs0000644000000000000000000003737407346545000020335 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017-2022, Google Inc. 2019 , Myrtle Software Ltd, 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-} module Clash.Explicit.Testbench ( -- * Testbench functions for circuits assert , assertBitVector , ignoreFor , stimuliGenerator , tbClockGen , tbEnableGen , tbSystemClockGen , clockToDiffClock , outputVerifier , outputVerifier' , outputVerifierBitVector , outputVerifierBitVector' , biTbClockGen , unsafeSimSynchronizer , outputVerifierWith ) where import Control.Exception (catch, evaluate) import Debug.Trace (trace) import GHC.TypeLits (KnownNat, type (+), type (<=)) import Prelude hiding ((!!), length) import System.IO.Unsafe (unsafeDupablePerformIO) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.Num (satSucc, SaturationMode(SatBound)) import Clash.Promoted.Nat (SNat(..)) import Clash.Promoted.Symbol (SSymbol(..)) import Clash.Explicit.Signal (Clock, Reset, System, Signal, toEnable, fromList, register, unbundle, unsafeSynchronizer) import Clash.Signal.Internal (ClockN (..), DiffClock (..), Reset (..), tbClockGen) import Clash.Signal (mux, KnownDomain, Enable) import Clash.Sized.Index (Index) import Clash.Sized.Internal.BitVector (BitVector, isLike#) import Clash.Sized.Vector (Vec, (!!), length) import Clash.XException (ShowX (..), XException) -- Note that outputVerifier' is used in $setup, while the examples mention -- outputVerifier. This is fine, as the examples have explicit type -- signatures, turning 'outputVerifier' into 'outputVerifier''. {- $setup >>> :set -XTemplateHaskell -XDataKinds -XTypeFamilies >>> import Clash.Explicit.Prelude >>> let testInput clk rst = stimuliGenerator clk rst $(listToVecTH [(1::Int),3..21]) >>> let expectedOutput clk rst = outputVerifier' clk rst $(listToVecTH ([70,99,2,3,4,5,7,8,9,10]::[Int])) -} -- | Compares the first two 'Signal's for equality and logs a warning when they -- are not equal. The second 'Signal' is considered the expected value. This -- function simply returns the third 'Signal' unaltered as its result. This -- function is used by 'outputVerifier'. -- -- === Usage in @clashi@ #assert-clashi# -- -- __NB__: When simulating a component that uses 'assert' in @clashi@, usually, -- the warnings are only logged the first time the component is simulated. -- Issuing @:reload@ in @clashi@ will discard the cached result of the -- computation, and warnings will once again be emitted. -- -- __NB__: This function /can/ be used in synthesizable designs. assert :: (KnownDomain dom, Eq a, ShowX a) => Clock dom -> Reset dom -> String -- ^ Additional message -> Signal dom a -- ^ Checked value -> Signal dom a -- ^ Expected value -> Signal dom b -- ^ Return value -> Signal dom b assert clk (Reset _) msg checked expected returned = (\c e cnt r -> if eqX c e then r else trace (concat [ "\ncycle(" ++ show clk ++ "): " , show cnt , ", " , msg , "\nexpected value: " , showX e , ", not equal to actual value: " , showX c ]) r) <$> checked <*> expected <*> fromList [(0::Integer)..] <*> returned where eqX a b = unsafeDupablePerformIO (catch (evaluate (a == b)) (\(_ :: XException) -> return False)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE assert #-} {-# ANN assert hasBlackBox #-} -- | The same as 'assert', but can handle don't care bits in its expected value. assertBitVector :: (KnownDomain dom, KnownNat n) => Clock dom -> Reset 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 clk (Reset _) msg checked expected returned = (\c e cnt r -> if eqX c e then r else trace (concat [ "\ncycle(" ++ show clk ++ "): " , show cnt , ", " , msg , "\nexpected value: " , showX e , ", not equal to actual value: " , showX c ]) r) <$> checked <*> expected <*> fromList [(0::Integer)..] <*> returned where eqX a b = unsafeDupablePerformIO (catch (evaluate (a `isLike#` b)) (\(_ :: XException) -> return False)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE assertBitVector #-} {-# ANN assertBitVector hasBlackBox #-} -- | -- -- Example: -- -- @ -- testInput -- :: KnownDomain dom -- => Clock dom -- -> Reset dom -- -> 'Signal' dom Int -- testInput clk rst = 'stimuliGenerator' clk rst $('Clash.Sized.Vector.listToVecTH' [(1::Int),3..21]) -- @ -- -- >>> sampleN 14 (testInput systemClockGen resetGen) -- [1,1,3,5,7,9,11,13,15,17,19,21,21,21] stimuliGenerator :: forall l dom a . ( KnownNat l , KnownDomain dom ) => Clock dom -- ^ Clock to which to synchronize the output signal -> Reset dom -> Vec l a -- ^ Samples to generate -> Signal dom a -- ^ Signal of given samples stimuliGenerator clk rst samples = let (r,o) = unbundle (genT <$> register clk rst (toEnable (pure True)) 0 r) in o where genT :: Index l -> (Index l,a) genT s = (s',samples !! s) where maxI = toEnum (length samples - 1) s' = if s < maxI then s + 1 else s {-# INLINABLE stimuliGenerator #-} -- | Same as 'outputVerifier' but used in cases where the test bench domain and -- the domain of the circuit under test are the same. outputVerifier' :: forall l a dom . ( KnownNat l , KnownDomain dom , Eq a , ShowX a , 1 <= l ) => Clock dom -- ^ Clock to which the test bench is synchronized -> Reset dom -- ^ Reset line of test bench -> Vec l a -- ^ Samples to compare with -> Signal dom a -- ^ Signal to verify -> Signal dom Bool -- ^ Indicator that all samples are verified outputVerifier' clk = outputVerifier @l @a clk clk {-# INLINE outputVerifier' #-} -- | Compare a signal (coming from a circuit) to a vector of samples. If a -- sample from the signal is not equal to the corresponding sample in the -- vector, print to stderr and continue testing. This function is -- synthesizable in the sense that HDL simulators will run it. If @testDom@ and -- @circuitDom@ refer to the same domain, it can also be synthesized into -- hardware. -- -- __NB__: This function uses 'assert'. When simulating this function in -- @clashi@, read the [note](#assert-clashi). -- -- Example: -- -- @ -- expectedOutput -- :: Clock dom -> Reset dom -- -> 'Signal' dom Int -> 'Signal' dom Bool -- expectedOutput clk rst = 'outputVerifier' clk rst $('Clash.Sized.Vector.listToVecTH' ([70,99,2,3,4,5,7,8,9,10]::[Int])) -- @ -- -- >>> import qualified Data.List as List -- >>> sampleN 12 (expectedOutput systemClockGen resetGen (fromList (0:[0..10] List.++ [10,10,10]))) -- -- cycle(): 0, outputVerifier -- expected value: 70, not equal to actual value: 0 -- [False -- cycle(): 1, outputVerifier -- expected value: 70, not equal to actual value: 0 -- ,False -- cycle(): 2, outputVerifier -- expected value: 99, not equal to actual value: 1 -- ,False,False,False,False,False -- cycle(): 7, outputVerifier -- expected value: 7, not equal to actual value: 6 -- ,False -- cycle(): 8, outputVerifier -- expected value: 8, not equal to actual value: 7 -- ,False -- cycle(): 9, outputVerifier -- expected value: 9, not equal to actual value: 8 -- ,False -- cycle(): 10, outputVerifier -- expected value: 10, not equal to actual value: 9 -- ,False,True] -- -- If you're working with 'BitVector's containing don't care bits you should -- use 'outputVerifierBitVector'. outputVerifier :: forall l a testDom circuitDom . ( KnownNat l , KnownDomain testDom , KnownDomain circuitDom , Eq a , ShowX a , 1 <= l ) => Clock testDom -- ^ Clock to which the test bench is synchronized (but not necessarily -- the circuit under test) -> Clock circuitDom -- ^ Clock to which the circuit under test is synchronized -> Reset testDom -- ^ Reset line of test bench -> Vec l a -- ^ Samples to compare with -> Signal circuitDom a -- ^ Signal to verify -> Signal testDom Bool -- ^ True if all samples are verified outputVerifier = outputVerifierWith (\clk rst -> assert clk rst "outputVerifier") {-# INLINE outputVerifier #-} -- | Same as 'outputVerifier'', but can handle don't care bits in its expected -- values. outputVerifierBitVector' :: forall l n dom . ( KnownNat l , KnownNat n , KnownDomain dom , 1 <= l ) => Clock dom -- ^ Clock to which the input signal is synchronized -> Reset dom -> Vec l (BitVector n) -- ^ Samples to compare with -> Signal dom (BitVector n) -- ^ Signal to verify -> Signal dom Bool -- ^ Indicator that all samples are verified outputVerifierBitVector' clk = outputVerifierBitVector @l @n clk clk {-# INLINE outputVerifierBitVector' #-} -- | Same as 'outputVerifier', but can handle don't care bits in its -- expected values. outputVerifierBitVector :: forall l n testDom circuitDom . ( KnownNat l , KnownNat n , KnownDomain testDom , KnownDomain circuitDom , 1 <= l ) => Clock testDom -- ^ Clock to which the test bench is synchronized (but not necessarily -- the circuit under test) -> Clock circuitDom -- ^ Clock to which the circuit under test is synchronized -> Reset testDom -- ^ Reset line of test bench -> Vec l (BitVector n) -- ^ Samples to compare with -> Signal circuitDom (BitVector n) -- ^ Signal to verify -> Signal testDom Bool -- ^ Indicator that all samples are verified outputVerifierBitVector = outputVerifierWith (\clk rst -> assertBitVector clk rst "outputVerifierBitVector") {-# INLINE outputVerifierBitVector #-} outputVerifierWith :: forall l a testDom circuitDom . ( KnownNat l , KnownDomain testDom , KnownDomain circuitDom , Eq a , ShowX a , 1 <= l ) => ( Clock testDom -> Reset testDom -> Signal testDom a -> Signal testDom a -> Signal testDom Bool -> Signal testDom Bool ) -- ^ The @assert@ function to use -> Clock testDom -- ^ Clock to which the test bench is synchronized (but not necessarily -- the circuit under test) -> Clock circuitDom -- ^ Clock to which the circuit under test is synchronized -> Reset testDom -- ^ Reset line of test bench -> Vec l a -- ^ Samples to compare with -> Signal circuitDom a -- ^ Signal to verify -> Signal testDom Bool -- ^ True if all samples are verified outputVerifierWith assertF clkTest clkCircuit rst samples i0 = let i1 = unsafeSimSynchronizer clkCircuit clkTest i0 en = toEnable (pure True) (s,o) = unbundle (genT <$> register clkTest rst en 0 s) (e,f) = unbundle o f' = register clkTest rst en False f -- Only assert while not finished in mux f' f' $ assertF clkTest rst i1 e f' where genT :: Index l -> (Index l,(a,Bool)) genT s = (s',(samples !! s,finished)) where s' = satSucc SatBound s finished = s == maxBound {-# INLINABLE outputVerifierWith #-} -- | Ignore signal for a number of cycles, while outputting a static value. ignoreFor :: forall dom n a . KnownDomain dom => Clock dom -> Reset dom -> Enable dom -> SNat n -- ^ Number of cycles to ignore incoming signal -> a -- ^ Value function produces when ignoring signal -> Signal dom a -- ^ Incoming signal -> Signal dom a -- ^ Either a passthrough of the incoming signal, or the static value -- provided as the second argument. ignoreFor clk rst en SNat a i = mux ((==) <$> counter <*> (pure maxBound)) i (pure a) where counter :: Signal dom (Index (n+1)) counter = register clk rst en 0 (satSucc SatBound <$> counter) -- | Same as 'tbClockGen', but returns two clocks on potentially different -- domains. To be used in situations where the test circuit potentially operates -- on a different clock than the device under test. biTbClockGen :: forall testDom circuitDom . ( KnownDomain testDom , KnownDomain circuitDom ) => Signal testDom Bool -> (Clock testDom, Clock circuitDom) biTbClockGen done = (testClk, circuitClk) where testClk = tbClockGen done circuitClk = tbClockGen (unsafeSynchronizer testClk circuitClk done) -- | Enable signal that's always enabled. Because it has a blackbox definition -- this enable signal is opaque to other blackboxes. It will therefore never -- be optimized away. tbEnableGen :: Enable tag tbEnableGen = toEnable (pure True) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE tbEnableGen #-} {-# ANN tbEnableGen hasBlackBox #-} -- | Clock generator for the 'System' clock domain. -- -- __NB__: Can be used in the /testBench/ function -- -- === __Example__ -- -- @ -- topEntity :: Vec 2 (Vec 3 (Unsigned 8)) -> Vec 6 (Unsigned 8) -- topEntity = concat -- -- testBench :: Signal System Bool -- testBench = done -- where -- testInput = pure ((1 :> 2 :> 3 :> Nil) :> (4 :> 5 :> 6 :> Nil) :> Nil) -- expectedOutput = outputVerifier' ((1:>2:>3:>4:>5:>6:>Nil):>Nil) -- done = exposeClockResetEnable (expectedOutput (topEntity <$> testInput)) clk rst -- clk = 'tbSystemClockGen' (not <\$\> done) -- rst = systemResetGen -- @ tbSystemClockGen :: Signal System Bool -> Clock System tbSystemClockGen = tbClockGen -- | Convert a single-ended clock to a differential clock -- -- The 'tbClockGen' function generates a single-ended clock. This function will -- output the two phases of a differential clock corresponding to that -- single-ended clock. -- -- This function is only meant to be used in the /testBench/ function, not to -- create a differential output in hardware. -- -- Example: -- -- @ -- clk = clockToDiffClock $ tbClockGen (not \<\$\> done) -- @ clockToDiffClock :: KnownDomain dom => -- | Single-ended input Clock dom -> -- | Differential output DiffClock dom clockToDiffClock clk = DiffClock clk (ClockN SSymbol) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE clockToDiffClock #-} {-# ANN clockToDiffClock hasBlackBox #-} -- | Cross clock domains in a way that is unsuitable for hardware but good -- enough for simulation. -- -- It's equal to 'unsafeSynchronizer' but will warn when used outside of a test -- bench. 'outputVerifier' uses this function when it needs to cross between -- clock domains, which will render it unsuitable for synthesis, but good enough -- for simulating the generated HDL. unsafeSimSynchronizer :: forall dom1 dom2 a . ( KnownDomain dom1 , KnownDomain dom2 ) => Clock dom1 -- ^ 'Clock' of the incoming signal -> Clock dom2 -- ^ 'Clock' of the outgoing signal -> Signal dom1 a -> Signal dom2 a unsafeSimSynchronizer = unsafeSynchronizer -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unsafeSimSynchronizer #-} {-# ANN unsafeSimSynchronizer hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Explicit/Verification.hs0000644000000000000000000002071007346545000021022 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd 2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Verification primitives for Clash. Currently implements PSL (Property Specification Language) and SVA (SystemVerilog Assertions). For a good overview of PSL and an introduction to the concepts of property checking, read . The verification API is currently experimental and subject to change. -} {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE QuasiQuotes #-} module Clash.Explicit.Verification ( -- * Types Assertion , Property , AssertionValue , RenderAs(..) -- * Bootstrapping functions , name , lit -- * Functions to build a PSL/SVA expressions , not , and , or , implies , next , nextN , before , timplies , timpliesOverlapping , always , never , eventually -- * Asserts , assert , cover , assume -- * Assertion checking , check , checkI -- * Functions to deal with assertion results , hideAssertion ) where import Prelude (Bool, Word, (.), pure, max, concat) import Data.Text (Text) import Data.Maybe (Maybe(Just)) import Data.String.Interpolate (__i) import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), HDL(..)) import Clash.Signal.Internal (KnownDomain, Signal, Clock, Reset) import Clash.XException (errorX, hwSeqX) import Clash.Verification.Internal -- | Convert a signal to a cv expression with a name hint. Clash will try its -- best to use this name in the rendered assertion, but might run into -- collisions. You can skip using 'name' altogether. Clash will then try its -- best to get a readable name from context. name :: Text -> Signal dom Bool -> Assertion dom name nm signal = Assertion IsNotTemporal (CvPure (Just nm, signal)) {-# INLINE name #-} -- | For using a literal (either True or False) in assertions lit :: Bool -> Assertion dom lit = Assertion IsNotTemporal . CvLit {-# INLINE lit #-} -- | Truth table for 'not': -- -- @ -- a | not a -- ------------ -- True | False -- False | True -- @ not :: AssertionValue dom a => a -> Assertion dom not (toAssertionValue -> a) = Assertion (isTemporal a) (CvNot (assertion a)) {-# INLINE not #-} -- | Truth table for 'and': -- -- @ -- a | b | a `and` b -- --------------|---------- -- False | False | False -- False | True | False -- True | False | False -- True | True | True -- @ and :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom and (toAssertionValue -> a) (toAssertionValue -> b) = Assertion (max (isTemporal a) (isTemporal b)) (CvAnd (assertion a) (assertion b)) {-# INLINE and #-} -- | Truth table for 'or': -- -- @ -- a | b | a `or` b -- --------------|--------- -- False | False | False -- False | True | True -- True | False | True -- True | True | True -- @ or :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom or (toAssertionValue -> a) (toAssertionValue -> b) = Assertion (max (isTemporal a) (isTemporal b)) (CvOr (assertion a) (assertion b)) {-# INLINE or #-} -- | -- Truth table for 'implies': -- -- @ -- a | b | a `implies` b -- --------------|-------------- -- False | False | True -- False | True | True -- True | False | False -- True | True | True -- @ implies :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom implies (toAssertionValue -> Assertion aTmp a) (toAssertionValue -> Assertion bTmp b) = Assertion (max aTmp bTmp) (CvImplies a b) {-# INLINE implies #-} -- | Truth table for 'next': -- -- @ -- a[n] | a[n+1] | a `implies` next a -- ---------------|------------------- -- False | False | True -- False | True | True -- True | False | False -- True | True | True -- @ -- -- where a[n] represents the value of @a@ at cycle @n@ and @a[n+1]@ represents -- the value of @a@ at cycle @n+1@. Cycle n is an arbitrary cycle. next :: AssertionValue dom a => a -> Assertion dom next = nextN 1 {-# INLINE next #-} -- | Truth table for 'nextN': -- -- @ -- a[n] | a[n+m] | a `implies` next m a -- ---------------|--------------------- -- False | False | True -- False | True | True -- True | False | False -- True | True | True -- @ -- -- where a[n] represents the value of @a@ at cycle @n@ and a[n+m] represents -- the value of @a@ at cycle @n+m@. Cycle n is an arbitrary cycle. nextN :: AssertionValue dom a => Word -> a -> Assertion dom nextN n = Assertion IsTemporal . CvNext n . assertion . toAssertionValue {-# INLINE nextN #-} -- | Same as @a && next b@ but with a nice syntax. E.g., @a && next b@ could -- be written as @a `before` b@. Might be read as "a happens one cycle before b". before :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom before a0 b0 = Assertion IsTemporal (CvBefore a1 b1) where a1 = assertion (toAssertionValue a0) b1 = assertion (toAssertionValue b0) {-# INLINE before #-} -- | Same as @a `implies` next b@ but with a nice syntax. E.g., -- @a `implies` next b@ could be written as @a `timplies` b@. Might be read -- as "a at cycle n implies b at cycle n+1". timplies :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom timplies a0 b0 = Assertion IsTemporal (CvTemporalImplies 1 a1 b1) where a1 = toTemporal (toAssertionValue a0) b1 = toTemporal (toAssertionValue b0) {-# INLINE timplies #-} -- | Same as 'implies' but strictly temporal. timpliesOverlapping :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom timpliesOverlapping a0 b0 = Assertion IsTemporal (CvTemporalImplies 0 a1 b1) where a1 = toTemporal (toAssertionValue a0) b1 = toTemporal (toAssertionValue b0) {-# INLINE timpliesOverlapping #-} -- | Specify assertion should _always_ hold always :: AssertionValue dom a => a -> Assertion dom always = Assertion IsTemporal . CvAlways . assertion . toAssertionValue {-# INLINE always #-} -- | Specify assertion should _never_ hold (not supported by SVA) never :: AssertionValue dom a => a -> Assertion dom never = Assertion IsTemporal . CvNever . assertion . toAssertionValue {-# INLINE never #-} -- | Specify assertion should _eventually_ hold eventually :: AssertionValue dom a => a -> Assertion dom eventually = Assertion IsTemporal . CvEventually . assertion . toAssertionValue {-# INLINE eventually #-} -- | Check whether given assertion always holds. Results can be collected with -- 'check'. assert :: AssertionValue dom a => a -> Property dom assert = Property . CvAssert . assertion . toAssertionValue {-# INLINE assert #-} -- | Check whether given assertion holds for at least a single cycle. Results -- can be collected with 'check'. cover :: AssertionValue dom a => a -> Property dom cover = Property . CvCover . assertion . toAssertionValue {-# INLINE cover #-} -- | Inform the prover that this property is true. This is the same as 'assert' -- for simulations. assume :: AssertionValue dom a => a -> Property dom assume = Property . CvAssume . assertion . toAssertionValue {-# INLINE assume #-} -- | Print property as PSL/SVA in HDL. Clash simulation support not yet -- implemented. check :: KnownDomain dom => Clock dom -> Reset dom -> Text -- ^ Property name (used in reports and error messages) -> RenderAs -- ^ Assertion language to use in HDL -> Property dom -> Signal dom AssertionResult check !_clk !_rst !_propName !_renderAs !_prop = pure (errorX (concat [ "Simulation for Clash.Verification not yet implemented. If you need this," , " create an issue at https://github.com/clash-compiler/clash-lang/issues." ])) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE check #-} {-# ANN check (InlineYamlPrimitive [Verilog, SystemVerilog, VHDL] [__i| BlackBoxHaskell: name: Clash.Explicit.Verification.check templateFunction: Clash.Primitives.Verification.checkBBF |]) #-} -- | Same as 'check', but doesn't require a design to explicitly carried to -- top-level. checkI :: KnownDomain dom => Clock dom -> Reset dom -> Text -- ^ Property name (used in reports and error messages) -> RenderAs -- ^ Assertion language to use in HDL -> Property dom -> Signal dom a -> Signal dom a checkI clk rst propName renderAs prop = hideAssertion (check clk rst propName renderAs prop) -- | Print assertions in HDL hideAssertion :: Signal dom AssertionResult -> Signal dom a -> Signal dom a hideAssertion = hwSeqX clash-prelude-1.8.1/src/Clash/HaskellPrelude.hs0000644000000000000000000000433707346545000017532 0ustar0000000000000000{-| Copyright : (C) 2019, QBayLogic B.V. (C) 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V "Clash.HaskellPrelude" re-exports most of the Haskell "Prelude" with the exception of those functions that the Clash API defines to work on 'Clash.Sized.Vector.Vec' from "Clash.Sized.Vector" instead of on lists as the Haskell Prelude does. In addition, for the 'Clash.Class.Parity.odd' and 'Clash.Class.Parity.even' functions a type class called 'Clash.Class.Parity.Parity' is available at "Clash.Class.Parity". -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} module Clash.HaskellPrelude (module Prelude, (&&), (||), not) where import Prelude hiding ((++), (!!), concat, concatMap, drop, even, foldl, foldl1, foldr, foldr1, head, init, iterate, last, length, map, odd, repeat, replicate, reverse, scanl, scanl1, scanr, scanr1, splitAt, tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3, undefined, (^), getChar, putChar, getLine, (&&), (||), not, maximum, minimum) import qualified Prelude import GHC.Magic (noinline) {- Note [use of noinline] ~~~~~~~~~~~~~~~~~~~~~~ The magic noinline function is used here to prevent GHC inlining these functions in the simplifier. They are removed (by GHC) post-simplifier, so they have no negative impact on Clash's normalization. Why prevent this inlining? When GHC sees a function like topEntity :: Bool -> Bool -> Bool topEntity a b = a && b it inlines the definition of && to become topEntity a b = case a of True -> case b of True -> True False -> False False -> False which Clash will render as multiplexer(s) instead of using the and operator available in the targeted HDL backend. While this has no impact on the quality of the final result (EDA tools will optimize this with ease in P&R), it makes the generated HDL (and RTL view of circuits) more obfuscated to read. -} infixr 3 && (&&) :: Bool -> Bool -> Bool (&&) = noinline (Prelude.&&) infixr 2 || (||) :: Bool -> Bool -> Bool (||) = noinline (Prelude.||) not :: Bool -> Bool not = noinline Prelude.not clash-prelude-1.8.1/src/Clash/Hidden.hs0000644000000000000000000000440607346545000016016 0ustar0000000000000000{-| Copyright : (C) 2018 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Hidden arguments -} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} module Clash.Hidden ( Hidden , expose -- * OverloadedLabels , fromLabel ) where import qualified GHC.Classes import GHC.TypeLits import Unsafe.Coerce -- | A value reflected to, or /hiding/ at, the /Constraint/ level -- -- e.g. a function: -- -- @ -- f :: Hidden "foo" Int -- => Bool -- -> Int -- f = ... -- @ -- -- has a /normal/ argument of type @Bool@, and a /hidden/ argument called \"foo\" -- of type @Int@. In order to apply the @Int@ argument we have to use the -- 'expose' function, so that the /hidden/ argument becomes a normal argument -- again. -- -- === __Original implementation__ -- -- 'Hidden' used to be implemented by: -- -- @ -- class Hidden (x :: Symbol) a | x -> a where -- hidden :: a -- @ -- -- which is equivalent to /IP/, except that /IP/ has magic inference rules -- bestowed by GHC so that there's never any ambiguity. We need these magic -- inference rules so we don't end up in type inference absurdity where asking -- for the type of an type-annotated value results in a /no-instance-in-scope/ -- error. type Hidden (x :: Symbol) a = GHC.Classes.IP x a newtype Secret x a r = Secret (Hidden x a => r) -- | Expose a 'Hidden' argument so that it can be applied normally, e.g. -- -- @ -- f :: Hidden "foo" Int -- => Bool -- -> Int -- f = ... -- -- g :: Int -> Bool -> Int -- g = 'expose' \@\"foo" f -- @ expose :: forall x a r . (Hidden x a => r) -- ^ Function with a 'Hidden' argument -> (a -> r) -- ^ Function with the 'Hidden' argument exposed expose k = unsafeCoerce (Secret @x @a @r k) {-# INLINE expose #-} -- | Using /-XOverloadedLabels/ and /-XRebindableSyntax/, we can turn any -- value into a /hidden/ argument using the @#foo@ notation, e.g.: -- -- @ -- f :: Int -> Bool -> Int -- f = ... -- -- g :: Hidden "foo" Bool -- => Int -> Int -- g i = f i #foo -- @ fromLabel :: forall x a . Hidden x a => a fromLabel = GHC.Classes.ip @x {-# INLINE fromLabel #-} clash-prelude-1.8.1/src/Clash/Intel/0000755000000000000000000000000007346545000015336 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Intel/ClockGen.hs0000644000000000000000000004453207346545000017367 0ustar0000000000000000{-| Copyright : (C) 2017-2018, Google Inc 2019 , Myrtle Software 2022-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. This module contains functions for instantiating clock generators on Intel FPGA's. We suggest you use a clock generator even if your oscillator runs at the frequency you want to run your circuit at. A clock generator generates a stable clock signal for your design at a configurable frequency. A clock generator in an FPGA is frequently referred to as a PLL (Phase-Locked Loop). Intel also refers to them as PLL's in general but because this is not consistently the case among FPGA vendors, we choose the more generic term /clock generator/. For most use cases, you would create two or more synthesis domains describing the oscillator input and the domains you wish to use in your design, and use the [regular functions](#g:regular) below to generate the clocks and resets of the design from the oscillator input. There are use cases not covered by this simpler approach, and the [unsafe functions](#g:unsafe) are provided as a means to build advanced reset managers for the output domains. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module Clash.Intel.ClockGen ( -- * Choosing domains -- $domains -- ** Caution: actual output frequency -- $caution -- * Using -- $using -- ** Example -- $example -- ** Type checking errors -- $error -- * Regular functions #regular# altpllSync , alteraPllSync -- * Unsafe functions #unsafe# -- $unsafe -- ** Example -- $unsafe_example , unsafeAltpll , unsafeAlteraPll -- * Deprecated , altpll , alteraPll ) where import GHC.TypeLits (type (<=)) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Clocks (Clocks(..), ClocksSync(..), ClocksSyncCxt, NumOutClocksSync) import Clash.Magic (setName) import Clash.Promoted.Symbol (SSymbol) import Clash.Signal.Internal (Signal, Clock, Reset, KnownDomain, HasAsynchronousReset) {- $domains Synthesis domains are denoted by the type-parameter @dom :: t'Clash.Signal.Domain'@ as occurring in for instance @t'Clash.Signal.Signal' dom a@; see "Clash.Signal" for more information. For each domain, there is only a single clock signal which clocks that domain; mixing clock signals is a design error. Conversely, it is possible to clock multiple domains using the same clock signal, in complex designs. For the clock generator inputs, create a domain with the correct clock frequency and reset polarity. For instance, if the clock input is a free-running clock at a frequency of 50 MHz (a period of 20 ns or 20,000 ps), and the reset input connected to the clock generator is /active-low/, the following will instantiate the required input domain: @ 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"DomInput\", vPeriod=20000, vResetPolarity='Clash.Signal.ActiveLow'} @ If you haven't determined the frequency you want the design to run at, the predefined 100 MHz domain t'Clash.Signal.System' can be a good starting point. The datasheet for your FPGA specifies lower and upper limits, but the true maximum frequency is determined by your design. Supposing you need a clock running at 150 MHz for your design, the following will instantiate a suitable domain: @ 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"Dom150\", vPeriod='Clash.Signal.hzToPeriod' 150e6} @ As the clock generator always reacts asynchronously to its reset input, it will require that the @DomInput@ domain has asynchronous resets. The /unsafe/ functions below do not enforce this requirement on the domain (but they still react asynchronously). -} {- $caution The clock generator in the FPGA is limited in which clock frequencies it can generate, especially when one clock generator has multiple outputs. The clock generator will pick the attainable frequency closest to the requested frequency (or possibly fail to synthesize). You can check the frequency that the IP core chose by loading your design into the Quartus GUI. In the /Project Navigator/, choose the /Hierarchy/ view and find your clock generator instance. Double-click the instance to open Platform Designer and choose /Edit/ /Parameters.../. In the /Output Clocks/ page, the relevant column is /Actual/ /Settings/. If the actual value differs, copy the actual value back to the Clash design. -} {- $using The functions in this module will instantiate an Intel IP core for a clock generator with 1 reference clock input and a reset input, and one or more output clocks and a @locked@ output. The [regular functions](#g:regular) incorporate 'Clash.Signal.resetSynchronizer' to convert the @locked@ output port into a proper 'Reset' signal for the domains which will keep the circuit in reset while the clock is still stabilizing. The clock generator will react asynchronously to the incoming reset input. When the reset input is asserted, the clock generator's @locked@ output will deassert, in turn causing the 'Reset' output(s) of these functions to assert. You can use 'Clash.Magic.setName' to give the IP instance a specific name, which can be useful if you need to refer to the instance in Synopsys Design Constraints files. The output of the function for /n/ output clocks is a /2n/-tuple with clock and reset outputs. The compiler needs to be able to fully determine the types of the individual tuple elements from the context; the clock generator function itself will not constrain them. If the types of the tuple elements cannot be inferred, you can use pattern type signatures to specify the types. Supposing the referenced domains have been created with 'Clash.Signal.createDomain', an instance with a single output clock can be instantiated using: @ (clk150 :: 'Clock' Dom150, rst150 :: 'Reset' Dom150) = 'alteraPllSync' clkIn rstIn @ An instance with two clocks can be instantiated using @ ( clk100 :: 'Clock' Dom100 , rst100 :: 'Reset' Dom100 , clk150 :: 'Clock' Dom150 , rst150 :: 'Reset' Dom150) = 'alteraPllSync' clkIn rstIn @ and so on up to 18 clocks, following the general pattern @('Clock' dom1, 'Reset' dom1, 'Clock' dom2, 'Reset' dom2, ..., 'Clock' dom/n/, 'Reset' dom/n/)@. These examples show 'alteraPllSync' but it is the same for 'altpllSync' except that it supports up to 5 clocks. If you need access to the @locked@ output to build a more advanced reset manager, you should use the [unsafe functions](#g:unsafe) instead. -} {- $example When the oscillator connected to the FPGA runs at 50 MHz and the external reset signal is /active-low/, this will generate a 150 MHz clock for use by the circuit: @ 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"DomInput\", vPeriod=20000, vResetPolarity='Clash.Signal.ActiveLow'} 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"Dom150\", vPeriod='Clash.Signal.hzToPeriod' 150e6} topEntity :: 'Clock' DomInput -> 'Reset' DomInput -> t'Clash.Signal.Signal' Dom150 Int -> t'Clash.Signal.Signal' Dom150 Int topEntity clkIn rstIn = 'Clash.Signal.exposeClockResetEnable' (register 0) clk rst 'Clash.Signal.enableGen' where (clk, rst) = 'alteraPllSync' clkIn rstIn @ -} {- $error When type checking cannot infer the types of the tuple elements, or they have the wrong type, the GHC compiler will complain about satisfying @NumOutClocks@. The error message on GHC 9.4 and up is: @ • Cannot satisfy: clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst ([...]) DomInput) <= 18 • In the expression: alteraPllSync clkIn rstIn @ On older GHC versions, the error message is: @ • Couldn't match type ‘clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst ([...]) DomInput) <=? 18’ with ‘'True’ arising from a use of ‘alteraPllSync’ • In the expression: alteraPllSync clkIn rstIn @ The above error message is also emitted when trying to instantiate more than 18 output clocks, as it will fail to find an instance. As 'altpllSync' supports no more than 5 clocks, trying to instantiate between 6 and 18 output clocks will also cause a type checking error. On GHC 9.4 and up, the error for attempting to instantiate 6 clocks is: @ • Cannot satisfy: 6 <= 5 • In the expression: altpllSync clkIn rstIn @ On older GHC versions, the error message is less clear: @ • Couldn't match type ‘'False’ with ‘'True’ arising from a use of ‘altpllSync’ • In the expression: altpllSync clkIn rstIn @ -} {- $unsafe These functions are provided for the cases where the [regular functions](#g:regular) cannot provide the desired behavior, like when implementing certain advanced reset managers. These functions directly expose the /asynchronous/ @locked@ output of the clock generator, which will assert when the output clocks are stable. @locked@ is usually connected to reset circuitry to keep the circuit in reset while the clock is still stabilizing. The output of the function for /n/ output clocks is an /n+1/-tuple with /n/ clock outputs and a @locked@ signal. The compiler needs to be able to fully determine the types of the individual tuple elements from the context; the clock generator function itself will not constrain them. If the types of the tuple elements cannot be inferred, you can use pattern type signatures to specify the types. Supposing the referenced domains have been created with 'Clash.Signal.createDomain', an instance with a single output clock can be instantiated using: @ (clk150 :: 'Clock' Dom150, locked :: t'Clash.Signal.Signal' Dom150 'Bool') = 'unsafeAlteraPll' clkIn rstIn @ An instance with two clocks can be instantiated using @ (clk100 :: 'Clock' Dom100 , clk150 :: 'Clock' Dom150 , locked :: t'Clash.Signal.Signal' Dom100 'Bool') = 'unsafeAlteraPll' clkIn rstIn @ and so on up to 18 clocks, following the general pattern @('Clock' dom1, 'Clock' dom2, ..., 'Clock' dom/n/, t'Clash.Signal.Signal' pllLock Bool)@. These examples show 'unsafeAlteraPll' but it is the same for 'unsafeAltpll' except that it supports up to 5 clocks. Though the @locked@ output is specified as a @t'Clash.Signal.Signal' pllLock 'Bool'@, it is an asynchronous signal and will need to be synchronized before it can be used as a (reset) signal. While in the examples above the @locked@ output has been assigned the domain of one of the output clocks, the domain @pllLock@ is left unrestricted. If the lock signal is to be used in multiple domains, the @pllLock@ domain should probably be set to @domIn@ (the domain of the input clock and reset). While in HDL 'Clash.Explicit.Signal.unsafeSynchronizer' is just a wire, in Haskell simulation it does actually resample the signal, and by setting @pllLock@ to @domIn@, there is no resampling of the simulated lock signal. The simulated lock signal is simply the inverse of the reset input: @locked@ is asserted whenever the reset input is deasserted and vice versa. -} {- $unsafe_example @ 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"DomInput\", vPeriod=20000, vResetPolarity='Clash.Signal.ActiveLow'} 'Clash.Signal.createDomain' 'Clash.Signal.vSystem'{vName=\"Dom150\", vPeriod='Clash.Signal.hzToPeriod' 150e6} topEntity :: 'Clock' DomInput -> 'Reset' DomInput -> t'Clash.Signal.Signal' Dom150 Int -> t'Clash.Signal.Signal' Dom150 Int topEntity clkIn rstIn = 'Clash.Signal.exposeClockResetEnable' (register 0) clk rst 'Clash.Signal.enableGen' where (clk, locked) = 'unsafeAlteraPll' clkIn rstIn rst = 'Clash.Signal.resetSynchronizer' clk ('Clash.Signal.unsafeFromActiveLow' locked) @ 'Clash.Signal.resetSynchronizer' will keep the reset asserted when @locked@ is 'False', hence the use of @'Clash.Signal.unsafeFromActiveLow' locked@. -} -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"ALTPLL\" IP core (Arria GX, Arria II, Stratix IV, Stratix III, Stratix II, -- Stratix, Cyclone 10 LP, Cyclone IV, Cyclone III, Cyclone II, Cyclone) with 1 -- reference clock input and a reset input and 1 to 5 output clocks and a -- @locked@ output. -- -- This function incorporates 'Clash.Signal.resetSynchronizer's to convert the -- @locked@ output port into proper 'Reset' signals for the output domains which -- will keep the circuit in reset while the clock is still stabilizing. -- -- See also the [ALTPLL (Phase-Locked Loop) IP Core User Guide](https://www.intel.com/content/dam/www/programmable/us/en/pdfs/literature/ug/ug_altpll.pdf) altpllSync :: forall t domIn . ( HasAsynchronousReset domIn , ClocksSyncCxt t domIn , NumOutClocksSync t domIn <= 5 ) => -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> t altpllSync clkIn rstIn = clocksResetSynchronizer (unsafeAltpll clkIn rstIn) clkIn -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"ALTPLL\" IP core (Arria GX, Arria II, Stratix IV, Stratix III, Stratix II, -- Stratix, Cyclone 10 LP, Cyclone IV, Cyclone III, Cyclone II, Cyclone) with 1 -- reference clock input and a reset input and 1 output clock and a @locked@ -- output. -- -- This function is deprecated because the @locked@ output is an asynchronous -- signal. This means the user is required to add a synchronizer and as such -- this function is unsafe. The common use case is now covered by 'altpllSync' -- and 'unsafeAltpll' offers the functionality of this deprecated function for -- advanced use cases. altpll :: forall domOut domIn name . ( HasAsynchronousReset domIn , KnownDomain domOut ) => -- | Name of the component instance -- -- Instantiate as follows: @(SSymbol \@\"altpll50\")@ SSymbol name -> -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> -- | (Output clock, Clock generator locked) (Clock domOut, Signal domOut Bool) altpll _ = setName @name unsafeAltpll {-# INLINE altpll #-} {-# DEPRECATED altpll "This function is unsafe. Please see documentation of the function for alternatives." #-} -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"ALTPLL\" IP core (Arria GX, Arria II, Stratix IV, Stratix III, Stratix II, -- Stratix, Cyclone 10 LP, Cyclone IV, Cyclone III, Cyclone II, Cyclone) with 1 -- reference clock input and a reset input and 1 to 5 output clocks and a -- @locked@ output. -- -- __NB__: Because the clock generator reacts asynchronously to the incoming -- reset input, the signal __must__ be glitch-free. -- -- See also the [ALTPLL (Phase-Locked Loop) IP Core User Guide](https://www.intel.com/content/dam/www/programmable/us/en/pdfs/literature/ug/ug_altpll.pdf) unsafeAltpll :: forall t domIn . ( KnownDomain domIn , Clocks t , ClocksCxt t , NumOutClocks t <= 5 ) => -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> t unsafeAltpll = clocks -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unsafeAltpll #-} {-# ANN unsafeAltpll hasBlackBox #-} -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"Altera PLL\" IP core (Arria V, Stratix V, Cyclone V) with 1 reference clock -- input and a reset input and 1 to 18 output clocks and a @locked@ output. -- -- This function incorporates 'Clash.Signal.resetSynchronizer's to convert the -- @locked@ output port into proper 'Reset' signals for the output domains which -- will keep the circuit in reset while the clock is still stabilizing. -- -- See also the [Altera Phase-Locked Loop (Altera PLL) IP Core User Guide](https://www.intel.com/content/dam/www/programmable/us/en/pdfs/literature/ug/altera_pll.pdf) alteraPllSync :: forall t domIn . ( HasAsynchronousReset domIn , ClocksSyncCxt t domIn , NumOutClocksSync t domIn <= 18 ) => -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> t alteraPllSync clkIn rstIn = clocksResetSynchronizer (unsafeAlteraPll clkIn rstIn) clkIn -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"Altera PLL\" IP core (Arria V, Stratix V, Cyclone V) with 1 reference clock -- input and a reset input and 1 to 18 output clocks and a @locked@ output. -- -- This function is deprecated because the @locked@ output is an asynchronous -- signal. This means the user is required to add a synchronizer and as such -- this function is unsafe. The common use case is now covered by -- 'alteraPllSync' and 'unsafeAlteraPll' offers the functionality of this -- deprecated function for advanced use cases. alteraPll :: forall t domIn name . ( HasAsynchronousReset domIn , Clocks t , ClocksCxt t , NumOutClocks t <= 18 ) => -- | Name of the component instance -- -- Instantiate as follows: @(SSymbol \@\"alterapll50\")@ SSymbol name -> -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> t alteraPll _ = setName @name unsafeAlteraPll {-# INLINE alteraPll #-} {-# DEPRECATED alteraPll "This function is unsafe. Please see documentation of the function for alternatives." #-} -- | Instantiate an Intel clock generator corresponding to the Intel/Quartus -- \"Altera PLL\" IP core (Arria V, Stratix V, Cyclone V) with 1 reference clock -- input and a reset input and 1 to 18 output clocks and a @locked@ output. -- -- __NB__: Because the clock generator reacts asynchronously to the incoming -- reset input, the signal __must__ be glitch-free. -- -- See also the [Altera Phase-Locked Loop (Altera PLL) IP Core User Guide](https://www.intel.com/content/dam/www/programmable/us/en/pdfs/literature/ug/altera_pll.pdf) unsafeAlteraPll :: forall t domIn . ( KnownDomain domIn , Clocks t , ClocksCxt t , NumOutClocks t <= 18 ) => -- | Free running clock (e.g. a clock pin connected to a crystal oscillator) Clock domIn -> -- | Reset for the clock generator Reset domIn -> t unsafeAlteraPll = clocks -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unsafeAlteraPll #-} {-# ANN unsafeAlteraPll hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Intel/DDR.hs0000644000000000000000000000612107346545000016303 0ustar0000000000000000{-| Copyright : (C) 2017, Google Inc 2019, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij DDR primitives for Intel FPGAs using ALTDDIO primitives. For general information about DDR primitives see "Clash.Explicit.DDR". Note that a reset is only available on certain devices, see ALTDDIO userguide for the specifics: -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module Clash.Intel.DDR ( altddioIn , altddioOut ) where import GHC.Stack (HasCallStack, withFrozenCallStack) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.Prelude import Clash.Explicit.DDR -- | Intel specific variant of 'ddrIn' implemented using the ALTDDIO_IN IP core. -- -- Reset values are @0@ altddioIn :: ( HasCallStack , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) , KnownNat m ) => SSymbol deviceFamily -- ^ The FPGA family -- -- For example this can be instantiated as follows: -- -- > SSymbol @"Cyclone IV GX" -> Clock slow -- ^ clock -> Reset slow -- ^ reset -> Enable slow -- ^ Global enable -> Signal fast (BitVector m) -- ^ DDR input signal -> Signal slow (BitVector m,BitVector m) -- ^ normal speed output pairs altddioIn _devFam clk rst en = withFrozenCallStack ddrIn# clk rst en 0 0 0 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE altddioIn #-} {-# ANN altddioIn hasBlackBox #-} -- | Intel specific variant of 'ddrOut' implemented using the ALTDDIO_OUT IP core. -- -- Reset value is @0@ altddioOut :: ( HasCallStack , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) , KnownNat m ) => SSymbol deviceFamily -- ^ The FPGA family -- -- For example this can be instantiated as follows: -- -- > SSymbol @"Cyclone IV E" -> Clock slow -- ^ clock -> Reset slow -- ^ reset -> Enable slow -- ^ Global enable -> Signal slow (BitVector m,BitVector m) -- ^ normal speed input pair -> Signal fast (BitVector m) -- ^ DDR output signal altddioOut devFam clk rst en = uncurry (withFrozenCallStack altddioOut# devFam clk rst en) . unbundle altddioOut# :: ( HasCallStack , KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity) , KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity) , KnownNat m ) => SSymbol deviceFamily -> Clock slow -> Reset slow -> Enable slow -> Signal slow (BitVector m) -> Signal slow (BitVector m) -> Signal fast (BitVector m) altddioOut# _ clk rst en = ddrOut# clk rst en 0 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE altddioOut# #-} {-# ANN altddioOut# hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Magic.hs0000644000000000000000000002121107346545000015634 0ustar0000000000000000{-| Copyright : (C) 2019-2023, Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Control naming and deduplication in the generated HDL code. Explicitly nameable things include: * Component (VHDL) / module ((System)Verilog) instances * Registers * Terms Refer to "Clash.Annotations.TopEntity" for controlling naming of entities (VHDL) / modules ((System)Verilog) and their ports. -} {-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskellQuotes #-} module Clash.Magic ( -- ** Functions to control names of identifiers in HDL prefixName , suffixName , suffixNameP , suffixNameFromNat , suffixNameFromNatP , setName , nameHint -- ** Functions to control Clash's (de)duplication mechanisms , deDup , noDeDup -- ** Utilities to differentiate between simulation and generating HDL , clashSimulation , SimOnly (..) -- * Static assertions , clashCompileError ) where import Data.String.Interpolate (__i) import GHC.Stack (HasCallStack, withFrozenCallStack) import Clash.NamedTypes ((:::)) import GHC.TypeLits (Nat,Symbol) import Clash.Promoted.Symbol (SSymbol) import Clash.Annotations.Primitive (Primitive(..), hasBlackBox) -- | Prefix instance and register names with the given 'Symbol' prefixName :: forall (name :: Symbol) a . a -> name ::: a prefixName = id -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE prefixName #-} -- | Suffix instance and register names with the given 'Symbol' suffixName :: forall (name :: Symbol) a . a -> name ::: a suffixName = id -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE suffixName #-} -- | Suffix instance and register names with the given 'Nat' suffixNameFromNat :: forall (name :: Nat) a . a -> name ::: a suffixNameFromNat = id -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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 -- 'setName' and instances and registers that are auto-named. setName :: forall (name :: Symbol) a . a -> name ::: a setName = id -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE setName #-} -- | Name a given term, such as one of type 'Clash.Signal.Signal', using the -- given 'SSymbol'. Results in a declaration with the name used as the -- identifier in the generated HDL code. -- -- Example usage: -- -- @ -- nameHint (SSymbol @"identifier") term -- @ -- -- __NB__: The given name should be considered a hint as it may be expanded, -- e.g. if it collides with existing identifiers. nameHint :: SSymbol sym -- ^ A hint for a name -> a -> a nameHint = seq -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE nameHint #-} {-# ANN nameHint hasBlackBox #-} -- | 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 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE 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 -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE noDeDup #-} -- | 'True' in Haskell/Clash simulation. Replaced by 'False' when generating HDL. clashSimulation :: Bool clashSimulation = True -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE clashSimulation #-} -- | A container for data you only want to have around during simulation and -- is ignored during synthesis. Useful for carrying around things such as: -- -- * A map of simulation/vcd traces -- * Co-simulation state or meta-data -- * etc. data SimOnly a = SimOnly a deriving (Eq, Ord, Foldable, Traversable) {-# ANN SimOnly hasBlackBox #-} instance Functor SimOnly where fmap f (SimOnly a) = SimOnly (f a) instance Applicative SimOnly where pure = SimOnly (SimOnly f) <*> (SimOnly a) = SimOnly (f a) instance Monad SimOnly where (SimOnly a) >>= f = f a instance Semigroup a => Semigroup (SimOnly a) where (SimOnly a) <> (SimOnly b) = SimOnly (a <> b) instance Monoid a => Monoid (SimOnly a) where mempty = SimOnly mempty -- | Same as 'error' but will make HDL generation fail if included in the -- final circuit. -- -- This is useful for the error case of static assertions. -- -- Note that the error message needs to be a literal, and during HDL generation -- the error message does not include a stack trace, so it had better be -- descriptive. clashCompileError :: forall a . HasCallStack => String -> a clashCompileError msg = withFrozenCallStack $ error msg -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE clashCompileError #-} {-# ANN clashCompileError ( let primName = 'clashCompileError in InlineYamlPrimitive [minBound..] [__i| BlackBoxHaskell: name: #{primName} templateFunction: Clash.Primitives.Magic.clashCompileErrorBBF |]) #-} clash-prelude-1.8.1/src/Clash/NamedTypes.hs0000644000000000000000000000321607346545000016672 0ustar0000000000000000{- | Copyright : (C) 2017, Myrtle Software Ltd, QBayLogic, Google Inc. License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Add inline documentation to types: @ fifo :: Clock dom -> Reset dom -> SNat addrSize -> "read request" ::: Signal dom Bool -> "write request" ::: Signal dom (Maybe (BitVector dataSize)) -> ( "q" ::: Signal dom (BitVector dataSize) , "full" ::: Signal dom Bool , "empty" ::: Signal dom Bool ) @ which can subsequently be inspected in the interactive environment: >>> import Clash.Explicit.Prelude >>> :t fifo @System fifo @System :: Clock System -> Reset System -> SNat addrSize -> ("read request" ::: Signal System Bool) -> ("write request" ::: Signal System (Maybe (BitVector dataSize))) -> ("q" ::: Signal System (BitVector dataSize), "full" ::: Signal System Bool, "empty" ::: Signal System Bool) -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.NamedTypes ((:::)) where type (name :: k) ::: a = a -- ^ Annotate a type with a name {- $setup >>> :set -XDataKinds -XTypeOperators -XNoImplicitPrelude >>> import Clash.Explicit.Prelude >>> :{ let fifo :: Clock dom -> Reset dom -> SNat addrSize -> "read request" ::: Signal dom Bool -> "write request" ::: Signal dom (Maybe (BitVector dataSize)) -> ( "q" ::: Signal dom (BitVector dataSize) , "full" ::: Signal dom Bool , "empty" ::: Signal dom Bool ) fifo = Clash.Explicit.Prelude.undefined :} -} clash-prelude-1.8.1/src/Clash/Num/0000755000000000000000000000000007346545000015022 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Num/Erroring.hs0000644000000000000000000001104307346545000017144 0ustar0000000000000000{- Copyright : (C) 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Clash.Num.Erroring ( Erroring , fromErroring -- exported here because haddock https://github.com/haskell/haddock/issues/456 , toErroring ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Bits (Bits, FiniteBits) import Data.Coerce (coerce) import Data.Functor.Compose (Compose(..)) import Data.Hashable (Hashable) import GHC.TypeLits (KnownNat, type (+)) import Test.QuickCheck (Arbitrary) import Clash.Class.BitPack (BitPack) import Clash.Class.Num (SaturationMode(SatError), SaturatingNum(..)) import Clash.Class.Parity (Parity) import Clash.Class.Resize (Resize(..)) import Clash.XException (NFDataX, ShowX, errorX) -- | An erroring number type is one where all operations return a -- 'Clash.XException.XExecption' if they would go out of bounds for the -- underlying type. -- -- Numbers can be converted to error by default using 'toErroring'. -- newtype Erroring a = Erroring { fromErroring :: a } deriving newtype ( Arbitrary , Binary , Bits , BitPack , Bounded , Eq , FiniteBits , Hashable , NFData , NFDataX , Ord , Parity , Show , ShowX ) {-# INLINE toErroring #-} toErroring :: (SaturatingNum a) => a -> Erroring a toErroring = Erroring instance (Resize f) => Resize (Compose Erroring f) where {-# INLINE resize #-} resize :: forall a b . (KnownNat a, KnownNat b) => Compose Erroring f a -> Compose Erroring f b resize = coerce (resize @f @a @b) {-# INLINE zeroExtend #-} zeroExtend :: forall a b . (KnownNat a, KnownNat b) => Compose Erroring f a -> Compose Erroring f (b + a) zeroExtend = coerce (zeroExtend @f @a @b) {-# INLINE truncateB #-} truncateB :: forall a b . (KnownNat a) => Compose Erroring f (a + b) -> Compose Erroring f a truncateB = coerce (truncateB @f @a @b) instance (Bounded a, Ord a, SaturatingNum a) => Num (Erroring a) where {-# INLINE (+) #-} (+) = coerce (satAdd @a SatError) {-# INLINE (-) #-} (-) = coerce (satSub @a SatError) {-# INLINE (*) #-} (*) = coerce (satMul @a SatError) negate x | 0 == x = x | 0 <= minBound @a = errorX "Erroring.negate: result exceeds minBound" | x == minBound = errorX "Erroring.negate: result exceeds maxBound" | otherwise = coerce (negate @a) x abs x | x == minBound && x < 0 = errorX "Erroring.abs: result exceeds maxBound" | otherwise = coerce (abs @a) x {-# INLINE signum #-} signum = coerce (signum @a) {-# INLINE fromInteger #-} -- TODO This does what the underlying representation does if the Integer -- is not in range (typically wrapping). It would be better if this also -- threw an XException, but in a way which remained synthesizable. fromInteger = coerce (fromInteger @a) instance (Enum a, SaturatingNum a) => Enum (Erroring a) where {-# INLINE succ #-} succ = coerce (satSucc @a SatError) {-# INLINE pred #-} pred = coerce (satPred @a SatError) {-# INLINE toEnum #-} toEnum = coerce (toEnum @a) {-# INLINE fromEnum #-} fromEnum = coerce (fromEnum @a) instance (Real a, SaturatingNum a) => Real (Erroring a) where {-# INLINE toRational #-} toRational = coerce (toRational @a) instance (Integral a, SaturatingNum a) => Integral (Erroring a) where -- NOTE the seemingly duplicate "y < 0 && y == -1" guards against unsigned types quotRem x y | x == minBound && y < 0 && y == -1 = (errorX "Erroring.quotRem: result exceeds maxBound", 0) | otherwise = coerce (quotRem @a) x y divMod x y | x == minBound && y < 0 && y == -1 = (errorX "Erroring.divMod: result exceeds maxBound", 0) | otherwise = coerce (divMod @a) x y {-# INLINE toInteger #-} toInteger = coerce (toInteger @a) instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Erroring a) where {-# INLINE recip #-} recip = coerce (recip @a) {-# INLINE fromRational #-} -- TODO This does what the underlying representation does if the Rational -- is not in range (typically wrapping). It would be better if this also -- threw an XException, but in a way which remained synthesizable. fromRational = coerce (fromRational @a) instance (RealFrac a, SaturatingNum a) => RealFrac (Erroring a) where {-# INLINE properFraction #-} properFraction :: forall b. (Integral b) => Erroring a -> (b, Erroring a) properFraction = coerce (properFraction @a @b) clash-prelude-1.8.1/src/Clash/Num/Overflowing.hs0000644000000000000000000001326307346545000017664 0ustar0000000000000000{-| Copyright : (C) 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Clash.Num.Overflowing ( Overflowing , fromOverflowing , hasOverflowed , toOverflowing , clearOverflow ) where import Prelude hiding (even, odd) import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Function (on) import Data.Hashable (Hashable) import GHC.Generics (Generic) import GHC.TypeLits (KnownNat, type (+)) import Clash.Class.BitPack (BitPack(..)) import Clash.Class.Num (SaturationMode(SatWrap, SatZero), SaturatingNum(..)) import Clash.Class.Parity (Parity(..)) import Clash.XException (NFDataX, ShowX) -- | An overflowing number behaves similarly to a 'Clash.Num.Wrapping.Wrapping' -- number, but also includes an overflow status flag which can be used to more -- easily check if an overflow has occurred. -- -- Numbers can be converted to be 'Overflowing' using 'toOverflowing'. -- data Overflowing a = Overflowing { fromOverflowing :: a -- ^ Retrieve the value , hasOverflowed :: Bool -- ^ 'True' when a computation has overflowed } deriving stock (Generic, Show) deriving anyclass (Binary, Hashable, NFData, NFDataX, ShowX) {-# INLINE toOverflowing #-} toOverflowing :: a -> Overflowing a toOverflowing x = Overflowing x False {-# INLINE clearOverflow #-} -- | Reset the overflow status flag to False. clearOverflow :: Overflowing a -> Overflowing a clearOverflow x = x { hasOverflowed = False } instance (Eq a) => Eq (Overflowing a) where {-# INLINE (==) #-} (==) = (==) `on` fromOverflowing instance (Ord a) => Ord (Overflowing a) where {-# INLINE compare #-} compare = compare `on` fromOverflowing instance (BitPack a, KnownNat (BitSize a + 1)) => BitPack (Overflowing a) where type BitSize (Overflowing a) = BitSize a + 1 -- Default instance, no explicit implementations. instance (Parity a) => Parity (Overflowing a) where {-# INLINE even #-} even = even . fromOverflowing {-# INLINE odd #-} odd = odd . fromOverflowing instance (Bounded a, Ord a, SaturatingNum a) => Num (Overflowing a) where Overflowing x a + Overflowing y b | y > 0 , x > satSub SatWrap maxBound y = withOverflow True | y < 0 , x < satSub SatWrap minBound y = withOverflow True | otherwise = withOverflow (a || b) where withOverflow = Overflowing (satAdd SatWrap x y) Overflowing x a - Overflowing y b | y < 0 , x > satAdd SatWrap maxBound y = withOverflow True | y > 0 , x < satAdd SatWrap minBound y = withOverflow True | otherwise = withOverflow (a || b) where withOverflow = Overflowing (satSub SatWrap x y) Overflowing x a * Overflowing y b | x /= 0 , y /= 0 , satMul SatZero x y == 0 = withOverflow True | otherwise = withOverflow (a || b) where withOverflow = Overflowing (satMul SatWrap x y) negate n@(Overflowing x a) | 0 == x = n | 0 <= minBound @a = withOverflow True | x == minBound = withOverflow True | otherwise = withOverflow a where withOverflow = Overflowing (negate x) abs (Overflowing x a) | x == minBound && x < 0 = Overflowing x True | otherwise = Overflowing (abs x) a signum (Overflowing x a) = Overflowing (signum x) a -- TODO This does what the underlying representation does if the Integer -- is not in range (typically wrapping). It would be better if this also -- definitely wrapped, but in a way which remained synthesizable. fromInteger i = Overflowing (fromInteger i) False instance (Bounded a) => Bounded (Overflowing a) where minBound = Overflowing minBound False maxBound = Overflowing maxBound False instance (Enum a, Eq a, SaturatingNum a) => Enum (Overflowing a) where succ (Overflowing x a) | x == maxBound = withOverflow True | otherwise = withOverflow a where withOverflow = Overflowing (satSucc SatWrap x) pred (Overflowing x a) | x == minBound = withOverflow True | otherwise = withOverflow a where withOverflow = Overflowing (satPred SatWrap x) toEnum i = Overflowing (toEnum i) False fromEnum = fromEnum . fromOverflowing instance (Real a, SaturatingNum a) => Real (Overflowing a) where toRational = toRational . fromOverflowing instance (Integral a, SaturatingNum a) => Integral (Overflowing a) where -- NOTE the seemingly duplicate "y < 0 && y == -1" guards against unsigned types quotRem (Overflowing x a) (Overflowing y b) | x == minBound && y < 0 && y == -1 = withOverflow True | otherwise = withOverflow (a || b) where withOverflow o = let (q, r) = quotRem x y in (Overflowing q o, Overflowing r False) divMod (Overflowing x a) (Overflowing y b) | x == minBound && y < 0 && y == -1 = withOverflow True | otherwise = withOverflow (a || b) where withOverflow o = let (d, m) = divMod x y in (Overflowing d o, Overflowing m False) toInteger = toInteger . fromOverflowing instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Overflowing a) where recip x = x { fromOverflowing = recip (fromOverflowing x) } -- TODO This does what the underlying representation does if the Rational -- is not in range (typically wrapping). It would be better if this also -- definitely wrapped, but in a way which remained synthesizable. fromRational i = Overflowing (fromRational i) False instance (RealFrac a, SaturatingNum a) => RealFrac (Overflowing a) where properFraction (Overflowing x _) = let (n, f) = properFraction x in (n, Overflowing f False) clash-prelude-1.8.1/src/Clash/Num/Saturating.hs0000644000000000000000000001100207346545000017471 0ustar0000000000000000{- Copyright : (C) 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Clash.Num.Saturating ( Saturating , fromSaturating -- exported here because haddock https://github.com/haskell/haddock/issues/456 , toSaturating ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Bits (Bits, FiniteBits) import Data.Coerce (coerce) import Data.Functor.Compose (Compose(..)) import Data.Hashable (Hashable) import GHC.TypeLits (KnownNat, type (+)) import Test.QuickCheck (Arbitrary) import Clash.Class.BitPack (BitPack) import Clash.Class.Num (SaturationMode(SatBound), SaturatingNum(..)) import Clash.Class.Parity (Parity) import Clash.Class.Resize (Resize(..)) import Clash.XException (NFDataX, ShowX) -- | A saturating number type is one where all operations saturate at the -- bounds of the underlying type, i.e. operations which overflow return -- 'maxBound' and operations that underflow return 'minBound'. -- -- Numbers can be converted to saturate by default using 'toSaturating'. -- newtype Saturating a = Saturating { fromSaturating :: a } deriving newtype ( Arbitrary , Binary , Bits , BitPack , Bounded , Eq , FiniteBits , Hashable , NFData , NFDataX , Ord , Parity , Show , ShowX ) {-# INLINE toSaturating #-} toSaturating :: (SaturatingNum a) => a -> Saturating a toSaturating = Saturating instance (Resize f) => Resize (Compose Saturating f) where {-# INLINE resize #-} resize :: forall a b . (KnownNat a, KnownNat b) => Compose Saturating f a -> Compose Saturating f b resize = coerce (resize @f @a @b) {-# INLINE zeroExtend #-} zeroExtend :: forall a b . (KnownNat a, KnownNat b) => Compose Saturating f a -> Compose Saturating f (b + a) zeroExtend = coerce (zeroExtend @f @a @b) {-# INLINE truncateB #-} truncateB :: forall a b . (KnownNat a) => Compose Saturating f (a + b) -> Compose Saturating f a truncateB = coerce (truncateB @f @a @b) instance (Ord a, SaturatingNum a) => Num (Saturating a) where {-# INLINE (+) #-} (+) = coerce (satAdd @a SatBound) {-# INLINE (-) #-} (-) = coerce (satSub @a SatBound) {-# INLINE (*) #-} (*) = coerce (satMul @a SatBound) negate x | 0 <= minBound @a = 0 | x == minBound = maxBound | otherwise = coerce (negate @a) x abs x | x == minBound && x < 0 = maxBound | otherwise = coerce (abs @a) x {-# INLINE signum #-} signum = coerce (signum @a) {-# INLINE fromInteger #-} -- TODO This does what the underlying representation does if the Integer -- is not in range (typically wrapping). It would be better if this also -- saturated, but in a way which remained synthesizable. fromInteger = coerce (fromInteger @a) instance (Enum a, SaturatingNum a) => Enum (Saturating a) where {-# INLINE succ #-} -- Deliberately breaks the Enum law that succ maxBound ~> error succ = coerce (satSucc @a SatBound) {-# INLINE pred #-} -- Deliberately breaks the Enum law that pred minBound ~> error pred = coerce (satPred @a SatBound) {-# INLINE toEnum #-} toEnum = coerce (toEnum @a) {-# INLINE fromEnum #-} fromEnum = coerce (fromEnum @a) instance (Real a, SaturatingNum a) => Real (Saturating a) where {-# INLINE toRational #-} toRational = coerce (toRational @a) instance (Integral a, SaturatingNum a) => Integral (Saturating a) where -- NOTE the seemingly duplicate "y < 0 && y == -1" guards against unsigned types quotRem x y | x == minBound && y < 0 && y == -1 = (maxBound, 0) | otherwise = coerce (quotRem @a) x y divMod x y | x == minBound && y < 0 && y == -1 = (maxBound, 0) | otherwise = coerce (divMod @a) x y {-# INLINE toInteger #-} toInteger = coerce (toInteger @a) instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Saturating a) where {-# INLINE recip #-} recip = coerce (recip @a) {-# INLINE fromRational #-} -- TODO This does what the underlying representation does if the Rational -- is not in range (typically wrapping). It would be better if this also -- saturated, but in a way which remained synthesizable. fromRational = coerce (fromRational @a) instance (Ord a, RealFrac a, SaturatingNum a) => RealFrac (Saturating a) where {-# INLINE properFraction #-} properFraction :: forall b. (Integral b) => Saturating a -> (b, Saturating a) properFraction = coerce (properFraction @a @b) clash-prelude-1.8.1/src/Clash/Num/Wrapping.hs0000644000000000000000000001012207346545000017141 0ustar0000000000000000{- Copyright : (C) 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Clash.Num.Wrapping ( Wrapping(..) , toWrapping ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Bits (Bits, FiniteBits) import Data.Coerce (coerce) import Data.Functor.Compose (Compose(..)) import Data.Hashable (Hashable) import GHC.TypeLits (KnownNat, type (+)) import Test.QuickCheck (Arbitrary) import Clash.Class.BitPack (BitPack) import Clash.Class.Num (SaturationMode(SatWrap), SaturatingNum(..)) import Clash.Class.Parity (Parity) import Clash.Class.Resize (Resize(..)) import Clash.XException (NFDataX, ShowX) -- | A wrapping number type is one where all operations wrap between minBound -- and maxBound (and vice-versa) if the result goes out of bounds for the -- underlying type. -- -- Numbers can be converted to wrap by default using 'toWrapping'. -- newtype Wrapping a = Wrapping { fromWrapping :: a } deriving newtype ( Arbitrary , Binary , Bits , BitPack , Bounded , Eq , FiniteBits , Hashable , NFData , NFDataX , Ord , Parity , Show , ShowX ) {-# INLINE toWrapping #-} toWrapping :: (SaturatingNum a) => a -> Wrapping a toWrapping = Wrapping instance (Resize f) => Resize (Compose Wrapping f) where {-# INLINE resize #-} resize :: forall a b . (KnownNat a, KnownNat b) => Compose Wrapping f a -> Compose Wrapping f b resize = coerce (resize @f @a @b) {-# INLINE zeroExtend #-} zeroExtend :: forall a b . (KnownNat a, KnownNat b) => Compose Wrapping f a -> Compose Wrapping f (b + a) zeroExtend = coerce (zeroExtend @f @a @b) {-# INLINE truncateB #-} truncateB :: forall a b . (KnownNat a) => Compose Wrapping f (a + b) -> Compose Wrapping f a truncateB = coerce (truncateB @f @a @b) instance (SaturatingNum a) => Num (Wrapping a) where {-# INLINE (+) #-} (+) = coerce (satAdd @a SatWrap) {-# INLINE (-) #-} (-) = coerce (satSub @a SatWrap) {-# INLINE (*) #-} (*) = coerce (satMul @a SatWrap) -- Assume the default behaviour is to wrap anyway. {-# INLINE negate #-} negate = coerce (negate @a) {-# INLINE abs #-} abs = coerce (abs @a) {-# INLINE signum #-} signum = coerce (signum @a) {-# INLINE fromInteger #-} -- TODO This does what the underlying representation does if the Integer -- is not in range (typically wrapping). It would be better if this also -- definitely wrapped, but in a way which remained synthesizable. fromInteger = coerce (fromInteger @a) instance (Enum a, SaturatingNum a) => Enum (Wrapping a) where {-# INLINE succ #-} -- Deliberately breaks the Enum law that succ maxBound ~> error succ = coerce (satSucc @a SatWrap) {-# INLINE pred #-} -- Deliberately breaks the Enum law that pred minBound ~> error pred = coerce (satPred @a SatWrap) {-# INLINE toEnum #-} toEnum = coerce (toEnum @a) {-# INLINE fromEnum #-} fromEnum = coerce (fromEnum @a) instance (Real a, SaturatingNum a) => Real (Wrapping a) where {-# INLINE toRational #-} toRational = coerce (toRational @a) instance (Integral a, SaturatingNum a) => Integral (Wrapping a) where {-# INLINE quotRem #-} quotRem = coerce (quotRem @a) {-# INLINE divMod #-} divMod = coerce (divMod @a) {-# INLINE toInteger #-} toInteger = coerce (toInteger @a) instance (Fractional a, SaturatingNum a) => Fractional (Wrapping a) where {-# INLINE recip #-} recip = coerce (recip @a) {-# INLINE fromRational #-} -- TODO This does what the underlying representation does if the Rational -- is not in range (typically wrapping). It would be better if this also -- definitely wrapped, but in a way which remained synthesizable. fromRational = coerce (fromRational @a) instance (RealFrac a, SaturatingNum a) => RealFrac (Wrapping a) where {-# INLINE properFraction #-} properFraction :: forall b. (Integral b) => Wrapping a -> (b, Wrapping a) properFraction = coerce (properFraction @a @b) clash-prelude-1.8.1/src/Clash/Num/Zeroing.hs0000644000000000000000000001047307346545000017000 0ustar0000000000000000{- Copyright : (C) 2021, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Clash.Num.Zeroing ( Zeroing , fromZeroing -- exported here because haddock https://github.com/haskell/haddock/issues/456 , toZeroing ) where import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Bits (Bits, FiniteBits) import Data.Coerce (coerce) import Data.Functor.Compose (Compose(..)) import Data.Hashable (Hashable) import GHC.TypeLits (KnownNat, type (+)) import Test.QuickCheck (Arbitrary) import Clash.Class.BitPack (BitPack) import Clash.Class.Num (SaturationMode(SatZero), SaturatingNum(..)) import Clash.Class.Parity (Parity) import Clash.Class.Resize (Resize(..)) import Clash.XException (NFDataX, ShowX) -- | A zeroing number type is one where all operations return zero if they go -- out of bounds for the underlying type. -- -- Numbers can be converted to zero by default using `toZeroing`. -- newtype Zeroing a = Zeroing { fromZeroing :: a } deriving newtype ( Arbitrary , Binary , Bits , BitPack , Bounded , Eq , FiniteBits , Hashable , NFData , NFDataX , Ord , Parity , Show , ShowX ) {-# INLINE toZeroing #-} toZeroing :: (SaturatingNum a) => a -> Zeroing a toZeroing = Zeroing instance (Resize f) => Resize (Compose Zeroing f) where {-# INLINE resize #-} resize :: forall a b . (KnownNat a, KnownNat b) => Compose Zeroing f a -> Compose Zeroing f b resize = coerce (resize @f @a @b) {-# INLINE zeroExtend #-} zeroExtend :: forall a b . (KnownNat a, KnownNat b) => Compose Zeroing f a -> Compose Zeroing f (b + a) zeroExtend = coerce (zeroExtend @f @a @b) {-# INLINE truncateB #-} truncateB :: forall a b . (KnownNat a) => Compose Zeroing f (a + b) -> Compose Zeroing f a truncateB = coerce (truncateB @f @a @b) instance (Bounded a, Ord a, SaturatingNum a) => Num (Zeroing a) where {-# INLINE (+) #-} (+) = coerce (satAdd @a SatZero) {-# INLINE (-) #-} (-) = coerce (satSub @a SatZero) {-# INLINE (*) #-} (*) = coerce (satMul @a SatZero) negate x | 0 <= minBound @a = 0 | x == minBound = 0 | otherwise = coerce (negate @a) x abs x | x == minBound && x < 0 = 0 | otherwise = coerce (abs @a) x {-# INLINE signum #-} signum = coerce (signum @a) {-# INLINE fromInteger #-} -- TODO This does what the underlying representation does if the Integer -- is not in range (typically wrapping). It would be better if this also -- returned zero, but in a way which remained synthesizable. fromInteger = coerce (fromInteger @a) instance (Enum a, SaturatingNum a) => Enum (Zeroing a) where {-# INLINE succ #-} -- Deliberately breaks the Enum law that succ maxBound ~> error succ = coerce (satSucc @a SatZero) {-# INLINE pred #-} -- Deliberately breaks the Enum law that pred minBound ~> error pred = coerce (satPred @a SatZero) {-# INLINE toEnum #-} toEnum = coerce (toEnum @a) {-# INLINE fromEnum #-} fromEnum = coerce (fromEnum @a) instance (Real a, SaturatingNum a) => Real (Zeroing a) where {-# INLINE toRational #-} toRational = coerce (toRational @a) instance (Integral a, SaturatingNum a) => Integral (Zeroing a) where -- NOTE the seemingly duplicate "y < 0 && y == -1" guards against unsigned types quotRem x y | x == minBound && y < 0 && y == -1 = (0, 0) | otherwise = coerce (quotRem @a) x y divMod x y | x == minBound && y < 0 && y == -1 = (0, 0) | otherwise = coerce (divMod @a) x y {-# INLINE toInteger #-} toInteger = coerce (toInteger @a) instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Zeroing a) where {-# INLINE recip #-} recip = coerce (recip @a) {-# INLINE fromRational #-} -- TODO This does what the underlying representation does if the Rational -- is not in range (typically wrapping). It would be better if this also -- returned zero, but in a way which remained synthesizable. fromRational = coerce (fromRational @a) instance (RealFrac a, SaturatingNum a) => RealFrac (Zeroing a) where {-# INLINE properFraction #-} properFraction :: forall b. (Integral b) => Zeroing a -> (b, Zeroing a) properFraction = coerce (properFraction @a @b) clash-prelude-1.8.1/src/Clash/Prelude.hs0000644000000000000000000002126607346545000016226 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017 , Google Inc., 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Clash is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The merits of using a functional language to describe hardware comes from the fact that combinational circuits can be directly modeled as mathematical functions and that functional languages lend themselves very well at describing and (de-)composing mathematical functions. This package provides: * Prelude library containing datatypes and functions for circuit design To use the library: * Import "Clash.Prelude"; by default clock and reset lines are implicitly routed for all the components found in "Clash.Prelude". You can read more about implicit clock and reset lines in "Clash.Signal#implicitclockandreset" * Alternatively, if you want to explicitly route clock and reset ports, for more straightforward multi-clock designs, you can import the "Clash.Explicit.Prelude" module. Note that you should not import "Clash.Prelude" and "Clash.Explicit.Prelude" at the same time as they have overlapping definitions. For now, "Clash.Prelude" is also the best starting point for exploring the library. A preliminary version of a tutorial can be found in "Clash.Tutorial". Some circuit examples can be found in "Clash.Examples". -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} module Clash.Prelude ( -- * Creating synchronous sequential circuits mealy , mealyS , mealyB , mealySB , (<^>) , moore , mooreB , registerB #ifdef CLASH_MULTIPLE_HIDDEN -- * Synchronizer circuits for safe clock domain crossings , dualFlipFlopSynchronizer , asyncFIFOSynchronizer #endif -- * ROMs , asyncRom , asyncRomPow2 , rom , romPow2 -- ** ROMs defined by a 'MemBlob' , asyncRomBlob , asyncRomBlobPow2 , romBlob , romBlobPow2 -- ** ROMs defined by a data file , asyncRomFile , asyncRomFilePow2 , romFile , romFilePow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * Block RAM primitives , blockRam , blockRamPow2 , blockRamU , blockRam1 , E.ResetStrategy(..) -- ** Block RAM primitives initialized with a 'MemBlob' , blockRamBlob , blockRamBlobPow2 -- *** Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- ** Block RAM primitives initialized with a data file , blockRamFile , blockRamFilePow2 -- ** Block RAM read/write conflict resolution , readNew -- ** True dual-port block RAM , trueDualPortBlockRam , RamOp(..) -- * Utility functions , window , windowD , isRising , isFalling , riseEvery , oscillate -- * Tracing -- ** Simple , traceSignal1 , traceVecSignal1 -- ** Tracing in a multi-clock environment , traceSignal , traceVecSignal -- ** VCD dump functions , dumpVCD -- * Exported modules -- ** Synchronous signals , module Clash.Signal , module Clash.Signal.Delayed -- ** Datatypes -- *** Bit vectors , module Clash.Sized.BitVector -- *** Arbitrary-width numbers , module Clash.Sized.Signed , module Clash.Sized.Unsigned , module Clash.Sized.Index -- *** Fixed point numbers , module Clash.Sized.Fixed -- *** Fixed size vectors , module Clash.Sized.Vector -- *** Perfect depth trees , module Clash.Sized.RTree -- ** Annotations , module Clash.Annotations.TopEntity -- ** Generics type-classes , Generic , Generic1 -- ** Type-level natural numbers , module GHC.TypeLits , module GHC.TypeLits.Extra , module Clash.Promoted.Nat , module Clash.Promoted.Nat.Literals , module Clash.Promoted.Nat.TH -- ** Type-level strings , module Clash.Promoted.Symbol -- ** Template Haskell , Lift (..) -- ** Type classes -- *** Clash , 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 , module Data.Bits , module Data.Default.Class , module Data.Kind -- ** Exceptions , module Clash.XException -- ** Named types , module Clash.NamedTypes -- ** Hidden arguments , module Clash.Hidden -- ** Magic , module Clash.Magic -- ** Haskell Prelude -- $hiding , module Clash.HaskellPrelude ) where import Control.Applicative import Data.Bits import Data.Default.Class import Data.Kind (Type, Constraint) import GHC.Stack (HasCallStack) import GHC.TypeLits #if MIN_VERSION_base(4,18,0) hiding (SNat, SSymbol, fromSNat) #endif 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 import Clash.Magic import Clash.NamedTypes import Clash.Prelude.BlockRam import Clash.Prelude.BlockRam.Blob import Clash.Prelude.BlockRam.File import Clash.Prelude.ROM.Blob import Clash.Prelude.ROM.File import Clash.Prelude.Safe #ifdef CLASH_MULTIPLE_HIDDEN import Clash.Prelude.Synchronizer #endif import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals import Clash.Promoted.Symbol 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 hiding (fromList, unsafeFromList) import Clash.Signal hiding (HiddenClockName, HiddenResetName, HiddenEnableName) import Clash.Signal.Delayed import Clash.Signal.Trace import Clash.XException {- $setup >>> :set -XDataKinds -XFlexibleContexts -XTypeApplications >>> let window4 = window :: HiddenClockResetEnable dom => Signal dom Int -> Vec 4 (Signal dom Int) >>> let windowD3 = windowD :: HiddenClockResetEnable dom => Signal dom Int -> Vec 3 (Signal dom Int) -} {- $hiding "Clash.Prelude" re-exports most of the Haskell "Prelude" with the exception of those functions that the Clash API defines to work on 'Vec' from "Clash.Sized.Vector" instead of on lists as the Haskell Prelude does. In addition, for the 'Clash.Class.Parity.odd' and 'Clash.Class.Parity.even' functions a type class called 'Clash.Class.Parity.Parity' is available at "Clash.Class.Parity". -} -- | Give a window over a 'Signal' -- -- > window4 :: HiddenClockResetEnable dom -- > => Signal dom Int -> Vec 4 (Signal dom Int) -- > window4 = window -- -- >>> simulateB @System window4 [1::Int,2,3,4,5] :: [Vec 4 Int] -- [1 :> 0 :> 0 :> 0 :> Nil,2 :> 1 :> 0 :> 0 :> Nil,3 :> 2 :> 1 :> 0 :> Nil,4 :> 3 :> 2 :> 1 :> Nil,5 :> 4 :> 3 :> 2 :> Nil,... -- ... window :: ( HiddenClockResetEnable dom , KnownNat n , Default a , NFDataX a ) => Signal dom a -- ^ Signal to create a window over -> Vec (n + 1) (Signal dom a) -- ^ Window of at least size 1 window = hideClockResetEnable E.window {-# INLINE window #-} -- | Give a delayed window over a 'Signal' -- -- > windowD3 -- > :: HiddenClockResetEnable dom -- > => Signal dom Int -- > -> Vec 3 (Signal dom Int) -- > windowD3 = windowD -- -- >>> simulateB @System windowD3 [1::Int,2,3,4] :: [Vec 3 Int] -- [0 :> 0 :> 0 :> Nil,1 :> 0 :> 0 :> Nil,2 :> 1 :> 0 :> Nil,3 :> 2 :> 1 :> Nil,4 :> 3 :> 2 :> Nil,... -- ... windowD :: ( HiddenClockResetEnable dom , KnownNat n , Default a , NFDataX a ) => Signal dom a -- ^ Signal to create a window over -> Vec (n + 1) (Signal dom a) -- ^ 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 clash-prelude-1.8.1/src/Clash/Prelude/0000755000000000000000000000000007346545000015663 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Prelude/BlockRam.hs0000644000000000000000000006636207346545000017726 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016-2019, Myrtle Software Ltd, 2017 , Google Inc., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Block RAM primitives = Using RAMs #usingrams# We will show a rather elaborate example on how you can, and why you might want to use 'blockRam's. We will build a \"small\" CPU + Memory + Program ROM where we will slowly evolve to using 'blockRam's. Note that the code is /not/ meant as a de-facto standard on how to do CPU design in Clash. We start with the definition of the Instructions, Register names and machine codes: @ {\-\# LANGUAGE RecordWildCards, TupleSections, DeriveAnyClass \#-\} module CPU where import Clash.Prelude type InstrAddr = Unsigned 8 type MemAddr = Unsigned 5 type Value = Signed 8 data Instruction = Compute Operator Reg Reg Reg | Branch Reg Value | Jump Value | Load MemAddr Reg | Store Reg MemAddr | Nop deriving (Eq, Show, Generic, NFDataX) data Reg = Zero | PC | RegA | RegB | RegC | RegD | RegE deriving (Eq, Show, Enum, Generic, NFDataX) data Operator = Add | Sub | Incr | Imm | CmpGt deriving (Eq, Show, Generic, NFDataX) data MachCode = MachCode { inputX :: Reg , inputY :: Reg , result :: Reg , aluCode :: Operator , ldReg :: Reg , rdAddr :: MemAddr , wrAddrM :: Maybe MemAddr , jmpM :: Maybe Value } nullCode = MachCode { inputX = Zero , inputY = Zero , result = Zero , aluCode = Imm , ldReg = Zero , rdAddr = 0 , wrAddrM = Nothing , jmpM = Nothing } @ Next we define the CPU and its ALU: @ cpu :: Vec 7 Value -- ^ Register bank -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( Vec 7 Value , (MemAddr, Maybe (MemAddr,Value), InstrAddr) ) cpu regbank (memOut, instr) = (regbank', (rdAddr, (,aluOut) 'Prelude.<$>' wrAddrM, bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank 'Clash.Sized.Vector.!!' PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank 'Clash.Sized.Vector.!!' inputX regY = regbank 'Clash.Sized.Vector.!!' inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers regbank' = 'Clash.Sized.Vector.replace' Zero 0 $ 'Clash.Sized.Vector.replace' PC nextPC $ 'Clash.Sized.Vector.replace' result aluOut $ 'Clash.Sized.Vector.replace' ldReg memOut $ regbank alu Add x y = x + y alu Sub x y = x - y alu Incr x _ = x + 1 alu Imm x _ = x alu CmpGt x y = if x > y then 1 else 0 @ We initially create a memory out of simple registers: @ dataMem :: HiddenClockResetEnable dom => Signal dom MemAddr -- ^ Read address -> Signal dom (Maybe (MemAddr,Value)) -- ^ (write address, data in) -> Signal dom Value -- ^ data out dataMem rd wrM = 'Clash.Prelude.Mealy.mealy' dataMemT ('Clash.Sized.Vector.replicate' d32 0) (bundle (rd,wrM)) where dataMemT mem (rd,wrM) = (mem',dout) where dout = mem 'Clash.Sized.Vector.!!' rd mem' = case wrM of Just (wr,din) -> 'Clash.Sized.Vector.replace' wr din mem _ -> mem @ And then connect everything: @ system :: ( KnownNat n , HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system instrs = memOut where memOut = dataMem rdAddr dout (rdAddr, dout, ipntr) = 'Clash.Prelude.Mealy.mealyB' cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr) instr = 'Clash.Prelude.ROM.asyncRom' instrs 'Prelude.<$>' ipntr @ Create a simple program that calculates the GCD of 4 and 6: @ -- Compute GCD of 4 and 6 prog = -- 0 := 4 Compute Incr Zero RegA RegA :> replicate d3 (Compute Incr RegA Zero RegA) ++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> replicate d5 (Compute Incr RegA Zero RegA) ++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil @ And test our system: @ >>> sampleN @System 32 (system prog) [0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ to see that our system indeed calculates that the GCD of 6 and 4 is 2. === Improvement 1: using @asyncRam@ As you can see, it's fairly straightforward to build a memory using registers and read ('Clash.Sized.Vector.!!') and write ('Clash.Sized.Vector.replace') logic. This might however not result in the most efficient hardware structure, especially when building an ASIC. Instead it is preferable to use the 'Clash.Prelude.RAM.asyncRam' function which has the potential to be translated to a more efficient structure: @ system2 :: ( KnownNat n , HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system2 instrs = memOut where memOut = 'Clash.Prelude.RAM.asyncRam' d32 rdAddr dout (rdAddr,dout,ipntr) = 'Clash.Prelude.mealyB' cpu ('Clash.Sized.Vector.replicate' d7 0) (memOut,instr) instr = 'Clash.Prelude.ROM.asyncRom' instrs 'Prelude.<$>' ipntr @ Again, we can simulate our system and see that it works. This time however, we need to disregard the first few output samples, because the initial content of an 'Clash.Prelude.RAM.asyncRam' is /undefined/, and consequently, the first few output samples are also /undefined/. We use the utility function 'Clash.XException.printX' to conveniently filter out the undefinedness and replace it with the string @\"undefined\"@ in the first few leading outputs. @ >>> printX $ sampleN @System 32 (system2 prog) [undefined,undefined,undefined,undefined,undefined,undefined,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ === Improvement 2: using @blockRam@ Finally we get to using 'blockRam'. On FPGAs, 'Clash.Prelude.RAM.asyncRam' will be implemented in terms of LUTs, and therefore take up logic resources. FPGAs also have large(r) memory structures called /block RAMs/, which are preferred, especially as the memories we need for our application get bigger. The 'blockRam' function will be translated to such a /block RAM/. One important aspect of block RAMs is that they have a /synchronous/ read port, meaning that, unlike the behavior of 'Clash.Prelude.RAM.asyncRam', given a read address @r@ at time @t@, the value @v@ in the RAM at address @r@ is only available at time @t+1@. For us that means we need to change the design of our CPU. Right now, upon a load instruction we generate a read address for the memory, and the value at that read address is immediately available to be put in the register bank. Because we will be using a block RAM, the value is delayed until the next cycle. Thus, we will need to also delay the register address to which the memory address is loaded: @ cpu2 :: (Vec 7 Value,Reg) -- ^ (Register bank, Load reg addr) -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( (Vec 7 Value, Reg) , (MemAddr, Maybe (MemAddr,Value), InstrAddr) ) cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank', ldRegD'), (rdAddr, (,aluOut) 'Prelude.<$>' wrAddrM, bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank 'Clash.Sized.Vector.!!' PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank 'Clash.Sized.Vector.!!' inputX regY = regbank 'Clash.Sized.Vector.!!' inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers ldRegD' = ldReg -- Delay the ldReg by 1 cycle regbank' = 'Clash.Sized.Vector.replace' Zero 0 $ 'Clash.Sized.Vector.replace' PC nextPC $ 'Clash.Sized.Vector.replace' result aluOut $ 'Clash.Sized.Vector.replace' ldRegD memOut $ regbank @ We can now finally instantiate our system with a 'blockRam': @ system3 :: (KnownNat n , HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system3 instrs = memOut where memOut = 'blockRam' (replicate d32 0) rdAddr dout (rdAddr,dout,ipntr) = 'Clash.Prelude.mealyB' cpu2 (('Clash.Sized.Vector.replicate' d7 0),Zero) (memOut,instr) instr = 'Clash.Prelude.ROM.asyncRom' instrs 'Prelude.<$>' ipntr @ We are, however, not done. We will also need to update our program. The reason being that values that we try to load in our registers won't be loaded into the register until the next cycle. This is a problem when the next instruction immediately depends on this memory value. In our case, this was only the case when we loaded the value @6@, which was stored at address @1@, into @RegB@. Our updated program is thus: @ prog2 = -- 0 := 4 Compute Incr Zero RegA RegA :> replicate d3 (Compute Incr RegA Zero RegA) ++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> replicate d5 (Compute Incr RegA Zero RegA) ++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> Nop :> -- Extra NOP -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil @ When we simulate our system we see that it works. This time again, we need to disregard the first sample, because the initial output of a 'blockRam' is /undefined/. We use the utility function 'Clash.XException.printX' to conveniently filter out the undefinedness and replace it with the string @\"undefined\"@. @ >>> printX $ sampleN @System 34 (system3 prog2) [undefined,0,0,0,0,0,0,4,4,4,4,4,4,4,4,6,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,2] @ This concludes the short introduction to using 'blockRam'. -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.BlockRam ( -- * BlockRAM synchronized to the system clock blockRam , blockRamPow2 , blockRamU , blockRam1 , E.ResetStrategy(..) -- ** Read/Write conflict resolution , readNew -- * True dual-port block RAM -- $tdpbram , trueDualPortBlockRam , E.RamOp(..) ) where import Prelude (Enum, Maybe, Eq) import GHC.TypeLits (KnownNat, type (^), type (<=)) import GHC.Stack (HasCallStack, withFrozenCallStack) import qualified Clash.Explicit.BlockRam as E import Clash.Promoted.Nat (SNat) import Clash.Signal import Clash.Sized.Index (Index) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Vector (Vec) import Clash.XException (NFDataX) {- $tdpbram A true dual-port block RAM has two fully independent, fully functional access ports: port A and port B. Either port can do both RAM reads and writes. These two ports can even be on distinct clock domains, but the memory itself is shared between the ports. This also makes a true dual-port block RAM suitable as a component in a domain crossing circuit (but it needs additional logic for it to be safe, see e.g. 'Clash.Explicit.Synchronizer.asyncFIFOSynchronizer'). A version with explicit clocks can be found in "Clash.Explicit.BlockRam". -} {- $setup >>> import Clash.Prelude as C >>> import qualified Data.List as L >>> :set -XDataKinds -XRecordWildCards -XTupleSections -XTypeApplications -XFlexibleContexts >>> :set -XDeriveAnyClass -XDeriveGeneric >>> type InstrAddr = Unsigned 8 >>> type MemAddr = Unsigned 5 >>> type Value = Signed 8 >>> :{ data Reg = Zero | PC | RegA | RegB | RegC | RegD | RegE deriving (Eq,Show,Enum,C.Generic,NFDataX) :} >>> :{ data Operator = Add | Sub | Incr | Imm | CmpGt deriving (Eq, Show, Generic, NFDataX) :} >>> :{ data Instruction = Compute Operator Reg Reg Reg | Branch Reg Value | Jump Value | Load MemAddr Reg | Store Reg MemAddr | Nop deriving (Eq, Show, Generic, NFDataX) :} >>> :{ data MachCode = MachCode { inputX :: Reg , inputY :: Reg , result :: Reg , aluCode :: Operator , ldReg :: Reg , rdAddr :: MemAddr , wrAddrM :: Maybe MemAddr , jmpM :: Maybe Value } :} >>> :{ nullCode = MachCode { inputX = Zero, inputY = Zero, result = Zero, aluCode = Imm , ldReg = Zero, rdAddr = 0, wrAddrM = Nothing , jmpM = Nothing } :} >>> :{ alu Add x y = x + y alu Sub x y = x - y alu Incr x _ = x + 1 alu Imm x _ = x alu CmpGt x y = if x > y then 1 else 0 :} >>> :{ let cpu :: Vec 7 Value -- ^ Register bank -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( Vec 7 Value , (MemAddr,Maybe (MemAddr,Value),InstrAddr) ) cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank C.!! PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank C.!! inputX regY = regbank C.!! inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers regbank' = replace Zero 0 $ replace PC nextPC $ replace result aluOut $ replace ldReg memOut $ regbank :} >>> :{ let dataMem :: HiddenClockResetEnable dom => Signal dom MemAddr -> Signal dom (Maybe (MemAddr,Value)) -> Signal dom Value dataMem rd wrM = mealy dataMemT (C.replicate d32 0) (bundle (rd,wrM)) where dataMemT mem (rd,wrM) = (mem',dout) where dout = mem C.!! rd mem' = case wrM of Just (wr,din) -> replace wr din mem Nothing -> mem :} >>> :{ let system :: (KnownNat n, HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system instrs = memOut where memOut = dataMem rdAddr dout (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ -- Compute GCD of 4 and 6 prog = -- 0 := 4 Compute Incr Zero RegA RegA :> C.replicate d3 (Compute Incr RegA Zero RegA) C.++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> C.replicate d5 (Compute Incr RegA Zero RegA) C.++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil :} >>> :{ let system2 :: ( KnownNat n , HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system2 instrs = memOut where memOut = asyncRam d32 rdAddr dout (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ let cpu2 :: (Vec 7 Value,Reg) -- ^ (Register bank, Load reg addr) -> (Value,Instruction) -- ^ (Memory output, Current instruction) -> ( (Vec 7 Value,Reg) , (MemAddr, Maybe (MemAddr, Value), InstrAddr) ) cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank', ldRegD'), (rdAddr, (,aluOut) <$> wrAddrM, bitCoerce ipntr)) where -- Current instruction pointer ipntr = regbank C.!! PC -- Decoder (MachCode {..}) = case instr of Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op} Branch cr a -> nullCode {inputX=cr,jmpM=Just a} Jump a -> nullCode {aluCode=Incr,jmpM=Just a} Load a r -> nullCode {ldReg=r,rdAddr=a} Store r a -> nullCode {inputX=r,wrAddrM=Just a} Nop -> nullCode -- ALU regX = regbank C.!! inputX regY = regbank C.!! inputY aluOut = alu aluCode regX regY -- next instruction nextPC = case jmpM of Just a | aluOut /= 0 -> ipntr + a _ -> ipntr + 1 -- update registers ldRegD' = ldReg -- Delay the ldReg by 1 cycle regbank' = replace Zero 0 $ replace PC nextPC $ replace result aluOut $ replace ldRegD memOut $ regbank :} >>> :{ let system3 :: ( KnownNat n , HiddenClockResetEnable dom ) => Vec n Instruction -> Signal dom Value system3 instrs = memOut where memOut = blockRam (C.replicate d32 0) rdAddr dout (rdAddr,dout,ipntr) = mealyB cpu2 ((C.replicate d7 0),Zero) (memOut,instr) instr = asyncRom instrs <$> ipntr :} >>> :{ prog2 = -- 0 := 4 Compute Incr Zero RegA RegA :> C.replicate d3 (Compute Incr RegA Zero RegA) C.++ Store RegA 0 :> -- 1 := 6 Compute Incr Zero RegA RegA :> C.replicate d5 (Compute Incr RegA Zero RegA) C.++ Store RegA 1 :> -- A := 4 Load 0 RegA :> -- B := 6 Load 1 RegB :> Nop :> -- Extra NOP -- start Compute CmpGt RegA RegB RegC :> Branch RegC 4 :> Compute CmpGt RegB RegA RegC :> Branch RegC 4 :> Jump 5 :> -- (a > b) Compute Sub RegA RegB RegA :> Jump (-6) :> -- (b > a) Compute Sub RegB RegA RegB :> Jump (-8) :> -- end Store RegA 2 :> Load 2 RegC :> Nil :} -} -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' ('blockRam' inits) rd wrM@. -- * A large 'Vec' for the initial content may be too inefficient, depending -- on how it is constructed. See 'Clash.Prelude.BlockRam.File.blockRamFile' and -- 'Clash.Prelude.BlockRam.Blob.blockRamBlob' for different approaches that -- scale well. -- -- === __Example__ -- @ -- bram40 -- :: 'HiddenClock' dom -- => 'Signal' dom ('Unsigned' 6) -- -> 'Signal' dom (Maybe ('Unsigned' 6, 'Clash.Sized.BitVector.Bit')) -- -> 'Signal' dom 'Clash.Sized.BitVector.Bit' -- bram40 = 'blockRam' ('Clash.Sized.Vector.replicate' d40 1) -- @ blockRam :: ( HasCallStack , HiddenClock dom , HiddenEnable dom , NFDataX a , Enum addr , NFDataX addr ) => Vec n a -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam = \cnt rd wrM -> withFrozenCallStack (hideEnable (hideClock E.blockRam) cnt rd wrM) {-# INLINE blockRam #-} -- | A version of 'blockRam' that has no default values set. May be cleared to -- an arbitrary state using a reset function. blockRamU :: forall n dom a r addr . ( HasCallStack , HiddenClockResetEnable dom , NFDataX a , Enum addr , NFDataX addr , 1 <= n ) => E.ResetStrategy r -- ^ Whether to clear BRAM on asserted reset ('Clash.Explicit.BlockRam.ClearOnReset') -- or not ('Clash.Explicit.BlockRam.NoClearOnReset'). The reset needs to be -- asserted for at least /n/ cycles to clear the BRAM. -> SNat n -- ^ Number of elements in BRAM -> (Index n -> a) -- ^ If applicable (see first argument), reset BRAM using this function -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamU = \rstStrategy cnt initF rd wrM -> withFrozenCallStack (hideClockResetEnable E.blockRamU) rstStrategy cnt initF rd wrM {-# INLINE blockRamU #-} -- | A version of 'blockRam' that is initialized with the same value on all -- memory positions blockRam1 :: forall n dom a r addr . ( HasCallStack , HiddenClockResetEnable dom , NFDataX a , Enum addr , NFDataX addr , 1 <= n ) => E.ResetStrategy r -- ^ Whether to clear BRAM on asserted reset ('Clash.Explicit.BlockRam.ClearOnReset') -- or not ('Clash.Explicit.BlockRam.NoClearOnReset'). The reset needs to be -- asserted for at least /n/ cycles to clear the BRAM. -> SNat n -- ^ Number of elements in BRAM -> a -- ^ Initial content of the BRAM (replicated /n/ times) -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRam1 = \rstStrategy cnt initValue rd wrM -> withFrozenCallStack (hideClockResetEnable E.blockRam1) rstStrategy cnt initValue rd wrM {-# INLINE blockRam1 #-} -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @'readNew' ('blockRamPow2' inits) rd wrM@. -- * A large 'Vec' for the initial content may be too inefficient, depending -- on how it is constructed. See 'Clash.Prelude.BlockRam.File.blockRamFilePow2' -- and 'Clash.Prelude.BlockRam.Blob.blockRamBlobPow2' for different approaches -- that scale well. -- -- === __Example__ -- @ -- bram32 -- :: 'HiddenClock' dom -- => 'Signal' dom ('Unsigned' 5) -- -> 'Signal' dom (Maybe ('Unsigned' 5, 'Clash.Sized.BitVector.Bit')) -- -> 'Signal' dom 'Clash.Sized.BitVector.Bit' -- bram32 = 'blockRamPow2' ('Clash.Sized.Vector.replicate' d32 1) -- @ blockRamPow2 :: ( HasCallStack , HiddenClock dom , HiddenEnable dom , NFDataX a , KnownNat n ) => Vec (2^n) a -- ^ Initial content of the BRAM -- -- __NB__: __MUST__ be a constant. -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the @blockRAM@ at address @r@ from the previous clock -- cycle blockRamPow2 = \cnt rd wrM -> withFrozenCallStack (hideEnable (hideClock E.blockRamPow2) cnt rd wrM) {-# INLINE blockRamPow2 #-} {- | Create a read-after-write block RAM from a read-before-write one #if __GLASGOW_HASKELL__ >= 908 && !defined(CLASH_MULTIPLE_HIDDEN) >>> :t readNew (blockRam (0 :> 1 :> Nil)) readNew (blockRam (0 :> 1 :> Nil)) :: ... ... ... => Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a #elif __GLASGOW_HASKELL__ >= 902 && !defined(CLASH_MULTIPLE_HIDDEN) >>> :t readNew (blockRam (0 :> 1 :> Nil)) readNew (blockRam (0 :> 1 :> Nil)) :: ... ... => Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a #else >>> :t readNew (blockRam (0 :> 1 :> Nil)) readNew (blockRam (0 :> 1 :> Nil)) :: ... ... ... ... ... => Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a #endif -} readNew :: ( HiddenClockResetEnable dom , NFDataX a , Eq addr ) => (Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a) -- ^ The BRAM component -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (Write address @w@, value to write) -> Signal dom a -- ^ Value of the BRAM at address @r@ from the previous clock cycle readNew = hideClockResetEnable E.readNew {-# INLINE readNew #-} -- | Produces vendor-agnostic HDL that will be inferred as a true dual-port -- block RAM -- -- Any value that is being written on a particular port is also the -- value that will be read on that port, i.e. the same-port read/write behavior -- is: WriteFirst. For mixed-port read/write, when port A writes to the address -- port B reads from, the output of port B is undefined, and vice versa. trueDualPortBlockRam :: #ifdef CLASH_MULTIPLE_HIDDEN forall nAddrs dom1 dom2 a . ( HasCallStack , KnownNat nAddrs , HiddenClock dom1 , HiddenClock dom2 , NFDataX a ) => Signal dom1 (E.RamOp nAddrs a) -- ^ RAM operation for port A -> Signal dom2 (E.RamOp nAddrs a) -- ^ RAM operation for port B -> (Signal dom1 a, Signal dom2 a) -- ^ Outputs data on /next/ cycle. When writing, the data written -- will be echoed. When reading, the read data is returned. trueDualPortBlockRam inA inB = E.trueDualPortBlockRam (hasClock @dom1) (hasClock @dom2) inA inB #else forall nAddrs dom a . ( HasCallStack , KnownNat nAddrs , HiddenClock dom , NFDataX a ) => Signal dom (E.RamOp nAddrs a) -- ^ RAM operation for port A -> Signal dom (E.RamOp nAddrs a) -- ^ RAM operation for port B -> (Signal dom a, Signal dom a) -- ^ Outputs data on /next/ cycle. When writing, the data written -- will be echoed. When reading, the read data is returned. trueDualPortBlockRam inA inB = E.trueDualPortBlockRam hasClock hasClock inA inB #endif clash-prelude-1.8.1/src/Clash/Prelude/BlockRam/0000755000000000000000000000000007346545000017355 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Prelude/BlockRam/Blob.hs0000644000000000000000000000704407346545000020574 0ustar0000000000000000{-| Copyright : (C) 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Efficient bundling of initial RAM content with the compiled code Leveraging Template Haskell, the initial content for the block RAM components in this module is stored alongside the compiled Haskell code. It covers use cases where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be problematically slow. The data is stored efficiently, with very little overhead (worst-case 7%, often no overhead at all). Unlike "Clash.Prelude.BlockRam.File", "Clash.Prelude.BlockRam.Blob" generates practically the same HDL as "Clash.Prelude.BlockRam" and is compatible with all tools consuming the generated HDL. -} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.BlockRam.Blob ( -- * BlockRAMs initialized with a 'E.MemBlob' blockRamBlob , blockRamBlobPow2 -- * Creating and inspecting 'E.MemBlob' , E.MemBlob , E.createMemBlob , E.memBlobTH , E.unpackMemBlob ) where import GHC.TypeLits (KnownNat, type (^)) import qualified Clash.Explicit.BlockRam.Blob as E import Clash.Signal (hideClock, hideEnable, HiddenClock, HiddenEnable, Signal) import Clash.Sized.BitVector (BitVector) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (NFDataX) -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining -- write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' -- ('blockRamBlob' content) rd wrM@. blockRamBlob :: forall dom addr m n . ( HiddenClock dom , HiddenEnable dom , Enum addr , NFDataX addr ) => E.MemBlob n m -- ^ Initial content of the BRAM, also determines the size, @n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamBlob = hideEnable (hideClock E.blockRamBlob) {-# INLINE blockRamBlob #-} -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining -- write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' -- ('blockRamBlobPow2' content) rd wrM@. blockRamBlobPow2 :: forall dom m n . ( HiddenClock dom , HiddenEnable dom , KnownNat n ) => E.MemBlob (2^n) m -- ^ Initial content of the BRAM, also determines the size, 2^@n@, of the BRAM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamBlobPow2 = hideEnable (hideClock E.blockRamBlobPow2) {-# INLINE blockRamBlobPow2 #-} clash-prelude-1.8.1/src/Clash/Prelude/BlockRam/File.hs0000644000000000000000000001515707346545000020601 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2019 , Myrtle Software Ltd, 2017 , Google Inc., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Initializing a block RAM with a data file #usingramfiles# Block RAM primitives that can be initialized with a data file. The BNF grammar for this data file is simple: @ FILE = LINE+ LINE = BIT+ BIT = '0' | '1' @ Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: @ 000000111 000001000 000001001 000001010 000001011 000001100 000001101 @ Such a file can be produced with 'E.memFile': @ writeFile "memory.bin" (memFile Nothing [7 :: Unsigned 9 .. 13]) @ We can instantiate a block RAM using the contents of the file above like so: @ f :: (HiddenClock dom, HiddenEnable dom) => Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) f rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' d7 \"memory.bin\" rd (pure Nothing) @ In the example above, we basically treat the block RAM as a synchronous ROM. We can see that it works as expected: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ f (fromList [3..5])__ [10,11,12] @ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ g :: (HiddenClock dom, HiddenEnable dom) => Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) g clk rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' d7 \"memory.bin\" rd (pure Nothing) @ And then we would see: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ g (fromList [3..5])__ [(1,2),(1,3)(1,-4)] @ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.BlockRam.File ( -- * Block RAM synchronized to an arbitrary clock blockRamFile , blockRamFilePow2 -- * Producing files , E.memFile ) where import GHC.TypeLits (KnownNat) import GHC.Stack (HasCallStack, withFrozenCallStack) import qualified Clash.Explicit.BlockRam.File as E import Clash.Promoted.Nat (SNat) import Clash.Signal (HiddenClock, HiddenEnable, Signal, hideClock, hideEnable) import Clash.Sized.BitVector (BitVector) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (NFDataX) -- | Create a block RAM with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' ('blockRamFilePow2' file) rd wrM@. -- * See "Clash.Prelude.BlockRam.File#usingramfiles" for more information on how -- to instantiate a block RAM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. blockRamFilePow2 :: forall dom n m . ( KnownNat m , KnownNat n , HiddenClock dom , HiddenEnable dom , HasCallStack ) => FilePath -- ^ File describing the initial content of the BRAM -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamFilePow2 = \fp rd wrM -> withFrozenCallStack (hideEnable (hideClock E.blockRamFilePow2) fp rd wrM) {-# INLINE blockRamFilePow2 #-} -- | Create a block RAM with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- block RAM. -- * Use the adapter 'Clash.Prelude.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Prelude.BlockRam.readNew' ('blockRamFile' size file) rd wrM@. -- * See "Clash.Prelude.BlockRam.File#usingramfiles" for more information on how -- to instantiate a block RAM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. blockRamFile :: ( KnownNat m , Enum addr , NFDataX addr , HiddenClock dom , HiddenEnable dom , HasCallStack ) => SNat n -- ^ Size of the BRAM -> FilePath -- ^ File describing the initial content of the BRAM -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, BitVector m)) -- ^ (write address @w@, value to write) -> Signal dom (BitVector m) -- ^ Value of the BRAM at address @r@ from the previous clock cycle blockRamFile = \sz fp rd wrM -> withFrozenCallStack (hideEnable (hideClock E.blockRamFile) sz fp rd wrM) {-# INLINE blockRamFile #-} clash-prelude-1.8.1/src/Clash/Prelude/DataFlow.hs0000644000000000000000000004646107346545000017733 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Self-synchronizing circuits based on data-flow principles. -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.DataFlow {-# DEPRECATED "Module will be removed in Clash 1.10 in favor of clash-protocols. See: https://github.com/clash-lang/clash-protocols/." #-} ( -- * Data types DataFlow (..) -- * Creating DataFlow circuits , liftDF , pureDF , mealyDF , mooreDF , fifoDF -- * Composition combinators , idDF , seqDF , firstDF , swapDF , secondDF , parDF , parNDF , loopDF , loopDF_nobuf -- * Lock-Step operation , LockStep (..) ) where import GHC.TypeLits (KnownNat, type (+), type (^)) import Prelude hiding ((++), (!!), length, map, repeat, tail, unzip3, zip3, zipWith) import Clash.Class.BitPack (boolToBV) import Clash.Class.Resize (truncateB) import Clash.Class.BitPack.BitIndex (msb) import Clash.Explicit.Mealy (mealyB) import Clash.Promoted.Nat (SNat) import Clash.Signal (KnownDomain, (.&&.)) import Clash.Signal.Bundle (Bundle (..)) import Clash.Explicit.Signal (Clock, Reset, Signal, Enable, andEnable, register) import Clash.Sized.BitVector (BitVector) import Clash.Sized.Vector import Clash.XException (errorX, NFDataX) {- | Dataflow circuit with bidirectional synchronization channels. In the /forward/ direction we assert /validity/ of the data. In the /backward/ direction we assert that the circuit is /ready/ to receive new data. A circuit adhering to the 'DataFlow' type should: * Not consume data when validity is deasserted. * Only update its output when readiness is asserted. The 'DataFlow' type is defined as: @ newtype DataFlow' dom iEn oEn i o = DF { df :: 'Signal' dom i -- Incoming data -> 'Signal' dom iEn -- Flagged with /valid/ bits @iEn@. -> 'Signal' dom oEn -- Incoming back-pressure, /ready/ edge. -> ( 'Signal' dom o -- Outgoing data. , 'Signal' dom oEn -- Flagged with /valid/ bits @oEn@. , 'Signal' dom iEn -- Outgoing back-pressure, /ready/ edge. ) } @ where: * @dom@ is the domain to which the circuit is synchronized. * @iEn@ is the type of the bidirectional incoming synchronization channel. * @oEn@ is the type of the bidirectional outgoing synchronization channel. * @i@ is the incoming data type. * @o@ is the outgoing data type. We define several composition operators for our 'DataFlow' circuits: * 'seqDF' sequential composition. * 'parDF' parallel composition. * 'loopDF' add a feedback arc. * 'lockStep' proceed in lock-step. When you look at the types of the above operators it becomes clear why we parametrize in the types of the synchronization channels. -} newtype DataFlow dom iEn oEn i o = DF { -- | Create an ordinary circuit from a 'DataFlow' circuit df :: Signal dom i -- Incoming data -> Signal dom iEn -- Flagged with /valid/ bits @iEn@. -> Signal dom oEn -- Incoming back-pressure, /ready/ edge. -> ( Signal dom o -- Outgoing data. , Signal dom oEn -- Flagged with /valid/ bits @oEn@. , Signal dom iEn -- Outgoing back-pressure, /ready/ edge. ) } -- | Dataflow circuit synchronized to the 'Clash.Signal.systemClockGen'. -- type DataFlow iEn oEn i o = DataFlow' systemClockGen iEn oEn i o -- | Create a 'DataFlow' circuit from a circuit description with the appropriate -- type: -- -- @ -- 'Signal' dom i -- Incoming data. -- -> 'Signal' dom Bool -- Flagged with a single /valid/ bit. -- -> 'Signal' dom Bool -- Incoming back-pressure, /ready/ bit. -- -> ( 'Signal' dom o -- Outgoing data. -- , 'Signal' dom oEn -- Flagged with a single /valid/ bit. -- , 'Signal' dom iEn -- Outgoing back-pressure, /ready/ bit. -- ) -- @ -- -- A circuit adhering to the 'DataFlow' type should: -- -- * Not consume data when validity is deasserted. -- * Only update its output when readiness is asserted. liftDF :: ( Signal dom i -> Signal dom Bool -> Signal dom Bool -> (Signal dom o, Signal dom Bool, Signal dom Bool)) -> DataFlow dom Bool Bool i o liftDF = DF -- | Create a 'DataFlow' circuit where the given function @f@ operates on the -- data, and the synchronization channels are passed unaltered. pureDF :: (i -> o) -> DataFlow dom Bool Bool i o pureDF f = DF (\i iV oR -> (fmap f i,iV,oR)) -- | Create a 'DataFlow' circuit from a Mealy machine description as those of -- "Clash.Prelude.Mealy" mealyDF :: ( KnownDomain dom , NFDataX s ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> (s,o)) -> s -> DataFlow dom Bool Bool i o mealyDF clk rst gen f iS = DF (\i iV oR -> let en = iV .&&. oR (s',o) = unbundle (f <$> s <*> i) s = register clk rst (andEnable gen en) iS s' in (o,iV,oR)) -- | Create a 'DataFlow' circuit from a Moore machine description as those of -- "Clash.Prelude.Moore" mooreDF :: ( KnownDomain dom , NFDataX s ) => Clock dom -> Reset dom -> Enable dom -> (s -> i -> s) -> (s -> o) -> s -> DataFlow dom Bool Bool i o mooreDF clk rst gen ft fo iS = DF (\i iV oR -> let en = iV .&&. oR s' = ft <$> s <*> i s = register clk rst (andEnable gen en) iS s' o = fo <$> s in (o,iV,oR)) fifoDF_mealy :: forall addrSize a . KnownNat addrSize => (Vec (2^addrSize) a, BitVector (addrSize + 1), BitVector (addrSize + 1)) -> (a, Bool, Bool) -> ((Vec (2^addrSize) a, BitVector (addrSize + 1), BitVector (addrSize + 1)) ,(a, Bool, Bool)) fifoDF_mealy (mem,rptr,wptr) (wdata,winc,rinc) = let raddr = truncateB rptr :: BitVector addrSize waddr = truncateB wptr :: BitVector addrSize mem' | winc && not full = replace waddr wdata mem | otherwise = mem rdata = mem !! raddr rptr' = rptr + boolToBV (rinc && not empty) wptr' = wptr + boolToBV (winc && not full) empty = rptr == wptr full = msb rptr /= msb wptr && raddr == waddr in ((mem',rptr',wptr'), (rdata,empty,full)) -- | Create a FIFO buffer adhering to the 'DataFlow' protocol. Can be filled -- with initial content. -- -- To create a FIFO of size 4, with two initial values 2 and 3 you would write: -- -- @ -- fifo4 = 'fifoDF' d4 (2 :> 3 :> Nil) -- @ fifoDF :: forall addrSize m n a dom . ( KnownDomain dom , NFDataX a , KnownNat addrSize , KnownNat n , KnownNat m , (m + n) ~ (2 ^ addrSize) ) => Clock dom -> Reset dom -> Enable dom -> SNat (m + n) -- ^ Depth of the FIFO buffer. Must be a power of two. -> Vec m a -- ^ Initial content. Can be smaller than the size of the -- FIFO. Empty spaces are initialized with 'undefined'. -> DataFlow dom Bool Bool a a fifoDF clk rst en _ iS = DF $ \i iV oR -> let initRdPtr = 0 initWrPtr = fromIntegral (length iS) initMem = iS ++ repeat (errorX "fifoDF: undefined") :: Vec (m + n) a initS = (initMem,initRdPtr,initWrPtr) (o,empty,full) = mealyB clk rst en fifoDF_mealy initS (i,iV,oR) in (o,not <$> empty, not <$> full) -- | Identity circuit -- -- <> idDF :: DataFlow dom en en a a idDF = DF (\a val rdy -> (a,val,rdy)) -- | Sequential composition of two 'DataFlow' circuits. -- -- <> seqDF :: DataFlow dom aEn bEn a b -> DataFlow dom bEn cEn b c -> DataFlow dom aEn cEn a c (DF f) `seqDF` (DF g) = DF (\a aVal cRdy -> let (b,bVal,aRdy) = f a aVal bRdy (c,cVal,bRdy) = g b bVal cRdy in (c,cVal,aRdy)) -- | Apply the circuit to the first halve of the communication channels, leave -- the second halve unchanged. -- -- <> firstDF :: DataFlow dom aEn bEn a b -> DataFlow dom (aEn, cEn) (bEn, cEn) (a, c) (b, c) firstDF (DF f) = DF (\ac acV bcR -> let (a,c) = unbundle ac (aV,cV) = unbundle acV (bR,cR) = unbundle bcR (b,bV,aR) = f a aV bR bc = bundle (b,c) bcV = bundle (bV,cV) acR = bundle (aR,cR) in (bc,bcV,acR) ) -- | Swap the two communication channels. -- -- <> swapDF :: DataFlow dom (aEn, bEn) (bEn, aEn) (a, b) (b, a) swapDF = DF (\ab abV baR -> (swap <$> ab, swap <$> abV, swap <$> baR)) where swap ~(a,b) = (b,a) -- | Apply the circuit to the second halve of the communication channels, leave -- the first halve unchanged. -- -- <> secondDF :: DataFlow dom aEn bEn a b -> DataFlow dom (cEn, aEn) (cEn, bEn) (c, a) (c, b) secondDF f = swapDF `seqDF` firstDF f `seqDF` swapDF -- | Compose two 'DataFlow' circuits in parallel. -- -- <> parDF :: DataFlow dom aEn bEn a b -> DataFlow dom cEn dEn c d -> DataFlow dom (aEn, cEn) (bEn, dEn) (a, c) (b, d) f `parDF` g = firstDF f `seqDF` secondDF g -- | Compose /n/ 'DataFlow' circuits in parallel. parNDF :: KnownNat n => Vec n (DataFlow dom aEn bEn a b) -> DataFlow dom (Vec n aEn) (Vec n bEn) (Vec n a) (Vec n b) parNDF fs = DF (\as aVs bRs -> let as' = unbundle as aVs' = unbundle aVs bRs' = unbundle bRs (bs,bVs,aRs) = unzip3 (zipWith (\k (a,b,r) -> df k a b r) fs (zip3 (lazyV as') (lazyV aVs') bRs')) in (bundle bs,bundle bVs, bundle aRs) ) -- | Feed back the second halve of the communication channel. The feedback loop -- is buffered by a 'fifoDF' circuit. -- -- So given a circuit /h/ with two synchronization channels: -- -- @ -- __h__ :: 'DataFlow' (Bool,Bool) (Bool,Bool) (a,d) (b,d) -- @ -- -- Feeding back the /d/ part (including its synchronization channels) results -- in: -- -- @ -- 'loopDF' d4 Nil h -- @ -- -- <> -- -- When you have a circuit @h'@, with only a single synchronization channel: -- -- @ -- __h'__ :: 'DataFlow' Bool Bool (a,d) (b,d) -- @ -- -- and you want to compose /h'/ in a feedback loop, the following will not work: -- -- @ -- f \`@'seqDF'@\` ('loopDF' d4 Nil h') \`@'seqDF'@\` g -- @ -- -- The circuits @f@, @h@, and @g@, must operate in /lock-step/ because the /h'/ -- circuit only has a single synchronization channel. Consequently, there -- should only be progress when all three circuits are producing /valid/ data -- and all three circuits are /ready/ to receive new data. We need to compose -- /h'/ with the 'lockStep' and 'stepLock' functions to achieve the /lock-step/ -- operation. -- -- @ -- f \`@'seqDF'@\` ('lockStep' \`@'seqDF'@\` 'loopDF' d4 Nil h' \`@'seqDF'@\` 'stepLock') \`@'seqDF'@\` g -- @ -- -- <> loopDF :: ( KnownDomain dom , NFDataX d , KnownNat m , KnownNat n , KnownNat addrSize , (m+n) ~ (2^addrSize) ) => Clock dom -> Reset dom -> Enable dom -> SNat (m + n) -- ^ Depth of the FIFO buffer. Must be a power of two -> Vec m d -- ^ Initial content of the FIFO buffer. Can be smaller than the size of the -- FIFO. Empty spaces are initialized with 'undefined'. -> DataFlow dom (Bool,Bool) (Bool,Bool) (a,d) (b,d) -> DataFlow dom Bool Bool a b loopDF clk rst en sz is (DF f) = DF (\a aV bR -> let (bd,bdV,adR) = f ad adV bdR (b,d) = unbundle bd (bV,dV) = unbundle bdV (aR,dR) = unbundle adR (d_buf,dV_buf,dR_buf) = df (fifoDF clk rst en sz is) d dV dR ad = bundle (a,d_buf) adV = bundle (aV,dV_buf) bdR = bundle (bR,dR_buf) in (b,bV,aR) ) -- | Feed back the second halve of the communication channel. Unlike 'loopDF', -- the feedback loop is /not/ buffered. loopDF_nobuf :: DataFlow dom (Bool,Bool) (Bool,Bool) (a,d) (b,d) -> DataFlow dom Bool Bool a b loopDF_nobuf (DF f) = DF (\a aV bR -> let (bd,bdV,adR) = f ad adV bdR (b,d) = unbundle bd (bV,dV) = unbundle bdV (aR,dR) = unbundle adR ad = bundle (a,d) adV = bundle (aV,dV) bdR = bundle (bR,dR) in (b,bV,aR) ) -- | Reduce or extend the synchronization granularity of parallel compositions. class LockStep a b where -- | Reduce the synchronization granularity to a single 'Bool'ean value. -- -- Given: -- -- @ -- __f__ :: 'DataFlow' Bool Bool a b -- __g__ :: 'DataFlow' Bool Bool c d -- __h__ :: 'DataFlow' Bool Bool (b,d) (p,q) -- @ -- -- We /cannot/ simply write: -- -- @ -- (f \`@'parDF'@\` g) \`@'seqDF'@\` h -- @ -- -- because, @f \`parDF\` g@, has type, @'DataFlow' (Bool,Bool) (Bool,Bool) (a,c) (b,d)@, -- which does not match the expected synchronization granularity of @h@. We -- need a circuit in between that has the type: -- -- @ -- 'DataFlow' (Bool,Bool) Bool (b,d) (b,d) -- @ -- -- Simply '&&'-ing the /valid/ signals in the forward direction, and -- duplicating the /ready/ signal in the backward direction is however not -- enough. We also need to make sure that @f@ does not update its output when -- @g@'s output is invalid and visa versa, as @h@ can only consume its input -- when both @f@ and @g@ are producing valid data. @g@'s /ready/ port is hence -- only asserted when @h@ is ready and @f@ is producing /valid/ data. And @f@'s -- ready port is only asserted when @h@ is ready and @g@ is producing valid -- data. @f@ and @g@ will hence be proceeding in /lock-step/. -- -- The 'lockStep' function ensures that all synchronization signals are -- properly connected: -- -- @ -- (f \`@'parDF'@\` g) \`@'seqDF'@\` 'lockStep' \`@'seqDF'@\` h -- @ -- -- <> -- -- __Note 1__: ensure that the components that you are synchronizing have -- buffered/delayed @ready@ and @valid@ signals, or 'lockStep' has the -- potential to introduce combinational loops. You can do this by placing -- 'fifoDF's on the parallel channels. Extending the above example, you would -- write: -- -- @ -- ((f \`@'seqDF'@\` 'fifoDF' d4 Nil) \`@'parDF'@\` (g \`@'seqDF'@\` 'fifoDF' d4 Nil)) \`@'seqDF'@\` 'lockStep' \`@'seqDF'@\` h -- @ -- -- __Note 2__: 'lockStep' works for arbitrarily nested tuples. That is: -- -- @ -- p :: 'DataFlow' Bool Bool ((b,d),d) z -- -- q :: 'DataFlow' ((Bool,Bool),Bool) ((Bool,Bool),Bool) ((a,c),c) ((b,d),d) -- q = f \`@'parDF'@\` g \`@'parDF'@\` g -- -- r = q \`@'seqDF'@\` 'lockStep' \`@'seqDF'@\` p -- @ -- -- Does the right thing. lockStep :: DataFlow dom a Bool b b -- | Extend the synchronization granularity from a single 'Bool'ean value. -- -- Given: -- -- @ -- __f__ :: 'DataFlow' Bool Bool a b -- __g__ :: 'DataFlow' Bool Bool c d -- __h__ :: 'DataFlow' Bool Bool (p,q) (a,c) -- @ -- -- We /cannot/ simply write: -- -- @ -- h \`@'seqDF'@\` (f \`@'parDF'@\` g) -- @ -- -- because, @f \`parDF\` g@, has type, @'DataFlow' (Bool,Bool) (Bool,Bool) (a,c) (b,d)@, -- which does not match the expected synchronization granularity of @h@. We -- need a circuit in between that has the type: -- -- @ -- 'DataFlow' Bool (Bool,Bool) (a,c) (a,c) -- @ -- -- Simply '&&'-ing the /ready/ signals in the backward direction, and -- duplicating the /valid/ signal in the forward direction is however not -- enough. We need to make sure that @f@ does not consume values when @g@ is -- not /ready/ and visa versa, because @h@ cannot update the values of its -- output tuple independently. @f@'s /valid/ port is hence only asserted when -- @h@ is valid and @g@ is ready to receive new values. @g@'s /valid/ port is -- only asserted when @h@ is valid and @f@ is ready to receive new values. -- @f@ and @g@ will hence be proceeding in /lock-step/. -- -- The 'stepLock' function ensures that all synchronization signals are -- properly connected: -- -- @ -- h \`@'seqDF'@\` 'stepLock' \`@'seqDF'@\` (f \`@'parDF'@\` g) -- @ -- -- <> -- -- __Note 1__: ensure that the components that you are synchronizing have -- buffered/delayed @ready@ and @valid@ signals, or 'stepLock' has the -- potential to introduce combinational loops. You can do this by placing -- 'fifoDF's on the parallel channels. Extending the above example, you would -- write: -- -- @ -- h \`@'seqDF'@\` 'stepLock' \`@'seqDF'@\` ((`fifoDF` d4 Nil \`@'seqDF'@\` f) \`@'parDF'@\` (`fifoDF` d4 Nil \`@'seqDF'@\` g)) -- @ -- -- __Note 2__: 'stepLock' works for arbitrarily nested tuples. That is: -- -- @ -- p :: 'DataFlow' Bool Bool z ((a,c),c) -- -- q :: 'DataFlow' ((Bool,Bool),Bool) ((Bool,Bool),Bool) ((a,c),c) ((b,d),d) -- q = f \`@'parDF'@\` g \`@'parDF'@\` g -- -- r = p \`@'seqDF'@\` 'stepLock' \`@'seqDF'@\` q -- @ -- -- Does the right thing. stepLock :: DataFlow dom Bool a b b instance LockStep Bool c where lockStep = idDF stepLock = idDF instance (LockStep a x, LockStep b y) => LockStep (a,b) (x,y) where lockStep = (lockStep `parDF` lockStep) `seqDF` (DF (\xy xyV rdy -> let (xV,yV) = unbundle xyV val = xV .&&. yV xR = yV .&&. rdy yR = xV .&&. rdy xyR = bundle (xR,yR) in (xy,val,xyR))) stepLock = (DF (\xy val xyR -> let (xR,yR) = unbundle xyR rdy = xR .&&. yR xV = val .&&. yR yV = val .&&. xR xyV = bundle (xV,yV) in (xy,xyV,rdy))) `seqDF` (stepLock `parDF` stepLock) instance (LockStep en a, KnownNat n) => LockStep (Vec n en) (Vec n a) where lockStep = parNDF (repeat lockStep) `seqDF` DF (\xs vals rdy -> let val = (and . (True :>)) <$> vals rdys = allReady <$> rdy <*> (repeat . (:< True) <$> vals) in (xs,val,rdys) ) stepLock = DF (\xs val rdys -> let rdy = (and . (True :>)) <$> rdys vals = allReady <$> val <*> (repeat . (:< True) <$> rdys) in (xs,vals,rdy) ) `seqDF` parNDF (repeat stepLock) allReady :: KnownNat n => Bool -> Vec n (Vec (n+1) Bool) -> Vec n Bool allReady b vs = map (and . (b :>) . tail) (smap (flip rotateLeftS) vs) clash-prelude-1.8.1/src/Clash/Prelude/Mealy.hs0000644000000000000000000001541007346545000017267 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd 2023 , Alex Mason License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Whereas the output of a Moore machine depends on the /previous state/, the output of a Mealy machine depends on /current transition/. Mealy machines are strictly more expressive, but may impose stricter timing requirements. -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} module Clash.Prelude.Mealy ( -- * Mealy machine synchronized to the system clock mealy , mealyS , mealyB , mealySB , (<^>) ) where import qualified Clash.Explicit.Mealy as E import Clash.Signal import Clash.XException (NFDataX) import Control.Monad.State.Strict (State) {- $setup >>> :set -XDataKinds -XTypeApplications -XDeriveGeneric -XDeriveAnyClass >>> import Clash.Prelude as C >>> import Clash.Prelude.Mealy (mealyS) >>> import qualified Data.List as L >>> import Control.Lens (Lens', (%=), (-=), uses, use) >>> import Control.Monad.State.Strict (State) >>> :{ let macT s (x,y) = (s',s) where s' = x * y + s mac = mealy macT 0 :} >>> :{ data DelayState = DelayState { _history :: Vec 4 Int , _untilValid :: Index 4 } deriving (Generic,NFDataX) :} >>> :{ history :: Lens' DelayState (Vec 4 Int) history f = \(DelayState d u) -> (`DelayState` u) <$> f d :} >>> :{ untilValid :: Lens' DelayState (Index 4) untilValid f = \(DelayState d u) -> DelayState d <$> f u :} >>> :{ delayS :: Int -> State DelayState (Maybe Int) delayS n = do history %= (n +>>) remaining <- use untilValid if remaining > 0 then do untilValid -= 1 return Nothing else do out <- uses history C.last return (Just out) :} >>> let initialDelayState = DelayState (C.repeat 0) maxBound >>> :{ delayTop :: HiddenClockResetEnable dom => Signal dom Int -> Signal dom (Maybe Int) delayTop = mealyS delayS initialDelayState :} -} -- | Create a synchronous function from a combinational function describing -- a mealy machine -- -- @ -- macT -- :: Int -- Current state -- -> (Int,Int) -- Input -- -> (Int,Int) -- (Updated state, output) -- macT s (x,y) = (s',s) -- where -- s' = x * y + s -- -- mac :: HiddenClockResetEnable dom => 'Signal' dom (Int, Int) -> 'Signal' dom Int -- mac = 'mealy' macT 0 -- @ -- -- >>> simulate @System mac [(0,0),(1,1),(2,2),(3,3),(4,4)] -- [0,0,1,5,14... -- ... -- -- Synchronous sequential functions can be composed just like their -- combinational counterpart: -- -- @ -- dualMac -- :: HiddenClockResetEnable dom -- => ('Signal' dom Int, 'Signal' dom Int) -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> 'Signal' dom Int -- dualMac (a,b) (x,y) = s1 + s2 -- where -- s1 = 'mealy' macT 0 ('Clash.Signal.bundle' (a,x)) -- s2 = 'mealy' macT 0 ('Clash.Signal.bundle' (b,y)) -- @ mealy :: ( HiddenClockResetEnable dom , NFDataX s ) => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@ -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealy = hideClockResetEnable E.mealy {-# INLINE mealy #-} -- | A version of 'mealy' that does automatic 'Bundle'ing -- -- Given a function @f@ of type: -- -- @ -- __f__ :: Int -> (Bool, Int) -> (Int, (Int, Bool)) -- @ -- -- When we want to make compositions of @f@ in @g@ using 'mealy', we have to -- write: -- -- @ -- g a b c = (b1,b2,i2) -- where -- (i1,b1) = 'Clash.Signal.unbundle' ('mealy' f 0 ('Clash.Signal.bundle' (a,b))) -- (i2,b2) = 'Clash.Signal.unbundle' ('mealy' f 3 ('Clash.Signal.bundle' (c,i1))) -- @ -- -- Using 'mealyB' however we can write: -- -- @ -- g a b c = (b1,b2,i2) -- where -- (i1,b1) = 'mealyB' f 0 (a,b) -- (i2,b2) = 'mealyB' f 3 (c,i1) -- @ mealyB :: ( HiddenClockResetEnable dom , NFDataX s , Bundle i , Bundle o ) => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@ -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealyB = hideClockResetEnable E.mealyB {-# INLINE mealyB #-} -- | Create a synchronous function from a combinational function describing -- a mealy machine using the state monad. This can be particularly useful -- when combined with lenses or optics to replicate imperative algorithms. -- -- @ -- data DelayState = DelayState -- { _history :: Vec 4 Int -- , _untilValid :: Index 4 -- } -- deriving (Generic, NFDataX) -- makeLenses ''DelayState -- -- initialDelayState = DelayState (repeat 0) maxBound -- -- delayS :: Int -> State DelayState (Maybe Int) -- delayS n = do -- history %= (n +>>) -- remaining <- use untilValid -- if remaining > 0 -- then do -- untilValid -= 1 -- return Nothing -- else do -- out <- uses history last -- return (Just out) -- -- delayTop :: HiddenClockResetEnable dom => 'Signal' dom Int -> 'Signal' dom (Maybe Int) -- delayTop = 'mealyS' delayS initialDelayState -- @ -- -- >>> L.take 7 $ simulate @System delayTop [1,2,3,4,5,6,7,8] -- [Nothing,Nothing,Nothing,Just 1,Just 2,Just 3,Just 4] -- ... -- mealyS :: ( HiddenClockResetEnable dom , NFDataX s ) => (i -> State s o) -- ^ Transfer function in mealy machine handling inputs using @Control.Monad.Strict.State s@. -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealyS = hideClockResetEnable E.mealyS {-# INLINE mealyS #-} -- | A version of 'mealyS' that does automatic 'Bundle'ing, see 'mealyB' for details. mealySB :: ( HiddenClockResetEnable dom , NFDataX s , Bundle i , Bundle o ) => (i -> State s o) -- ^ Transfer function in mealy machine handling inputs using @Control.Monad.Strict.State s@. -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine mealySB = hideClockResetEnable E.mealySB {-# INLINE mealySB #-} -- | Infix version of 'mealyB' (<^>) :: ( HiddenClockResetEnable dom , NFDataX s , Bundle i , Bundle o ) => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@ -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine (<^>) = mealyB {-# INLINE (<^>) #-} clash-prelude-1.8.1/src/Clash/Prelude/Moore.hs0000644000000000000000000001012007346545000017272 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente 2017 , Google Inc. 2019 , Myrtle Software Ltd License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Whereas the output of a Mealy machine depends on /current transition/, the output of a Moore machine depends on the /previous state/. Moore machines are strictly less expressive, but may impose laxer timing requirements. -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} module Clash.Prelude.Moore ( -- * Moore machine moore , mooreB , medvedev , medvedevB ) where import qualified Clash.Explicit.Moore as E import Clash.Signal import Clash.XException (NFDataX) {- $setup >>> :set -XDataKinds -XTypeApplications >>> :m -Clash.Explicit.Prelude >>> :m -Clash.Explicit.Prelude.Safe >>> import Clash.Prelude >>> :{ let macT s (x,y) = x * y + s mac = moore macT id 0 :} -} -- | Create a synchronous function from a combinational function describing -- a moore machine -- -- @ -- macT -- :: Int -- Current state -- -> (Int,Int) -- Input -- -> Int -- Updated state -- macT s (x,y) = x * y + s -- -- mac -- :: HiddenClockResetEnable dom -- => 'Signal' dom (Int, Int) -- -> 'Signal' dom Int -- mac = 'moore' mac id 0 -- @ -- -- >>> simulate @System mac [(0,0),(1,1),(2,2),(3,3),(4,4)] -- [0,0,1,5,14,30,... -- ... -- -- Synchronous sequential functions can be composed just like their -- combinational counterpart: -- -- @ -- dualMac -- :: HiddenClockResetEnable dom -- => ('Signal' dom Int, 'Signal' dom Int) -- -> ('Signal' dom Int, 'Signal' dom Int) -- -> 'Signal' dom Int -- dualMac (a,b) (x,y) = s1 + s2 -- where -- s1 = 'moore' macT id 0 ('Clash.Signal.bundle' (a,x)) -- s2 = 'moore' macT id 0 ('Clash.Signal.bundle' (b,y)) -- @ moore :: ( HiddenClockResetEnable dom , NFDataX s ) => (s -> i -> s) -- ^ Transfer function in moore machine form: @state -> input -> newstate@ -> (s -> o) -- ^ Output function in moore machine form: @state -> output@ -> s -- ^ Initial state -> (Signal dom i -> Signal dom o) -- ^ Synchronous sequential function with input and output matching that -- of the moore machine moore = hideClockResetEnable E.moore {-# INLINE moore #-} -- | Create a synchronous function from a combinational function describing -- a moore machine without any output logic medvedev :: ( HiddenClockResetEnable dom , NFDataX s ) => (s -> i -> s) -> s -> (Signal dom i -> Signal dom s) medvedev tr st = moore tr id st {-# INLINE medvedev #-} -- | A version of 'moore' that does automatic 'Bundle'ing -- -- Given a functions @t@ and @o@ of types: -- -- @ -- __t__ :: Int -> (Bool, Int) -> Int -- __o__ :: Int -> (Int, Bool) -- @ -- -- When we want to make compositions of @t@ and @o@ in @g@ using 'moore', we have to -- write: -- -- @ -- g a b c = (b1,b2,i2) -- where -- (i1,b1) = 'Clash.Signal.unbundle' ('moore' t o 0 ('Clash.Signal.bundle' (a,b))) -- (i2,b2) = 'Clash.Signal.unbundle' ('moore' t o 3 ('Clash.Signal.bundle' (c,i1))) -- @ -- -- Using 'mooreB' however we can write: -- -- @ -- g a b c = (b1,b2,i2) -- where -- (i1,b1) = 'mooreB' t o 0 (a,b) -- (i2,b2) = 'mooreB' t o 3 (c,i1) -- @ mooreB :: ( HiddenClockResetEnable dom , NFDataX s , Bundle i , Bundle o ) => (s -> i -> s) -- ^ Transfer function in moore machine form: @state -> input -> newstate@ -> (s -> o) -- ^ Output function in moore machine form: @state -> output@ -> s -- ^ Initial state -> (Unbundled dom i -> Unbundled dom o) -- ^ Synchronous sequential function with input and output matching that -- of the moore machine mooreB = hideClockResetEnable E.mooreB {-# INLINE mooreB #-} -- | A version of 'medvedev' that does automatic 'Bundle'ing medvedevB :: ( HiddenClockResetEnable dom , NFDataX s , Bundle i , Bundle s ) => (s -> i -> s) -> s -> (Unbundled dom i -> Unbundled dom s) medvedevB tr st = mooreB tr id st {-# INLINE medvedevB #-} clash-prelude-1.8.1/src/Clash/Prelude/RAM.hs0000644000000000000000000000471507346545000016645 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017 , Google Inc., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. RAM primitives with a combinational read port -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.RAM ( -- * RAM synchronized to an arbitrary clock asyncRam , asyncRamPow2 ) where import GHC.TypeLits (KnownNat) import GHC.Stack (HasCallStack, withFrozenCallStack) import qualified Clash.Explicit.RAM as E import Clash.Promoted.Nat (SNat) import Clash.Signal import Clash.Sized.Unsigned (Unsigned) import Clash.XException (NFDataX) -- | Create a RAM with space for @n@ elements -- -- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- RAM. asyncRam :: ( Enum addr , NFDataX addr , HiddenClock dom , HiddenEnable dom , HasCallStack , NFDataX a ) => SNat n -- ^ Size @n@ of the RAM -> Signal dom addr -- ^ Read address @r@ -> Signal dom (Maybe (addr, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the RAM at address @r@ asyncRam = \sz rd wrM -> withFrozenCallStack (hideEnable (\en -> hideClock (\clk -> E.asyncRam clk clk en sz rd wrM))) {-# INLINE asyncRam #-} -- | Create a RAM with space for 2^@n@ elements -- -- * __NB__: Initial content of the RAM is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a -- RAM. asyncRamPow2 :: ( KnownNat n , HiddenClock dom , HiddenEnable dom , HasCallStack , NFDataX a ) => Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (Maybe (Unsigned n, a)) -- ^ (write address @w@, value to write) -> Signal dom a -- ^ Value of the RAM at address @r@ asyncRamPow2 = \rd wrM -> withFrozenCallStack (hideEnable (\en -> (hideClock (\clk -> E.asyncRamPow2 clk clk en rd wrM)))) {-# INLINE asyncRamPow2 #-} clash-prelude-1.8.1/src/Clash/Prelude/ROM.hs0000644000000000000000000001302207346545000016652 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. ROMs -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.ROM ( -- * Asynchronous ROM asyncRom , asyncRomPow2 -- * Synchronous ROM synchronized to an arbitrary clock , rom , romPow2 -- * Internal , asyncRom# ) where import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding (length) import Clash.Annotations.Primitive (hasBlackBox) import qualified Clash.Explicit.ROM as E import Clash.Signal import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Vector (Vec, length, toList) import Clash.XException (NFDataX, deepErrorX) -- | An asynchronous/combinational ROM with space for @n@ elements -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Prelude.ROM.File.asyncRomFile' and -- 'Clash.Prelude.ROM.Blob.asyncRomBlob' for different approaches that scale -- well. asyncRom :: ( KnownNat n , Enum addr , NFDataX a ) => Vec n a -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> addr -- ^ Read address @r@ -> a -- ^ The value of the ROM at address @r@ asyncRom = \content rd -> asyncRom# content (fromEnum rd) {-# INLINE asyncRom #-} -- | An asynchronous/combinational ROM with space for 2^@n@ elements -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Prelude.ROM.File.asyncRomFilePow2' and -- 'Clash.Prelude.ROM.Blob.asyncRomBlobPow2' for different approaches that scale -- well. asyncRomPow2 :: ( KnownNat n , NFDataX a ) => Vec (2^n) a -- ^ ROM content -- -- __NB__: __MUST__ be a constant -> Unsigned n -- ^ Read address @r@ -> a -- ^ The value of the ROM at address @r@ asyncRomPow2 = asyncRom {-# INLINE asyncRomPow2 #-} -- | asyncRom primitive asyncRom# :: forall n a . ( KnownNat n , NFDataX a ) => Vec n a -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Int -- ^ Read address @r@ -> a -- ^ The value of the ROM at address @r@ asyncRom# content = safeAt where szI = length content arr = listArray (0,szI-1) (toList content) safeAt :: Int -> a safeAt i = if (0 <= i) && (i < szI) then unsafeAt arr i else withFrozenCallStack (deepErrorX ("asyncRom: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE asyncRom# #-} {-# ANN asyncRom# hasBlackBox #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Prelude.ROM.File.romFile' and -- 'Clash.Prelude.ROM.Blob.romBlob' for different approaches that scale well. rom :: forall dom n m a . ( NFDataX a , KnownNat n , KnownNat m , HiddenClock dom , HiddenEnable dom ) => Vec n a -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned m) -- ^ Read address @r@ -> Signal dom a -- ^ The value of the ROM at address @r@ from the previous clock cycle rom = hideEnable (hideClock E.rom) {-# INLINE rom #-} -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and "Clash.Prelude.BlockRam#usingrams" -- for ideas on how to use ROMs and RAMs. -- * A large 'Vec' for the content may be too inefficient, depending on how it -- is constructed. See 'Clash.Prelude.ROM.File.romFilePow2' and -- 'Clash.Prelude.ROM.Blob.romBlobPow2' for different approaches that scale -- well. romPow2 :: forall dom n a . ( KnownNat n , NFDataX a , HiddenClock dom , HiddenEnable dom ) => Vec (2^n) a -- ^ ROM content -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom a -- ^ The value of the ROM at address @r@ from the previous clock cycle romPow2 = hideEnable (hideClock E.romPow2) {-# INLINE romPow2 #-} clash-prelude-1.8.1/src/Clash/Prelude/ROM/0000755000000000000000000000000007346545000016320 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Prelude/ROM/Blob.hs0000644000000000000000000001245007346545000017534 0ustar0000000000000000{-| Copyright : (C) 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Efficient bundling of ROM content with the compiled code Leveraging Template Haskell, the content for the ROM components in this module is stored alongside the compiled Haskell code. It covers use cases where passing the initial content as a 'Clash.Sized.Vector.Vec' turns out to be problematically slow. The data is stored efficiently, with very little overhead (worst-case 7%, often no overhead at all). Unlike "Clash.Prelude.ROM.File", "Clash.Prelude.ROM.Blob" generates practically the same HDL as "Clash.Prelude.ROM" and is compatible with all tools consuming the generated HDL. -} {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.ROM.Blob ( -- * Asynchronous ROM defined by a 'MemBlob' asyncRomBlob , asyncRomBlobPow2 -- * Synchronous 'MemBlob' ROM synchronized to an arbitrary clock , romBlob , romBlobPow2 -- * Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- * Internal , asyncRomBlob# ) where import Data.Array (listArray) import Data.Array.Base (unsafeAt) import GHC.Stack (withFrozenCallStack) import GHC.TypeLits (KnownNat, type (^)) import Clash.Annotations.Primitive (hasBlackBox) import qualified Clash.Explicit.ROM.Blob as E import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH) import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob) import Clash.Promoted.Nat (natToNum) import Clash.Signal (hideClock, hideEnable, HiddenClock, HiddenEnable) import Clash.Signal.Internal (Signal) import Clash.Sized.Internal.BitVector (BitVector) import Clash.Sized.Internal.Unsigned (Unsigned) import Clash.XException (deepErrorX) -- | An asynchronous/combinational ROM with space for @n@ elements -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Prelude.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. asyncRomBlob :: Enum addr => MemBlob n m -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> addr -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomBlob = \content rd -> asyncRomBlob# content (fromEnum rd) {-# INLINE asyncRomBlob #-} -- | An asynchronous/combinational ROM with space for 2^@n@ elements -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Prelude.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. asyncRomBlobPow2 :: KnownNat n => MemBlob (2^n) m -- ^ ROM content, also determines the size, 2^@n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Unsigned n -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomBlobPow2 = asyncRomBlob {-# INLINE asyncRomBlobPow2 #-} -- | asyncRomBlob primitive asyncRomBlob# :: forall m n . MemBlob n m -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Int -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomBlob# content@MemBlob{} = safeAt where szI = natToNum @n @Int arr = listArray (0,szI-1) $ unpackMemBlob content safeAt :: Int -> BitVector m safeAt i = if (0 <= i) && (i < szI) then unsafeAt arr i else withFrozenCallStack (deepErrorX ("asyncRom: address " ++ show i ++ " not in range [0.." ++ show szI ++ ")")) {-# ANN asyncRomBlob# hasBlackBox #-} -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE asyncRomBlob# #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlob :: forall dom addr m n . ( HiddenClock dom , HiddenEnable dom , Enum addr ) => MemBlob n m -- ^ ROM content, also determines the size, @n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom addr -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romBlob = hideEnable (hideClock E.romBlob) {-# INLINE romBlob #-} -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- -- === See also: -- -- * See "Clash.Sized.Fixed#creatingdatafiles" and -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlobPow2 :: forall dom m n . ( HiddenClock dom , HiddenEnable dom , KnownNat n ) => MemBlob (2^n) m -- ^ ROM content, also determines the size, 2^@n@, of the ROM -- -- __NB__: __MUST__ be a constant -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romBlobPow2 = hideEnable (hideClock E.romBlobPow2) {-# INLINE romBlobPow2 #-} clash-prelude-1.8.1/src/Clash/Prelude/ROM/File.hs0000644000000000000000000002623207346545000017540 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente, 2017 , Google Inc., 2019 , Myrtle Software Ltd, 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. = Initializing a ROM with a data file #usingromfiles# ROMs initialized with a data file. The BNF grammar for this data file is simple: @ FILE = LINE+ LINE = BIT+ BIT = '0' | '1' @ Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: @ 000000111 000001000 000001001 000001010 000001011 000001100 000001101 @ Such a file can be produced with 'memFile': @ writeFile "memory.bin" (memFile Nothing [7 :: Unsigned 9 .. 13]) @ We can instantiate a synchronous ROM using the contents of the file above like so: @ f :: (HiddenClock dom, HiddenEnable dom) => Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) f rd = 'Clash.Class.BitPack.unpack' '<$>' 'romFile' d7 \"memory.bin\" rd @ And see that it works as expected: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ f (fromList [3..5])__ [10,11,12] @ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ g :: (HiddenClock dom, HiddenEnable dom) => Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) g rd = 'Clash.Class.BitPack.unpack' '<$>' 'romFile' d7 \"memory.bin\" rd @ And then we would see: @ __>>> import qualified Data.List as L__ __>>> L.tail $ sampleN 4 $ g (fromList [3..5])__ [(1,2),(1,3)(1,-4)] @ -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.ROM.File ( -- * Asynchronous ROM asyncRomFile , asyncRomFilePow2 -- * Synchronous ROM synchronized to an arbitrary clock , romFile , romFilePow2 -- * Producing files , memFile -- * Internal , asyncRomFile# ) where import Data.Array (listArray,(!)) import GHC.TypeLits (KnownNat) import System.IO.Unsafe (unsafePerformIO) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.File (initMem, memFile) import qualified Clash.Explicit.ROM.File as E import Clash.Promoted.Nat (SNat (..), pow2SNat, snatToNum) import Clash.Signal import Clash.Sized.BitVector (BitVector) import Clash.Sized.Unsigned (Unsigned) -- | An asynchronous/combinational ROM with space for @n@ elements -- -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. -- * When you notice that 'asyncRomFile' is significantly slowing down your -- simulation, give it a /monomorphic/ type signature. So instead of leaving -- the type to be inferred: -- -- @ -- myRomData = asyncRomFile d512 "memory.bin" -- @ -- -- or giving it a /polymorphic/ type signature: -- -- @ -- myRomData :: Enum addr => addr -> BitVector 16 -- myRomData = asyncRomFile d512 "memory.bin" -- @ -- -- you __should__ give it a /monomorphic/ type signature: -- -- @ -- myRomData :: Unsigned 9 -> BitVector 16 -- myRomData = asyncRomFile d512 "memory.bin" -- @ asyncRomFile :: (KnownNat m, Enum addr) => SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> addr -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomFile sz file = asyncRomFile# sz file . fromEnum -- Leave 'asyncRomFile#' eta-reduced, see Note [Eta-reduction and unsafePerformIO initMem] {-# INLINE asyncRomFile #-} -- Note [Eta-reduction and unsafePerformIO initMem] -- -- The 'initMem' function initializes a @[BitVector n]@ from file. Ideally, -- we want this IO action to happen only once. When we call 'unsafePerformIO' -- on @initMem file@, it becomes a thunk in that function, so is hence evaluated -- only once. However, me must ensure that any code calling using of the -- @unsafePerformIO (initMem file)@ thunk also becomes a thunk. We do this by -- eta-reducing function where needed so that a thunk is returned. -- -- For example, instead of writing: -- -- > asyncRomFile# sz file rd = (content ! rd) -- > where -- > mem = unsafePerformIO (initMem file) -- > content = listArray (0,szI-1) mem -- > szI = snatToNum sz -- -- We write: -- -- > asyncRomFile# sz file = (content !) -- > where -- > mem = unsafePerformIO (initMem file) -- > content = listArray (0,szI-1) mem -- > szI = snatToNum sz -- -- Where instead of returning the BitVector defined by @(content ! rd)@, we -- return the function (thunk) @(content !)@. -- | An asynchronous/combinational ROM with space for 2^@n@ elements -- -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. -- * When you notice that 'asyncRomFilePow2' is significantly slowing down your -- simulation, give it a /monomorphic/ type signature. So instead of leaving the -- type to be inferred: -- -- @ -- myRomData = asyncRomFilePow2 "memory.bin" -- @ -- -- you __should__ give it a /monomorphic/ type signature: -- -- @ -- myRomData :: Unsigned 9 -> BitVector 16 -- myRomData = asyncRomFilePow2 "memory.bin" -- @ asyncRomFilePow2 :: forall n m . (KnownNat m, KnownNat n) => FilePath -- ^ File describing the content of the ROM -> Unsigned n -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomFilePow2 = asyncRomFile (pow2SNat (SNat @n)) {-# INLINE asyncRomFilePow2 #-} -- | asyncRomFile primitive asyncRomFile# :: KnownNat m => SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> Int -- ^ Read address @r@ -> BitVector m -- ^ The value of the ROM at address @r@ asyncRomFile# sz file = (content !) -- Leave "(content !)" eta-reduced, see where -- Note [Eta-reduction and unsafePerformIO initMem] mem = unsafePerformIO (initMem file) content = listArray (0,szI-1) mem szI = snatToNum sz -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE asyncRomFile# #-} {-# ANN asyncRomFile# hasBlackBox #-} -- | A ROM with a synchronous read port, with space for @n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. romFile :: ( KnownNat m , KnownNat n , HiddenClock dom , HiddenEnable dom , Enum addr ) => SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> Signal dom addr -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romFile = hideEnable (hideClock E.romFile) {-# INLINE romFile #-} -- | A ROM with a synchronous read port, with space for 2^@n@ elements -- -- * __NB__: Read value is delayed by 1 cycle -- * __NB__: Initial output value is /undefined/, reading it will throw an -- 'Clash.XException.XException' -- * __NB__: This function might not work for specific combinations of -- code-generation backends and hardware targets. Please check the support table -- below: -- -- +----------------+----------+----------+---------------+ -- | | VHDL | Verilog | SystemVerilog | -- +================+==========+==========+===============+ -- | Altera/Quartus | Broken | Works | Works | -- +----------------+----------+----------+---------------+ -- | Xilinx/ISE | Works | Works | Works | -- +----------------+----------+----------+---------------+ -- | ASIC | Untested | Untested | Untested | -- +----------------+----------+----------+---------------+ -- -- === See also: -- -- * See "Clash.Prelude.ROM.File#usingromfiles" for more information on how -- to instantiate a ROM with the contents of a data file. -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. romFilePow2 :: forall n m dom . ( KnownNat m , KnownNat n , HiddenClock dom , HiddenEnable dom ) => FilePath -- ^ File describing the content of the ROM -> Signal dom (Unsigned n) -- ^ Read address @r@ -> Signal dom (BitVector m) -- ^ The value of the ROM at address @r@ from the previous clock cycle romFilePow2 = hideEnable (hideClock E.romFilePow2) {-# INLINE romFilePow2 #-} clash-prelude-1.8.1/src/Clash/Prelude/Safe.hs0000644000000000000000000002116507346545000017102 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017-2019, Myrtle Software Ltd 2017 , Google Inc., 2021-2022, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. __This is the API only of "Clash.Prelude"__ Clash is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The merits of using a functional language to describe hardware comes from the fact that combinational circuits can be directly modeled as mathematical functions and that functional languages lend themselves very well at describing and (de-)composing mathematical functions. This package provides: * Prelude library containing datatypes and functions for circuit design To use the library: * Import "Clash.Prelude" * Additionally import "Clash.Explicit.Prelude" if you want to design explicitly clocked circuits in a multi-clock setting For now, "Clash.Prelude" is also the best starting point for exploring the library. A preliminary version of a tutorial can be found in "Clash.Tutorial". Some circuit examples can be found in "Clash.Examples". -} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions, not-home #-} module Clash.Prelude.Safe ( -- * Creating synchronous sequential circuits mealy , mealyS , mealyB , mealySB , (<^>) , moore , mooreB , registerB -- * ROMs , asyncRom , asyncRomPow2 , rom , romPow2 -- ** ROMs defined by a 'MemBlob' , asyncRomBlob , asyncRomBlobPow2 , romBlob , romBlobPow2 -- * RAM primitives with a combinational read port , asyncRam , asyncRamPow2 -- * BlockRAM primitives , blockRam , blockRamPow2 -- ** BlockRAM primitives initialized with a 'MemBlob' , blockRamBlob , blockRamBlobPow2 -- *** Creating and inspecting 'MemBlob' , MemBlob , createMemBlob , memBlobTH , unpackMemBlob -- ** BlockRAM read/write conflict resolution , readNew -- ** True dual-port block RAM , trueDualPortBlockRam , RamOp(..) -- * Utility functions , isRising , isFalling , riseEvery , oscillate -- * Exported modules -- ** Synchronous signals , module Clash.Signal , module Clash.Signal.Delayed -- ** Datatypes -- *** Bit vectors , module Clash.Sized.BitVector -- *** Arbitrary-width numbers , module Clash.Sized.Signed , module Clash.Sized.Unsigned , module Clash.Sized.Index -- *** Fixed point numbers , module Clash.Sized.Fixed -- *** Fixed size vectors , module Clash.Sized.Vector -- *** Perfect depth trees , module Clash.Sized.RTree -- ** Annotations , module Clash.Annotations.TopEntity -- ** Generics type-classes , Generic , Generic1 -- ** Type-level natural numbers , module GHC.TypeLits , module GHC.TypeLits.Extra , module Clash.Promoted.Nat , module Clash.Promoted.Nat.Literals , module Clash.Promoted.Nat.TH -- ** Type-level strings , module Clash.Promoted.Symbol -- ** Type classes -- *** Clash , module Clash.Class.BitPack , module Clash.Class.Num , module Clash.Class.Resize -- *** Other , module Control.Applicative , module Data.Bits -- ** Exceptions , module Clash.XException -- ** Named types , module Clash.NamedTypes -- ** Hidden arguments , module Clash.Hidden -- ** Haskell Prelude -- $hiding , module Clash.HaskellPrelude ) where import Control.Applicative import Data.Bits import GHC.Generics (Generic, Generic1) import GHC.TypeLits #if MIN_VERSION_base(4,18,0) hiding (SNat, SSymbol, fromSNat) #endif import GHC.TypeLits.Extra import Clash.HaskellPrelude import Clash.Annotations.TopEntity import Clash.Class.BitPack import Clash.Class.Num import Clash.Class.Resize import Clash.Hidden import Clash.NamedTypes import Clash.Prelude.BlockRam import Clash.Prelude.BlockRam.Blob import qualified Clash.Explicit.Prelude.Safe as E import Clash.Prelude.Mealy (mealy, mealyB, mealyS, mealySB, (<^>)) import Clash.Prelude.Moore (moore, mooreB) import Clash.Prelude.RAM (asyncRam,asyncRamPow2) import Clash.Prelude.ROM (asyncRom,asyncRomPow2,rom,romPow2) import Clash.Prelude.ROM.Blob import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals import Clash.Promoted.Symbol 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 hiding (fromList, unsafeFromList) import Clash.Signal import Clash.Signal.Delayed import Clash.XException {- $setup >>> :set -XFlexibleContexts -XTypeApplications >>> :m -Prelude >>> :m -Clash.Explicit.Prelude >>> import Clash.Prelude.Safe >>> let rP = registerB (8,8) -} {- $hiding "Clash.Prelude.Safe" re-exports most of the Haskell "Prelude" with the exception of those functions that the Clash API defines to work on 'Vec' from "Clash.Sized.Vector" instead of on lists as the Haskell Prelude does. In addition, for the 'Clash.Class.Parity.odd' and 'Clash.Class.Parity.even' functions a type class called 'Clash.Class.Parity.Parity' is available at "Clash.Class.Parity". -} -- | Create a 'register' function for product-type like signals (e.g. '(Signal a, Signal b)') -- -- > rP :: HiddenClockResetEnable dom -- > => (Signal dom Int, Signal dom Int) -- > -> (Signal dom Int, Signal dom Int) -- > rP = registerB (8,8) -- -- >>> simulateB @System rP [(1,1),(2,2),(3,3)] :: [(Int,Int)] -- [(8,8),(1,1),(2,2),(3,3)... -- ... registerB :: ( HiddenClockResetEnable dom , NFDataX a , Bundle a ) => a -> Unbundled dom a -> Unbundled dom a registerB = hideClockResetEnable E.registerB infixr 3 `registerB` {-# INLINE registerB #-} -- | Give a pulse when the 'Signal' goes from 'minBound' to 'maxBound' isRising :: ( HiddenClockResetEnable dom , NFDataX a , Bounded a , Eq a ) => a -- ^ Starting value -> Signal dom a -> Signal dom Bool isRising = hideClockResetEnable E.isRising {-# INLINE isRising #-} -- | Give a pulse when the 'Signal' goes from 'maxBound' to 'minBound' isFalling :: ( HiddenClockResetEnable dom , NFDataX a , Bounded a , Eq a ) => a -- ^ Starting value -> Signal dom a -> Signal dom Bool isFalling = hideClockResetEnable E.isFalling {-# INLINE isFalling #-} -- | Give a pulse every @n@ clock cycles. This is a useful helper function when -- combined with functions like @'Clash.Signal.regEn'@ or @'Clash.Signal.mux'@, -- in order to delay a register by a known amount. -- -- To be precise: the given signal will be @'False'@ for the next @n-1@ cycles, -- followed by a single @'True'@ value: -- -- >>> Prelude.last (sampleN @System 1025 (riseEvery d1024)) == True -- True -- >>> Prelude.or (sampleN @System 1024 (riseEvery d1024)) == False -- True -- -- For example, to update a counter once every 10 million cycles: -- -- @ -- counter = 'Clash.Signal.regEn' 0 ('riseEvery' ('SNat' :: 'SNat' 10000000)) (counter + 1) -- @ riseEvery :: HiddenClockResetEnable dom => SNat n -> Signal dom Bool riseEvery = hideClockResetEnable E.riseEvery {-# INLINE riseEvery #-} -- | Oscillate a @'Bool'@ for a given number of cycles. This is a convenient -- function when combined with something like @'regEn'@, as it allows you to -- easily hold a register value for a given number of cycles. The input @'Bool'@ -- determines what the initial value is. -- -- To oscillate on an interval of 5 cycles: -- -- >>> sampleN @System 11 (oscillate False d5) -- [False,False,False,False,False,False,True,True,True,True,True] -- -- To oscillate between @'True'@ and @'False'@: -- -- >>> sampleN @System 11 (oscillate False d1) -- [False,False,True,False,True,False,True,False,True,False,True] -- -- An alternative definition for the above could be: -- -- >>> let osc' = register False (not <$> osc') -- >>> sampleN @System 200 (oscillate False d1) == sampleN @System 200 osc' -- True oscillate :: HiddenClockResetEnable dom => Bool -> SNat n -> Signal dom Bool oscillate = hideClockResetEnable E.oscillate {-# INLINE oscillate #-} clash-prelude-1.8.1/src/Clash/Prelude/Synchronizer.hs0000644000000000000000000000565607346545000020730 0ustar0000000000000000{-| Copyright : (C) 2019, Myrtle Software Ltd, License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Synchronizer circuits for safe clock domain crossings -} {-# LANGUAGE TypeFamilies #-} module Clash.Prelude.Synchronizer ( -- * Bit-synchronizers dualFlipFlopSynchronizer -- * Word-synchronizers , asyncFIFOSynchronizer ) where import qualified Clash.Explicit.Synchronizer as E import Clash.Promoted.Nat (SNat) import Clash.Signal (HiddenClockResetEnable, HiddenClock, Signal, hasClock, hasReset, hasEnable) import Clash.XException (NFDataX) import GHC.TypeLits (type (<=)) -- | Synchronizer based on two sequentially connected flip-flops. -- -- * __NB__: This synchronizer can be used for __bit__-synchronization. -- -- * __NB__: Although this synchronizer does reduce metastability, it does -- not guarantee the proper synchronization of a whole __word__. For -- example, given that the output is sampled twice as fast as the input is -- running, and we have two samples in the input stream that look like: -- -- @[0111,1000]@ -- -- But the circuit driving the input stream has a longer propagation delay -- on __msb__ compared to the __lsb__s. What can happen is an output stream -- that looks like this: -- -- @[0111,0111,0000,1000]@ -- -- Where the level-change of the __msb__ was not captured, but the level -- change of the __lsb__s were. -- -- If you want to have /safe/ __word__-synchronization use -- 'asyncFIFOSynchronizer'. dualFlipFlopSynchronizer :: ( NFDataX a , HiddenClock dom1 , HiddenClockResetEnable dom2 ) => a -- ^ Initial value of the two synchronization registers -> Signal dom1 a -- ^ Incoming data -> Signal dom2 a -- ^ Outgoing, synchronized, data dualFlipFlopSynchronizer = E.dualFlipFlopSynchronizer hasClock hasClock hasReset hasEnable -- | Synchronizer implemented as a FIFO around an asynchronous RAM. Based on the -- design described in "Clash.Tutorial#multiclock", which is itself based on the -- design described in . -- -- __NB__: This synchronizer can be used for __word__-synchronization. asyncFIFOSynchronizer :: ( HiddenClockResetEnable rdom , HiddenClockResetEnable wdom , 2 <= addrSize , NFDataX a ) => SNat addrSize -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ -- elements. -> Signal rdom Bool -- ^ Read request -> Signal wdom (Maybe a) -- ^ Element to insert -> (Signal rdom a, Signal rdom Bool, Signal wdom Bool) -- ^ (Oldest element in the FIFO, @empty@ flag, @full@ flag) asyncFIFOSynchronizer addrSize = E.asyncFIFOSynchronizer addrSize hasClock -- wdom hasClock -- rdom hasReset -- wdom hasReset -- rdom hasEnable -- wdom hasEnable -- rdom clash-prelude-1.8.1/src/Clash/Prelude/Testbench.hs0000644000000000000000000001473607346545000020151 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2017 , Google Inc. 2019 , Myrtle Software Ltd, 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Prelude.Testbench ( -- * Testbench functions for circuits assert , assertBitVector , ignoreFor , outputVerifier' , outputVerifierBitVector' , stimuliGenerator , E.tbClockGen , E.tbEnableGen , E.tbSystemClockGen , E.clockToDiffClock ) where import GHC.TypeLits (KnownNat, type (<=)) import qualified Clash.Explicit.Testbench as E import Clash.Signal (HiddenClock, HiddenReset, HiddenClockResetEnable, Signal, hideClock, hideReset, hideClockResetEnable) import Clash.Promoted.Nat (SNat) import Clash.Sized.BitVector (BitVector) import Clash.Sized.Vector (Vec) import Clash.XException (ShowX) {- $setup >>> :set -XTemplateHaskell -XDataKinds -XTypeApplications >>> :m -Clash.Explicit.Prelude >>> :m -Clash.Explicit.Prelude.Safe >>> :m -Clash.Explicit.Testbench >>> import Clash.Prelude >>> import Clash.Prelude.Testbench >>> let testInput = stimuliGenerator $(listToVecTH [(1::Int),3..21]) >>> let expectedOutput = outputVerifier' $(listToVecTH ([70,99,2,3,4,5,7,8,9,10]::[Int])) -} -- | Compares the first two 'Signal's for equality and logs a warning when they -- are not equal. The second 'Signal' is considered the expected value. This -- function simply returns the third 'Signal' unaltered as its result. This -- function is used by 'outputVerifier''. -- -- === Usage in @clashi@ #assert-clashi# -- -- __NB__: When simulating a component that uses 'assert' in @clashi@, usually, -- the warnings are only logged the first time the component is simulated. -- Issuing @:reload@ in @clashi@ will discard the cached result of the -- computation, and warnings will once again be emitted. -- -- __NB__: This function /can/ be used in synthesizable designs. assert :: (Eq a, ShowX a, HiddenClock dom , HiddenReset dom ) => String -- ^ Additional message -> Signal dom a -- ^ Checked value -> Signal dom a -- ^ Expected value -> Signal dom b -- ^ Return value -> Signal dom b 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 its 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 #-} -- | -- -- Example: -- -- @ -- testInput -- :: HiddenClockResetEnable dom -- => 'Signal' dom Int -- testInput = 'stimuliGenerator' $('Clash.Sized.Vector.listToVecTH' [(1::Int),3..21]) -- @ -- -- >>> sampleN @System 13 testInput -- [1,1,3,5,7,9,11,13,15,17,19,21,21] stimuliGenerator :: ( KnownNat l , HiddenClock dom , HiddenReset dom ) => Vec l a -- ^ Samples to generate -> Signal dom a -- ^ Signal of given samples stimuliGenerator = hideReset (hideClock E.stimuliGenerator) {-# INLINE stimuliGenerator #-} -- | Compare a signal (coming from a circuit) to a vector of samples. If a -- sample from the signal is not equal to the corresponding sample in the -- vector, print to stderr and continue testing. This function is -- synthesizable in the sense that HDL simulators will run it. -- -- __NB__: This function uses 'assert'. When simulating this function in -- @clashi@, read the [note](#assert-clashi). -- -- Example: -- -- @ -- expectedOutput -- :: HiddenClockResetEnable dom -- -> 'Signal' dom Int -> 'Signal' dom Bool -- expectedOutput = 'outputVerifier'' $('Clash.Sized.Vector.listToVecTH' ([70,99,2,3,4,5,7,8,9,10]::[Int])) -- @ -- -- >>> import qualified Data.List as List -- >>> sampleN @System 12 (expectedOutput (fromList (0:[0..10] List.++ [10,10,10]))) -- -- cycle(): 0, outputVerifier -- expected value: 70, not equal to actual value: 0 -- [False -- cycle(): 1, outputVerifier -- expected value: 70, not equal to actual value: 0 -- ,False -- cycle(): 2, outputVerifier -- expected value: 99, not equal to actual value: 1 -- ,False,False,False,False,False -- cycle(): 7, outputVerifier -- expected value: 7, not equal to actual value: 6 -- ,False -- cycle(): 8, outputVerifier -- expected value: 8, not equal to actual value: 7 -- ,False -- cycle(): 9, outputVerifier -- expected value: 9, not equal to actual value: 8 -- ,False -- cycle(): 10, outputVerifier -- expected value: 10, not equal to actual value: 9 -- ,False,True] -- -- If you're working with 'BitVector's containing don't care bits you should use 'outputVerifierBitVector''. outputVerifier' :: ( KnownNat l , Eq a , ShowX a , HiddenClock dom , HiddenReset dom , 1 <= l ) => Vec l a -- ^ Samples to compare with -> Signal dom a -- ^ Signal to verify -> Signal dom Bool -- ^ Indicator that all samples are verified outputVerifier' = hideReset (hideClock E.outputVerifier') {-# INLINE outputVerifier' #-} -- | Same as 'outputVerifier'', -- but can handle don't care bits in its expected values. outputVerifierBitVector' :: ( KnownNat l , KnownNat n , HiddenClock dom , HiddenReset dom , 1 <= l ) => Vec l (BitVector n) -- ^ Samples to compare with -> Signal dom (BitVector n) -- ^ Signal to verify -> Signal dom Bool -- ^ Indicator that all samples are verified outputVerifierBitVector' = hideReset (hideClock E.outputVerifierBitVector') {-# INLINE outputVerifierBitVector' #-} -- | Ignore signal for a number of cycles, while outputting a static value. ignoreFor :: HiddenClockResetEnable dom => SNat n -- ^ Number of cycles to ignore incoming signal -> a -- ^ Value function produces when ignoring signal -> Signal dom a -- ^ Incoming signal -> Signal dom a -- ^ Either a passthrough of the incoming signal, or the static value -- provided as the second argument. ignoreFor = hideClockResetEnable E.ignoreFor {-# INLINE ignoreFor #-} clash-prelude-1.8.1/src/Clash/Promoted/0000755000000000000000000000000007346545000016054 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Promoted/Nat.hs0000644000000000000000000003700307346545000017135 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016 , Myrtle Software Ltd 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Promoted.Nat ( -- * Singleton natural numbers -- ** Data type SNat (..) -- ** Construction , snatProxy , withSNat -- ** Conversion , snatToInteger, snatToNatural, snatToNum -- ** Conversion (ambiguous types) , natToInteger, natToNatural, natToNum -- ** Arithmetic , addSNat, mulSNat, powSNat, minSNat, maxSNat, succSNat -- *** Partial , subSNat, divSNat, modSNat, flogBaseSNat, clogBaseSNat, logBaseSNat, predSNat -- *** Specialised , pow2SNat -- *** Comparison , SNatLE (..), compareSNat -- * Unary/Peano-encoded natural numbers -- ** Data type , UNat (..) -- ** Construction , toUNat -- ** Conversion , fromUNat -- ** Arithmetic , addUNat, mulUNat, powUNat -- *** Partial , predUNat, subUNat -- * Base-2 encoded natural numbers -- ** Data type , BNat (..) -- ** Construction , toBNat -- ** Conversion , fromBNat -- ** Pretty printing base-2 encoded natural numbers , showBNat -- ** Arithmetic , succBNat, addBNat, mulBNat, powBNat -- *** Partial , predBNat, div2BNat, div2Sub1BNat, log2BNat -- ** Normalisation , stripZeros -- * Constraints on natural numbers , leToPlus , leToPlusKN ) 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) import GHC.Natural (naturalFromInteger) import Language.Haskell.TH (appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift (..)) #if MIN_VERSION_template_haskell(2,16,0) import Language.Haskell.TH.Compat #endif import Numeric.Natural (Natural) import Unsafe.Coerce (unsafeCoerce) import Clash.Annotations.Primitive (hasBlackBox) import Clash.XException (ShowX (..), showsPrecXWith) {- $setup >>> :set -XBinaryLiterals >>> import Clash.Promoted.Nat.Literals (d789) -} -- | Singleton value for a type-level natural number @n@ -- -- * "Clash.Promoted.Nat.Literals" contains a list of predefined 'SNat' literals -- * "Clash.Promoted.Nat.TH" has functions to easily create large ranges of new -- 'SNat' literals data SNat (n :: Nat) where SNat :: KnownNat n => SNat n instance Lift (SNat n) where lift s = sigE [| SNat |] (appT (conT ''SNat) (litT $ numTyLit (snatToInteger s))) #if MIN_VERSION_template_haskell(2,16,0) liftTyped = liftTypedFromUntyped #endif -- | Create an @`SNat` n@ from a proxy for /n/ snatProxy :: KnownNat n => proxy n -> SNat n snatProxy _ = SNat instance Show (SNat n) where 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 {-# INLINE withSNat #-} -- | Supply a function with a singleton natural @n@ according to the context withSNat :: KnownNat n => (SNat n -> a) -> a withSNat f = f SNat -- | Same as 'snatToInteger' and 'GHC.TypeLits.natVal', but doesn't take term -- arguments. Example usage: -- -- >>> natToInteger @5 -- 5 natToInteger :: forall n . KnownNat n => Integer natToInteger = snatToInteger (SNat @n) {-# INLINE natToInteger #-} -- | Reify the type-level 'Nat' @n@ to it's term-level 'Integer' representation. snatToInteger :: SNat n -> Integer snatToInteger p@SNat = natVal p {-# INLINE snatToInteger #-} -- | Same as 'snatToNatural' and 'GHC.TypeNats.natVal', but doesn't take term -- arguments. Example usage: -- -- >>> natToNatural @5 -- 5 natToNatural :: forall n . KnownNat n => Natural natToNatural = snatToNatural (SNat @n) {-# INLINE natToNatural #-} -- | Reify the type-level 'Nat' @n@ to it's term-level 'Natural'. snatToNatural :: SNat n -> Natural snatToNatural = naturalFromInteger . snatToInteger {-# INLINE snatToNatural #-} -- | Same as 'snatToNum', but doesn't take term arguments. Example usage: -- -- >>> natToNum @5 @Int -- 5 natToNum :: forall n a . (Num a, KnownNat n) => a natToNum = snatToNum (SNat @n) {-# INLINE natToNum #-} -- | Reify the type-level 'Nat' @n@ to it's term-level 'Num'ber. snatToNum :: forall a n . Num a => SNat n -> a snatToNum p@SNat = fromInteger (snatToInteger p) {-# INLINE snatToNum #-} -- | Unary representation of a type-level natural -- -- __NB__: Not synthesizable data UNat :: Nat -> Type where UZero :: UNat 0 USucc :: UNat n -> UNat (n + 1) instance KnownNat n => Show (UNat n) where show x = 'u':show (natVal x) instance KnownNat n => ShowX (UNat n) where showsPrecX = showsPrecXWith showsPrec -- | Convert a singleton natural number to its unary representation -- -- __NB__: Not synthesizable toUNat :: forall n . SNat n -> UNat n toUNat p@SNat = fromI @n (snatToInteger p) where fromI :: forall m . Integer -> UNat m fromI 0 = unsafeCoerce @(UNat 0) @(UNat m) UZero fromI n = unsafeCoerce @(UNat ((m-1)+1)) @(UNat m) (USucc (fromI @(m-1) (n - 1))) -- | Convert a unary-encoded natural number to its singleton representation -- -- __NB__: Not synthesizable fromUNat :: UNat n -> SNat n fromUNat UZero = SNat :: SNat 0 fromUNat (USucc x) = addSNat (fromUNat x) (SNat :: SNat 1) -- | Add two unary-encoded natural numbers -- -- __NB__: Not synthesizable addUNat :: UNat n -> UNat m -> UNat (n + m) addUNat UZero y = y addUNat x UZero = x addUNat (USucc x) y = USucc (addUNat x y) -- | Multiply two unary-encoded natural numbers -- -- __NB__: Not synthesizable mulUNat :: UNat n -> UNat m -> UNat (n * m) mulUNat UZero _ = UZero mulUNat _ UZero = UZero mulUNat (USucc x) y = addUNat y (mulUNat x y) -- | Power of two unary-encoded natural numbers -- -- __NB__: Not synthesizable powUNat :: UNat n -> UNat m -> UNat (n ^ m) powUNat _ UZero = USucc UZero powUNat x (USucc y) = mulUNat x (powUNat x y) -- | Predecessor of a unary-encoded natural number -- -- __NB__: Not synthesizable predUNat :: UNat (n+1) -> UNat n predUNat (USucc x) = x #if __GLASGOW_HASKELL__ != 902 predUNat UZero = error "predUNat: impossible: 0 minus 1, -1 is not a natural number" #endif -- | Subtract two unary-encoded natural numbers -- -- __NB__: Not synthesizable subUNat :: UNat (m+n) -> UNat n -> UNat m subUNat x UZero = x subUNat (USucc x) (USucc y) = subUNat x y subUNat UZero _ = error "subUNat: impossible: 0 + (n + 1) ~ 0" -- | Predecessor of a singleton natural number predSNat :: SNat (a+1) -> SNat (a) predSNat SNat = SNat {-# INLINE predSNat #-} -- | Successor of a singleton natural number succSNat :: SNat a -> SNat (a+1) succSNat SNat = SNat {-# INLINE succSNat #-} -- | Add two singleton natural numbers addSNat :: SNat a -> SNat b -> SNat (a+b) addSNat SNat SNat = SNat {-# INLINE addSNat #-} infixl 6 `addSNat` -- | Subtract two singleton natural numbers subSNat :: SNat (a+b) -> SNat b -> SNat a subSNat SNat SNat = SNat {-# INLINE subSNat #-} infixl 6 `subSNat` -- | Multiply two singleton natural numbers mulSNat :: SNat a -> SNat b -> SNat (a*b) mulSNat SNat SNat = SNat {-# INLINE mulSNat #-} infixl 7 `mulSNat` -- | Power of two singleton natural numbers powSNat :: SNat a -> SNat b -> SNat (a^b) powSNat SNat SNat = SNat -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE powSNat #-} {-# ANN powSNat hasBlackBox #-} infixr 8 `powSNat` -- | Division of two singleton natural numbers divSNat :: (1 <= b) => SNat a -> SNat b -> SNat (Div a b) divSNat SNat SNat = SNat {-# INLINE divSNat #-} infixl 7 `divSNat` -- | Modulo of two singleton natural numbers modSNat :: (1 <= b) => SNat a -> SNat b -> SNat (Mod a b) modSNat SNat SNat = SNat {-# INLINE modSNat #-} infixl 7 `modSNat` minSNat :: SNat a -> SNat b -> SNat (Min a b) minSNat SNat SNat = SNat maxSNat :: SNat a -> SNat b -> SNat (Max a b) maxSNat SNat SNat = SNat -- | Floor of the logarithm of a natural number flogBaseSNat :: (2 <= base, 1 <= x) => SNat base -- ^ Base -> SNat x -> SNat (FLog base x) flogBaseSNat SNat SNat = SNat -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE flogBaseSNat #-} {-# ANN flogBaseSNat hasBlackBox #-} -- | Ceiling of the logarithm of a natural number clogBaseSNat :: (2 <= base, 1 <= x) => SNat base -- ^ Base -> SNat x -> SNat (CLog base x) clogBaseSNat SNat SNat = SNat -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE clogBaseSNat #-} {-# ANN clogBaseSNat hasBlackBox #-} -- | Exact integer logarithm of a natural number -- -- __NB__: Only works when the argument is a power of the base logBaseSNat :: (FLog base x ~ CLog base x) => SNat base -- ^ Base -> SNat x -> SNat (Log base x) logBaseSNat SNat SNat = SNat -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE logBaseSNat #-} {-# ANN logBaseSNat hasBlackBox #-} -- | Power of two of a singleton natural number pow2SNat :: SNat a -> SNat (2^a) pow2SNat SNat = SNat {-# INLINE pow2SNat #-} -- | Ordering relation between two Nats data SNatLE a b where SNatLE :: forall a b . a <= b => SNatLE a b SNatGT :: forall a b . (b+1) <= a => SNatLE a b deriving instance Show (SNatLE a b) -- | Get an ordering relation between two SNats compareSNat :: forall a b . SNat a -> SNat b -> SNatLE a b compareSNat a b = if snatToInteger a <= snatToInteger b then unsafeCoerce (SNatLE @0 @0) else unsafeCoerce (SNatGT @1 @0) -- | Base-2 encoded natural number -- -- * __NB__: The LSB is the left/outer-most constructor: -- * __NB__: Not synthesizable -- -- >>> B0 (B1 (B1 BT)) -- b6 -- -- == Constructors -- -- * Starting/Terminating element: -- -- @ -- __BT__ :: 'BNat' 0 -- @ -- -- * Append a zero (/0/): -- -- @ -- __B0__ :: 'BNat' n -> 'BNat' (2 'GHC.TypeNats.*' n) -- @ -- -- * Append a one (/1/): -- -- @ -- __B1__ :: 'BNat' n -> 'BNat' ((2 'GHC.TypeNats.*' n) 'GHC.TypeNats.+' 1) -- @ data BNat :: Nat -> Type where BT :: BNat 0 B0 :: BNat n -> BNat (2*n) B1 :: BNat n -> BNat ((2*n) + 1) instance KnownNat n => Show (BNat n) where show x = 'b':show (natVal x) instance KnownNat n => ShowX (BNat n) where showsPrecX = showsPrecXWith showsPrec -- | Show a base-2 encoded natural as a binary literal -- -- __NB__: The LSB is shown as the right-most bit -- -- >>> d789 -- d789 -- >>> toBNat d789 -- b789 -- >>> showBNat (toBNat d789) -- "0b1100010101" -- >>> 0b1100010101 :: Integer -- 789 showBNat :: BNat n -> String showBNat = go [] where go :: String -> BNat m -> String go xs BT = "0b" ++ xs go xs (B0 x) = go ('0':xs) x go xs (B1 x) = go ('1':xs) x -- | Convert a singleton natural number to its base-2 representation -- -- __NB__: Not synthesizable toBNat :: SNat n -> BNat n toBNat s@SNat = toBNat' (snatToInteger s) where toBNat' :: forall m . Integer -> BNat m toBNat' 0 = unsafeCoerce BT toBNat' n = case n `divMod` 2 of (n',1) -> unsafeCoerce (B1 (toBNat' @(Div (m-1) 2) n')) (n',_) -> unsafeCoerce (B0 (toBNat' @(Div m 2) n')) -- | Convert a base-2 encoded natural number to its singleton representation -- -- __NB__: Not synthesizable fromBNat :: BNat n -> SNat n fromBNat BT = SNat :: SNat 0 fromBNat (B0 x) = mulSNat (SNat :: SNat 2) (fromBNat x) fromBNat (B1 x) = addSNat (mulSNat (SNat :: SNat 2) (fromBNat x)) (SNat :: SNat 1) -- | Add two base-2 encoded natural numbers -- -- __NB__: Not synthesizable addBNat :: BNat n -> BNat m -> BNat (n+m) addBNat (B0 a) (B0 b) = B0 (addBNat a b) addBNat (B0 a) (B1 b) = B1 (addBNat a b) addBNat (B1 a) (B0 b) = B1 (addBNat a b) addBNat (B1 a) (B1 b) = B0 (succBNat (addBNat a b)) addBNat BT b = b addBNat a BT = a -- | Multiply two base-2 encoded natural numbers -- -- __NB__: Not synthesizable mulBNat :: BNat n -> BNat m -> BNat (n*m) mulBNat BT _ = BT mulBNat _ BT = BT mulBNat (B0 a) b = B0 (mulBNat a b) mulBNat (B1 a) b = addBNat (B0 (mulBNat a b)) b -- | Power of two base-2 encoded natural numbers -- -- __NB__: Not synthesizable powBNat :: BNat n -> BNat m -> BNat (n^m) powBNat _ BT = B1 BT powBNat a (B0 b) = let z = powBNat a b in mulBNat z z powBNat a (B1 b) = let z = powBNat a b in mulBNat a (mulBNat z z) -- | Successor of a base-2 encoded natural number -- -- __NB__: Not synthesizable succBNat :: BNat n -> BNat (n+1) succBNat BT = B1 BT succBNat (B0 a) = B1 a succBNat (B1 a) = B0 (succBNat a) -- | Predecessor of a base-2 encoded natural number -- -- __NB__: Not synthesizable predBNat :: (1 <= n) => BNat n -> BNat (n-1) predBNat (B1 a) = case stripZeros a of BT -> BT a' -> B0 a' predBNat (B0 x) = B1 (predBNat x) -- | Divide a base-2 encoded natural number by 2 -- -- __NB__: Not synthesizable div2BNat :: BNat (2*n) -> BNat n div2BNat BT = BT div2BNat (B0 x) = x div2BNat (B1 _) = error "div2BNat: impossible: 2*n ~ 2*n+1" -- | Subtract 1 and divide a base-2 encoded natural number by 2 -- -- __NB__: Not synthesizable div2Sub1BNat :: BNat (2*n+1) -> BNat n div2Sub1BNat (B1 x) = x div2Sub1BNat _ = error "div2Sub1BNat: impossible: 2*n+1 ~ 2*n" -- | Get the log2 of a base-2 encoded natural number -- -- __NB__: Not synthesizable log2BNat :: BNat (2^n) -> BNat n #if __GLASGOW_HASKELL__ != 902 log2BNat BT = error "log2BNat: log2(0) not defined" #endif log2BNat (B1 x) = case stripZeros x of BT -> BT _ -> error "log2BNat: impossible: 2^n ~ 2x+1" log2BNat (B0 x) = succBNat (log2BNat x) -- | Strip non-contributing zero's from a base-2 encoded natural number -- -- >>> B1 (B0 (B0 (B0 BT))) -- b1 -- >>> showBNat (B1 (B0 (B0 (B0 BT)))) -- "0b0001" -- >>> showBNat (stripZeros (B1 (B0 (B0 (B0 BT))))) -- "0b1" -- >>> stripZeros (B1 (B0 (B0 (B0 BT)))) -- b1 -- -- __NB__: Not synthesizable stripZeros :: BNat n -> BNat n stripZeros BT = BT stripZeros (B1 x) = B1 (stripZeros x) stripZeros (B0 BT) = BT stripZeros (B0 x) = case stripZeros x of BT -> BT k -> B0 k -- | Change a function that has an argument with an @(n ~ (k + m))@ constraint to a -- function with an argument that has an @(k <= n)@ constraint. -- -- === __Examples__ -- -- Example 1 -- -- @ -- f :: Index (n+1) -> Index (n + 1) -> Bool -- -- g :: forall n. (1 'GHC.TypeNats.<=' n) => Index n -> Index n -> Bool -- g a b = 'leToPlus' \@1 \@n (f a b) -- @ -- -- Example 2 -- -- @ -- head :: Vec (n + 1) a -> a -- -- head' :: forall n a. (1 'GHC.TypeNats.<=' n) => Vec n a -> a -- head' = 'leToPlus' @1 @n head -- @ leToPlus :: forall (k :: Nat) (n :: Nat) r . ( k <= n ) => (forall m . (n ~ (k + m)) => r) -- ^ Context with the @(n ~ (k + m))@ constraint -> r leToPlus r = r @(n - k) {-# INLINE leToPlus #-} -- | Same as 'leToPlus' with added 'KnownNat' constraints leToPlusKN :: forall (k :: Nat) (n :: Nat) r . ( k <= n , KnownNat k , KnownNat n ) => (forall m . (n ~ (k + m), KnownNat m) => r) -- ^ Context with the @(n ~ (k + m))@ constraint -> r leToPlusKN r = r @(n - k) {-# INLINE leToPlusKN #-} clash-prelude-1.8.1/src/Clash/Promoted/Nat/0000755000000000000000000000000007346545000016576 5ustar0000000000000000clash-prelude-1.8.1/src/Clash/Promoted/Nat/Literals.hs0000644000000000000000000000141607346545000020713 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij Predefined 'Clash.Promoted.Nat.SNat' singleton literals in the range [0 .. 1024] Defines: @ d0 = SNat :: SNat 0 d1 = SNat :: SNat 1 d2 = SNat :: SNat 2 ... d1024 = SNat :: SNat 1024 @ You can generate more 'Clash.Promoted.Nat.SNat' literals using 'decLiteralsD' from "Clash.Promoted.Nat.TH" -} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions, prune #-} module Clash.Promoted.Nat.Literals where import Clash.Promoted.Nat.TH #ifdef HADDOCK_ONLY -- Don't pollute docs with 1024 SNat literals $(decLiteralsD 0 9) #else $(decLiteralsD 0 1024) #endif clash-prelude-1.8.1/src/Clash/Promoted/Nat/TH.hs0000644000000000000000000000271007346545000017445 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Promoted.Nat.TH ( -- * Declare a single @d\@ literal decLiteralD -- * Declare ranges of @d\@ literals , decLiteralsD ) where import Language.Haskell.TH import Clash.Promoted.Nat {- $setup >>> :set -XDataKinds >>> :m -Prelude >>> import Clash.Prelude >>> let d1111 = SNat :: SNat 1111 >>> let d1200 = SNat :: SNat 1200 >>> let d1201 = SNat :: SNat 1201 >>> let d1202 = SNat :: SNat 1202 -} -- | Create an 'SNat' literal -- -- > $(decLiteralD 1111) -- -- >>> :t d1111 -- d1111 :: SNat 1111 -- decLiteralD :: Integer -> Q [Dec] decLiteralD n = do let suffix = if n < 0 then error ("Can't make negative SNat: " ++ show n) else show n valName = mkName $ 'd':suffix sig <- sigD valName (appT (conT ''SNat) (litT (numTyLit n))) val <- valD (varP valName) (normalB [| SNat |]) [] return [ sig, val ] -- | Create a range of 'SNat' literals -- -- > $(decLiteralsD 1200 1202) -- -- >>> :t d1200 -- d1200 :: SNat 1200 -- >>> :t d1201 -- d1201 :: SNat 1201 -- >>> :t d1202 -- d1202 :: SNat 1202 -- decLiteralsD :: Integer -> Integer -> Q [Dec] decLiteralsD from to = fmap concat $ sequence $ [ decLiteralD n | n <- [from..to] ] clash-prelude-1.8.1/src/Clash/Promoted/Nat/Unsafe.hs0000644000000000000000000000133607346545000020356 0ustar0000000000000000{-| Copyright : (C) 2015-2016, University of Twente 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE Unsafe #-} module Clash.Promoted.Nat.Unsafe (unsafeSNat) where import Data.Reflection (reifyNat) import Unsafe.Coerce (unsafeCoerce) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Promoted.Nat (SNat, snatProxy) -- | I hope you know what you're doing unsafeSNat :: Integer -> SNat k unsafeSNat i = reifyNat i $ (\p -> unsafeCoerce (snatProxy p)) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE unsafeSNat #-} {-# ANN unsafeSNat hasBlackBox #-} clash-prelude-1.8.1/src/Clash/Promoted/Symbol.hs0000644000000000000000000000321707346545000017660 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente 2022 , QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskellQuotes #-} -- Annotations are not allowed in safe Haskell -- {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Promoted.Symbol (SSymbol (..), ssymbolProxy, ssymbolToString) where import Language.Haskell.TH.Syntax import GHC.Show (appPrec) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Clash.Annotations.Primitive (hasBlackBox) -- | Singleton value for a type-level string @s@ data SSymbol (s :: Symbol) where SSymbol :: KnownSymbol s => SSymbol s {-# ANN SSymbol hasBlackBox #-} instance KnownSymbol s => Lift (SSymbol (s :: Symbol)) where -- lift :: t -> Q Exp lift t = pure (AppTypeE (ConE 'SSymbol) tt) where tt = LitT (StrTyLit (ssymbolToString t)) #if MIN_VERSION_template_haskell(2,17,0) liftTyped = unsafeCodeCoerce . lift #elif MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeTExpCoerce . lift #endif instance Show (SSymbol s) where 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 -- /s/ ssymbolProxy :: KnownSymbol s => proxy s -> SSymbol s ssymbolProxy _ = SSymbol {-# INLINE ssymbolToString #-} -- | Reify the type-level 'Symbol' @s@ to it's term-level 'String' -- representation. ssymbolToString :: SSymbol s -> String ssymbolToString s@SSymbol = symbolVal s clash-prelude-1.8.1/src/Clash/Signal.hs0000644000000000000000000021001007346545000016026 0ustar0000000000000000{-| Copyright : (C) 2013-2016, University of Twente, 2016-2019, Myrtle Software Ltd, 2017 , Google Inc., 2021-2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. Clash has synchronous 'Signal's in the form of: @ 'Signal' (dom :: 'Domain') a @ Where /a/ is the type of the value of the 'Signal', for example /Int/ or /Bool/, and /dom/ is the /clock-/ (and /reset-/) domain to which the memory elements manipulating these 'Signal's belong. The type-parameter, /dom/, is of the kind 'Domain' - a simple string. That string refers to a single /synthesis domain/. A synthesis domain describes the behavior of certain aspects of memory elements in it. More specifically, a domain looks like: @ 'DomainConfiguration' { _name :: 'Domain' -- ^ Domain name , _period :: 'Clash.Promoted.Nat.Nat' -- ^ Clock period in /ps/ , _activeEdge :: 'ActiveEdge' -- ^ Active edge of the clock , _resetKind :: 'ResetKind' -- ^ Whether resets are synchronous (edge-sensitive) or asynchronous (level-sensitive) , _initBehavior :: 'InitBehavior' -- ^ Whether the initial (or "power up") value of memory elements is -- unknown/undefined, or configurable to a specific value , _resetPolarity :: ResetPolarity -- ^ Whether resets are active high or active low } @ Check the documentation of each of the types to see the various options Clash provides. In order to specify a domain, an instance of 'KnownDomain' should be made. Clash provides an implementation 'System' with some common options chosen: @ instance KnownDomain "System" where type KnownConf "System" = 'DomainConfiguration "System" 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh @ In words, \"System\" is a synthesis domain with a clock running with a period of 10000 /ps/. Memory elements respond to the rising edge of the clock, asynchronously to changes in their resets, and have defined power up values if applicable. In order to create a new domain, you don't have to instantiate it explicitly. Instead, you can have 'createDomain' create a domain for you. You can also use the same function to subclass existing domains. * __NB__: \"Bad things\"™ happen when you actually use a clock period of @0@, so do __not__ do that! * __NB__: You should be judicious using a clock with period of @1@ as you can never create a clock that goes any faster! * __NB__: Whether 'System' has good defaults depends on your target platform. Check out 'IntelSystem' and 'XilinxSystem' too! -} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK show-extensions #-} module Clash.Signal ( -- * Synchronous signals Signal , BiSignalIn , BiSignalOut , BiSignalDefault(..) -- * Domain , Domain , sameDomain , KnownDomain(..) , KnownConfiguration , ActiveEdge(..) , SActiveEdge(..) , InitBehavior(..) , SInitBehavior(..) , ResetKind(..) , SResetKind(..) , ResetPolarity(..) , SResetPolarity(..) , DomainConfiguration(..) , SDomainConfiguration(..) -- ** Configuration type families , DomainPeriod , DomainActiveEdge , DomainResetKind , DomainInitBehavior , DomainResetPolarity -- *** Convenience types -- **** Simplifying -- $conveniencetypes , HasSynchronousReset , HasAsynchronousReset , HasDefinedInitialValues -- ** Default domains , System , XilinxSystem , IntelSystem , vSystem , vIntelSystem , vXilinxSystem -- ** Domain utilities , VDomainConfiguration(..) , vDomain , createDomain , knownVDomain , clockPeriod , activeEdge , resetKind , initBehavior , resetPolarity -- * Clock , Clock , DiffClock , periodToHz , hzToPeriod #ifdef CLASH_MULTIPLE_HIDDEN -- ** Synchronization primitive , unsafeSynchronizer #endif -- * Reset , Reset , unsafeToReset , unsafeFromReset , unsafeToActiveHigh , unsafeToActiveLow , unsafeFromActiveHigh , unsafeFromActiveLow #ifdef CLASH_MULTIPLE_HIDDEN , convertReset #endif , resetSynchronizer , resetGlitchFilter , holdReset -- * Enabling , Enable , toEnable , fromEnable , E.enableGen -- * Hidden clock, reset, and enable arguments -- $hiddenclockandreset -- ** Monomorphism restriction leads to surprising behavior -- $monomorphism -- ** Hidden clock , HiddenClock , hideClock , exposeClock , withClock #ifdef CLASH_MULTIPLE_HIDDEN , exposeSpecificClock , withSpecificClock #endif , hasClock -- ** Hidden reset , HiddenReset , hideReset , exposeReset , withReset #ifdef CLASH_MULTIPLE_HIDDEN , exposeSpecificReset , withSpecificReset #endif , hasReset -- ** Hidden enable , HiddenEnable , hideEnable , exposeEnable , withEnable #ifdef CLASH_MULTIPLE_HIDDEN , exposeSpecificEnable , withSpecificEnable #endif , hasEnable -- ** Hidden clock, reset, and enable , HiddenClockResetEnable , hideClockResetEnable , exposeClockResetEnable , withClockResetEnable #ifdef CLASH_MULTIPLE_HIDDEN , exposeSpecificClockResetEnable , withSpecificClockResetEnable #endif , SystemClockResetEnable -- * Basic circuit functions , andEnable #ifdef CLASH_MULTIPLE_HIDDEN , andSpecificEnable #endif , dflipflop , delay , delayMaybe , delayEn , register , regMaybe , regEn , mux -- * Simulation and testbench functions , clockGen , resetGen , resetGenN , systemClockGen , systemResetGen -- * Boolean connectives , (.&&.), (.||.) -- * Product/Signal isomorphism , Bundle(..) , EmptyTuple(..) , TaggedEmptyTuple(..) -- * Simulation functions (not synthesizable) , simulate , simulateB , simulateN , simulateWithReset , simulateWithResetN , runUntil -- ** lazy versions , simulate_lazy , simulateB_lazy -- ** Automaton , signalAutomaton -- * List \<-\> Signal conversion (not synthesizable) , sample , sampleN , sampleWithReset , sampleWithResetN , fromList , fromListWithReset -- ** lazy versions , sample_lazy , sampleN_lazy , fromList_lazy -- * QuickCheck combinators , testFor -- * Type classes -- ** 'Eq'-like , (.==.), (./=.) -- ** 'Ord'-like , (.<.), (.<=.), (.>=.), (.>.) -- * Bisignal functions , veryUnsafeToBiSignalIn , readFromBiSignal , writeToBiSignal , mergeBiSignalOuts -- * Internals , HiddenClockName , HiddenResetName , HiddenEnableName -- * Deprecated , unsafeFromHighPolarity , unsafeFromLowPolarity , unsafeToHighPolarity , unsafeToLowPolarity ) where import Control.Arrow.Transformer.Automaton (Automaton) import GHC.TypeLits (type (<=)) import Data.List (uncons) import Data.Proxy (Proxy(..)) import Prelude import Test.QuickCheck (Property, property) #ifdef CLASH_MULTIPLE_HIDDEN import GHC.TypeLits (AppendSymbol) import Clash.Class.HasDomain (WithSingleDomain) #endif import Clash.Class.HasDomain (WithSpecificDomain) import qualified Clash.Explicit.Signal as E import qualified Clash.Explicit.Reset as E import Clash.Explicit.Reset (resetSynchronizer, resetGlitchFilter) import Clash.Explicit.Signal (systemClockGen, systemResetGen) import Clash.Hidden import Clash.Promoted.Nat (SNat (..), snatToNum) 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, signalAutomaton) import Clash.Signal.Internal.Ambiguous (knownVDomain, clockPeriod, activeEdge, resetKind, initBehavior, resetPolarity) import Clash.XException (NFDataX, ShowX) {- $setup >>> :set -XFlexibleContexts -XTypeApplications >>> :m -Prelude >>> import Clash.Prelude >>> import Clash.Promoted.Nat (SNat(..)) >>> import Clash.XException (printX) >>> import Control.Applicative (liftA2) >>> let oscillate = register False (not <$> oscillate) >>> let count = regEn 0 oscillate (count + 1) >>> :{ let sometimes1 = s where s = register Nothing (switch <$> s) switch Nothing = Just 1 switch _ = Nothing :} >>> :{ let countSometimes = s where s = regMaybe 0 (plusM (pure <$> s) sometimes1) plusM = liftA2 (liftA2 (+)) :} -} {- $conveniencetypes If you want to write part of your Clash design as domain-polymorphic functions, it can be practical to define a design-wide constraint synonym that captures the characteristics of the clock domains of the design. Such a constraint synonym can be used as a constraint on all domain-polymorphic functions in the design, regardless of whether they actually need the constraints from this section. @ type DesignDomain dom = ( 'HasSynchronousReset' dom , 'HasDefinedInitialValues' dom ) type DesignDomainHidden dom = ( DesignDomain dom , 'HiddenClockResetEnable' dom ) myFunc :: DesignDomainHidden dom => 'Signal' dom [...] @ This way, you don't have to think about which constraints the function you're writing has exactly, and the constraint is succinct. -} {- $hiddenclockandreset #hiddenclockandreset# Clocks, resets and enables are by default implicitly routed to their components. You can see from the type of a component whether it has hidden clock, reset or enable arguments: It has a hidden clock when it has a: @ f :: 'HiddenClock' dom => ... @ Constraint. Or it has a hidden reset when it has a: @ g :: 'HiddenReset' dom => ... @ Constraint. Or it has a hidden enable when it has a: @ g :: 'HiddenEnable' dom => ... @ Constraint. Or it has a hidden clock argument, a hidden reset argument and a hidden enable argument when it has a: @ h :: 'HiddenClockResetEnable' dom => .. @ Constraint. Given a component with explicit clock, reset and enable arguments, you can turn them into hidden arguments using 'hideClock', 'hideReset', and 'hideEnable'. So given a: @ f :: Clock dom -> Reset dom -> Enable dom -> Signal dom a -> ... @ You hide the clock and reset arguments by: @ -- g :: 'HiddenClockResetEnable' dom => Signal dom a -> ... g = 'hideClockResetEnable' f @ Or, alternatively, by: @ -- h :: 'HiddenClockResetEnable' dom => Signal dom a -> ... h = f 'hasClock' 'hasReset' 'hasEnable' @ == Assigning explicit clock, reset and enable arguments to hidden clocks, resets and enables Given a component: @ f :: 'HiddenClockResetEnable' dom => Signal dom Int -> Signal dom Int @ which has hidden clock, reset and enable arguments, we expose those hidden arguments so that we can explicitly apply them: @ -- g :: Clock dom -> Reset dom -> Enable dom -> Signal dom Int -> Signal dom Int g = 'exposeClockResetEnable' f @ or, alternatively, by: @ -- h :: Clock dom -> Reset dom -> Enable dom -> Signal dom Int -> Signal dom Int h clk rst en = 'withClockResetEnable' clk rst en f @ Similarly, there are 'exposeClock', 'exposeReset' and 'exposeEnable' to just expose the hidden clock, the hidden reset or the hidden enable argument. You will need to explicitly apply clocks and resets when you want to use components such as PLLs: @ topEntity :: Clock System -> Reset System -> Signal System Bit -> Signal System (BitVector 8) topEntity clk rst key1 = let (pllOut,pllRst) = 'Clash.Intel.ClockGen.altpllSync' clk rst in 'exposeClockResetEnable' leds pllOut pllRst enableGen where key1R = isRising 1 key1 leds = mealy blinkerT (1, False, 0) key1R @ or, using the alternative method: @ topEntity :: Clock System -> Reset System -> Signal System Bit -> Signal System (BitVector 8) topEntity clk rst key1 = let (pllOut,pllRst) = 'Clash.Intel.ClockGen.altpllSync' clk rst in 'withClockResetEnable' pllOut pllRst enableGen leds where key1R = isRising 1 key1 leds = mealy blinkerT (1, False, 0) key1R @ -} {- $monomorphism #monomorphism# If you don't provide a type signature for a function, Haskell will infer one for you. Sometimes this inferred type is less general than you would expect. This can be due to the monomorphism restriction, which is a rather intricate technical aspect of Haskell's type system. You don't need to understand it to avoid the problems it creates with hidden parameters, though. The @expose...@ and @with...@ functions for hidden clocks, resets, and enables are intended to be used to resolve a function with hidden parameters into a function without that hidden parameter. Put differently, 'exposeClock' and 'withClock' are not themselves used in a 'HiddenClock' context, and so on for resets and enables. If the rule that they are not themselves in a @Hidden...@ context is observed, they will function as expected. No specific consideration is needed in these cases. However, the function 'andEnable' is explicitly designed to be used within a 'HiddenEnable' context. In such a situation, it is important to provide a type signature for the component that is given to `andEnable` as an argument, and not let Haskell infer one. The use of 'andEnable' has an unfortunate interaction with Haskells monomorphism restriction that can lead to very surprising behavior. All of the following also applies to using 'exposeClock' and 'withClock' inside a 'HiddenClock' context, and so on for resets and enables. When you write a function @ f :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Int -> Signal dom Int f en i = andEnable en g i -- BROKEN where g = register 0 @ you would intuitively think this has the following type for the local function @g@: @ f :: forall dom . HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Int -> Signal dom Int f en i = andEnable en g i where g :: HiddenClockResetEnable dom => Signal dom Int -> Signal dom Int g = register 0 @ but instead, the monomorphism restriction will cause the following type to be inferred: @ f :: forall dom . HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Int -> Signal dom Int f en i = andEnable en g i -- BROKEN where g :: Signal dom Int -> Signal dom Int g = register 0 @ The monomorphism restriction essentially misqualifies the implicit parameter as polymorphism, and tries to remove the implicit parameter from the context of the function's type. It /can/ do that because the outer scope already has a 'HiddenEnable' context. But by getting that implicit parameter of the enclosing function as context, it also gets the value of the parameter of the enclosing function. So the Enable line for @g@ is the Enable line of @f@, and the Enable line produced by 'andEnable' that was intended to be connected to @g@ is not connected to anything! When using 'andEnable', you should always explicitly provide the type signature for the component given to 'andEnable' as an argument, thereby avoiding surprising inferred types. We don't advise you to turn off the monomorphism restriction, as this may have undesirable consequences. Note that the inferred type is not always incorrect. The following variant works correctly: @ f :: HiddenClockResetEnable dom => Signal dom Bool -> Signal dom Int -> Signal dom Int f en i = andEnable en g i where g i = register 0 i @ This is an instance of the very first example on , @f1@ (as opposed to @f4@). The monomorphism restriction works differently for function bindings and pattern bindings. Since @g@ here has a formal parameter, it is a function binding, and the monomorphish restriction does not kick in. The code works as expected. If a later code change removes the formal parameter, all of a sudden the code silently disregards the @en@ signal! Adhering to the rule that you should always explicitly provide the type signature for the component given to 'andEnable' as an argument would have avoided this hard to debug problem. -} #ifdef CLASH_MULTIPLE_HIDDEN type HiddenClockName dom = AppendSymbol dom "_clk" type HiddenResetName dom = AppendSymbol dom "_rst" type HiddenEnableName dom = AppendSymbol dom "_en" #else type HiddenClockName (dom :: Domain) = "clock" type HiddenResetName (dom :: Domain) = "reset" type HiddenEnableName (dom :: Domain) = "enable" #endif -- | A /constraint/ that indicates the component has a hidden 'Clock' -- --