clash-prelude 0.5.1 → 0.6
raw patch · 44 files changed
+5624/−3084 lines, 44 filesdep +ghc-primdep +integer-gmp
Dependencies added: ghc-prim, integer-gmp
Files
- CHANGELOG.md +22/−0
- clash-prelude.cabal +46/−6
- doc/firstDF.svg +3/−0
- doc/idDF.svg +3/−0
- doc/lockStep.svg +3/−0
- doc/loopDF.svg +3/−0
- doc/parDF.svg +3/−0
- doc/secondDF.svg +3/−0
- doc/seqDF.svg +3/−0
- doc/stepLock.svg +3/−0
- doc/swapDF.svg +3/−0
- src/CLaSH/Bit.hs +0/−67
- src/CLaSH/Class/BitPack.hs +78/−0
- src/CLaSH/Class/BitVector.hs +0/−45
- src/CLaSH/Class/Num.hs +65/−15
- src/CLaSH/Class/Resize.hs +30/−0
- src/CLaSH/Prelude.hs +75/−320
- src/CLaSH/Prelude/BitIndex.hs +135/−0
- src/CLaSH/Prelude/BitReduction.hs +55/−0
- src/CLaSH/Prelude/BlockRam.hs +126/−0
- src/CLaSH/Prelude/DataFlow.hs +336/−0
- src/CLaSH/Prelude/Explicit.hs +61/−344
- src/CLaSH/Prelude/Mealy.hs +167/−0
- src/CLaSH/Prelude/Testbench.hs +222/−0
- src/CLaSH/Promoted/Nat.hs +17/−3
- src/CLaSH/Promoted/Nat/TH.hs +1/−1
- src/CLaSH/Promoted/Symbol.hs +22/−0
- src/CLaSH/Signal.hs +188/−0
- src/CLaSH/Signal/Bundle.hs +169/−0
- src/CLaSH/Signal/Delayed.hs +153/−0
- src/CLaSH/Signal/Explicit.hs +230/−242
- src/CLaSH/Signal/Implicit.hs +0/−231
- src/CLaSH/Signal/Internal.hs +361/−0
- src/CLaSH/Signal/Types.hs +0/−96
- src/CLaSH/Sized/Fixed.hs +431/−273
- src/CLaSH/Sized/Index.hs +5/−0
- src/CLaSH/Sized/Internal/BitVector.hs +538/−0
- src/CLaSH/Sized/Internal/Index.hs +181/−0
- src/CLaSH/Sized/Internal/Signed.hs +441/−0
- src/CLaSH/Sized/Internal/Unsigned.hs +383/−0
- src/CLaSH/Sized/Signed.hs +1/−333
- src/CLaSH/Sized/Unsigned.hs +2/−297
- src/CLaSH/Sized/Vector.hs +961/−724
- src/CLaSH/Tutorial.hs +95/−87
CHANGELOG.md view
@@ -1,5 +1,27 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.6 *November 17th 2014*++* New features:+ * Add `Fractional` instance for `Fixed` [#9](https://github.com/christiaanb/clash-prelude/issues/9)+ * Make indexing/subscript of `Vec` ascending [#4](https://github.com/christiaanb/clash-prelude/issues/4)+ * Add separate `BitVector` type, which has a descending index.+ * Add bit indexing operators, including the index/subscript operator `(!)`.+ * Add bit reduction operators: `reduceOr`, `reduceAnd`, `reduceOr`.+ * Rename `BitVector` class to `BitPack` with `pack` and `unpack` class methods.+ * Rename `Pack` class to `Bundle` with `bundle` and `unbundle` class methods.+ * Strip all `Vec` functions from their `v` prefix, i.e. `vmap` -> `map`.+ * Rename `Vec` indexing operator from `(!)` to `(!!)`.+ * Combine `Add` and `Mult` class into `ExtendingNum` class.+ * Add extend and truncate methods to the `Resize` class.+ * Add `SaturatingNum` class with saturating numeric operators.+ * Add multitude of lifted `Signal` operators, i.e. `(.==.) :: Eq a => Signal a -> Signal a -> Signal Bool`+ * Add `CLaSH.Signal.Delayed` with functions and data types for delay-annotated signals to support safe synchronisation.+ * Add `CLASH.Prelude.DataFlow` with functions and data types to create self-synchronising circuits based on data-flow principles.++* Fixes bugs:+ * Remove deprecated 'Arrow' instance for and related functions for `Comp` [#5](https://github.com/christiaanb/clash-prelude/issues/5)+ ## 0.5.1 *June 5th 2014* * New features:
clash-prelude.cabal view
@@ -1,5 +1,5 @@ Name: clash-prelude-Version: 0.5.1+Version: 0.6 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -35,6 +35,8 @@ Extra-source-files: README.md CHANGELOG.md +extra-doc-files: doc/*.svg+ Cabal-version: >=1.10 source-repository head@@ -45,28 +47,66 @@ HS-Source-Dirs: src default-language: Haskell2010- ghc-options: -Wall -fwarn-tabs+ ghc-options: -Wall -fwarn-tabs -fexpose-all-unfoldings - Exposed-modules: CLaSH.Bit- CLaSH.Class.BitVector+ Exposed-modules: CLaSH.Class.BitPack CLaSH.Class.Num+ CLaSH.Class.Resize+ CLaSH.Prelude+ CLaSH.Prelude.BitIndex+ CLaSH.Prelude.BitReduction+ CLaSH.Prelude.BlockRam+ CLaSH.Prelude.DataFlow CLaSH.Prelude.Explicit+ CLaSH.Prelude.Mealy+ CLaSH.Prelude.Testbench+ CLaSH.Promoted.Nat CLaSH.Promoted.Nat.TH CLaSH.Promoted.Nat.Literals CLaSH.Promoted.Ord+ CLaSH.Promoted.Symbol++ CLaSH.Signal+ CLaSH.Signal.Bundle+ CLaSH.Signal.Delayed CLaSH.Signal.Explicit- CLaSH.Signal.Implicit+ CLaSH.Signal.Internal+ CLaSH.Sized.Fixed+ CLaSH.Sized.Index CLaSH.Sized.Signed CLaSH.Sized.Unsigned CLaSH.Sized.Vector++ CLaSH.Sized.Internal.BitVector+ CLaSH.Sized.Internal.Index+ CLaSH.Sized.Internal.Signed+ CLaSH.Sized.Internal.Unsigned+ CLaSH.Tutorial - Other-modules: CLaSH.Signal.Types+ other-extensions: DataKinds+ DefaultSignatures+ DeriveDataTypeable+ FlexibleContexts+ GADTs+ GeneralizedNewtypeDeriving+ KindSignatures+ MagicHash+ MultiParamTypeClasses+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeFamilies+ TypeOperators+ UndecidableInstances Build-depends: base >= 4.7.0.0 && < 5, data-default >= 0.5.3,+ integer-gmp >= 0.5.1.0,+ ghc-prim >= 0.3.1.0, template-haskell >= 2.9.0.0, th-lift >= 0.5.6
+ doc/firstDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="50 116 263 163" width="263pt" height="163pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-04 10:45Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6000004 0 L 0 -2.1000001 L 0 2.1000001 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_4" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.5999994 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 104.20117 129.40234 L 249.70898 129.40234 C 252.47041 129.40234 254.70898 131.640915 254.70898 134.40234 L 254.70898 271.0918 C 254.70898 273.85321 252.47041 276.0918 249.70898 276.0918 L 104.20117 276.0918 C 101.43975 276.0918 99.20117 273.85321 99.20117 271.0918 C 99.20117 271.0918 99.20117 271.0918 99.20117 271.0918 L 99.201164 134.40234 C 99.201164 131.640915 101.439743 129.40234 104.201164 129.40234 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 126.990234 146.72656 L 224.05078 146.72656 C 226.81221 146.72656 229.05078 148.96513 229.05078 151.72656 L 229.05078 195.42578 C 229.05078 198.18721 226.81221 200.42578 224.05078 200.42578 L 126.990234 200.42578 C 124.22881 200.42578 121.990234 198.18721 121.990234 195.42578 C 121.990234 195.42578 121.990234 195.42578 121.990234 195.42578 L 121.990234 151.72656 C 121.990234 148.96513 124.22881 146.72656 126.990234 146.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(56.748047 154.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><path d="M 73.467186 159.92969 L 73.13672 159.92969 L 121.990234 160.15137" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><path d="M 73.0082 173.57617 L 72.828125 173.57617 L 121.990234 173.57614" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(128 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(125 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(197.97656 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(200.97656 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(197.97656 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(125 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(172.52051 133.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="229.05078" y1="160.15134" x2="285.64062" y2="160.15134" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="121.990234" y1="187.00095" x2="80.958473" y2="187.00095" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="229.05078" y1="173.57616" x2="285.42383" y2="173.57616" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 79.82383 251.7666 L 287.92383 251.7666 L 287.56796 251.7666" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 181.65234)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(293.22461 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(298.22461 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><text transform="translate(293.22461 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(152.48535 116.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19604492" y="9" textLength="48.60791">firstDF f</tspan></text><line x1="290.55469" y1="187.00098" x2="237.05078" y2="187.00098" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(300.22461 152.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(294.72461 167.69531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(295.46973 182.19531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><path d="M 280.02383 238.8418 L 71.92383 238.8418 L 72.279686 238.8418" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 280.02383 225.8418 L 71.92383 225.8418 L 72.279686 225.8418" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(50.44922 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(55.44922 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><text transform="translate(50.44922 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text></g></g></svg>
+ doc/idDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="50 199 261 76" width="261pt" height="76pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-05 09:25Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 104.20117 211.72461 L 249.70898 211.72461 C 252.47041 211.72461 254.70898 213.96318 254.70898 216.72461 L 254.70898 267.11914 C 254.70898 269.88055 252.47041 272.11914 249.70898 272.11914 L 104.20117 272.11914 C 101.43975 272.11914 99.20117 269.88055 99.20117 267.11914 C 99.20117 267.11914 99.20117 267.11914 99.20117 267.11914 L 99.20117 216.72461 C 99.20117 213.96318 101.43975 211.72461 104.20117 211.72461 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 79.82383 251.7666 L 287.92383 251.7666 L 287.56796 251.7666" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(293.22461 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(298.22461 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><text transform="translate(293.22461 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(165.95508 199.72461)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">idDF</tspan></text><path d="M 280.02383 238.8418 L 71.92383 238.8418 L 72.279686 238.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 280.02383 225.8418 L 71.92383 225.8418 L 72.279686 225.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(50.44922 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(55.44922 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><text transform="translate(50.44922 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text></g></g></svg>
+ doc/lockStep.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="5 75 563 236" width="563pt" height="236pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-05 10:53Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6000004 0 L 0 -2.1000001 L 0 2.1000001 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_4" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.5999994 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_5" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><font-face font-family="Helvetica" font-size="9" units-per-em="1000" underline-position="-75.683594" underline-thickness="49.316406" slope="0" x-height="522.94922" cap-height="717.28516" ascent="770.01953" descent="-229.98047" font-weight="500"><font-face-src><font-face-name name="Helvetica"/></font-face-src></font-face></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="1118" height="783"/><g><title>Layer 1</title><path d="M 34.933594 89.285156 L 528.07617 89.285156 C 530.8376 89.285156 533.07617 91.523735 533.07617 94.285156 L 533.07617 303.20673 C 533.07617 305.96814 530.8376 308.20673 528.07617 308.20673 L 34.933594 308.20673 C 32.172169 308.20673 29.933594 305.96814 29.933594 303.20673 C 29.933594 303.20673 29.933594 303.20673 29.933594 303.20673 L 29.933586 94.285156 C 29.933586 91.523735 32.172161 89.285156 34.933586 89.285156 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 241.96973 129.40234 L 387.47754 129.40234 C 390.23895 129.40234 392.47754 131.640915 392.47754 134.40234 L 392.47754 273.1875 C 392.47754 275.94891 390.23895 278.1875 387.47754 278.1875 L 241.96973 278.1875 C 239.2083 278.1875 236.96973 275.94891 236.96973 273.1875 C 236.96973 273.1875 236.96973 273.1875 236.96973 273.1875 L 236.96973 134.40234 C 236.96973 131.640915 239.2083 129.40234 241.96973 129.40234 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 46.982422 111.22461 L 406.5957 111.22461 C 409.35712 111.22461 411.5957 113.46319 411.5957 116.22461 L 411.5957 285.029 C 411.5957 287.7904 409.35712 290.029 406.5957 290.029 L 46.982422 290.029 C 44.220997 290.029 41.982422 287.7904 41.982422 285.029 C 41.982422 285.029 41.982422 285.029 41.982422 285.029 L 41.982414 116.22461 C 41.982414 113.46319 44.22099 111.22461 46.982414 111.22461 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 58.201172 129.40234 L 203.70898 129.40234 C 206.47041 129.40234 208.70898 131.640915 208.70898 134.40234 L 208.70898 273.1875 C 208.70898 275.94891 206.47041 278.1875 203.70898 278.1875 L 58.201172 278.1875 C 55.439747 278.1875 53.201172 275.94891 53.201172 273.1875 C 53.201172 273.1875 53.201172 273.1875 53.201172 273.1875 L 53.201164 134.40234 C 53.201164 131.640915 55.43974 129.40234 58.201164 129.40234 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 80.990234 146.72656 L 178.05078 146.72656 C 180.81221 146.72656 183.05078 148.96513 183.05078 151.72656 L 183.05078 195.42578 C 183.05078 198.18721 180.81221 200.42578 178.05078 200.42578 L 80.990234 200.42578 C 78.228813 200.42578 75.990234 198.18721 75.990234 195.42578 C 75.990234 195.42578 75.990234 195.42578 75.990234 195.42578 L 75.990234 151.72656 C 75.990234 148.96513 78.228813 146.72656 80.990234 146.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 9.467189 159.92969 L 9.136719 159.92969 L 75.990234 160.15137" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 9.0082035 173.57617 L 8.828125 173.57617 L 75.990234 173.57614" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(82 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(79 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(151.97656 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(154.97656 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(151.97656 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(79 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(126.52051 133.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="183.05078" y1="160.15134" x2="435.14062" y2="160.15134" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="75.990234" y1="187.00095" x2="16.958469" y2="187.00095" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 183.05078 173.57616 L 192.55078 173.57616 L 292.55078 173.57616 L 292.55078 206.60938 L 354.21036 206.60938 L 356.21036 206.60938" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(100.98535 116.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29516602" y="9" textLength="59.409668">f `parDF` g</tspan></text><path d="M 248.66211 187.41797 L 239.16211 187.41797 L 192.55078 187.00098 L 190.55078 187.00098" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 80.990234 218.5 L 178.05078 218.5 C 180.81221 218.5 183.05078 220.73857 183.05078 223.5 L 183.05078 267.19922 C 183.05078 269.96063 180.81221 272.19922 178.05078 272.19922 L 80.990234 272.19922 C 78.228813 272.19922 75.990234 269.96063 75.990234 267.19922 C 75.990234 267.19922 75.990234 267.19922 75.990234 267.19922 L 75.990234 223.5 C 75.990234 220.73857 78.228813 218.5 80.990234 218.5 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 9.467189 231.70312 L 9.136719 231.70312 L 75.990234 231.9248" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 9.0082035 245.34961 L 8.828125 245.34961 L 75.990234 245.34958" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(82 226.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(79 239.84961)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(151.97656 253.6914)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(154.97656 226.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(151.97656 239.84961)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(79 253.6914)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(126.52051 205.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">g</tspan></text><line x1="75.990234" y1="258.77438" x2="16.958469" y2="258.77438" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 183.05078 245.3496 L 192.55078 245.3496 L 273.55078 245.3496 L 273.55078 215.63641 L 354 215.63641 L 356 215.63641" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 246.77734 259.1914 L 237.27734 259.1914 L 192.55078 258.77441 L 190.55078 258.77441" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 363.5 219.83496 L 374.5437 219.83496 C 380.06555 219.83496 385.5874 217.62622 385.5874 211 C 385.5874 204.37378 380.06555 202.16504 374.5437 202.16504 L 363.5 202.16504 Z" fill="white"/><path d="M 363.5 219.83496 L 374.5437 219.83496 C 380.06555 219.83496 385.5874 217.62622 385.5874 211 C 385.5874 204.37378 380.06555 202.16504 374.5437 202.16504 L 363.5 202.16504 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(368.5 205.5)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><path d="M 270.74951 196.25293 L 259.70581 196.25293 C 254.18396 196.25293 248.66211 194.04419 248.66211 187.41797 C 248.66211 180.79175 254.18396 178.58301 259.70581 178.58301 L 270.74951 178.58301 Z" fill="white"/><path d="M 270.74951 196.25293 L 259.70581 196.25293 C 254.18396 196.25293 248.66211 194.04419 248.66211 187.41797 C 248.66211 180.79175 254.18396 178.58301 259.70581 178.58301 L 270.74951 178.58301 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(253.66211 181.91797)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><path d="M 268.86475 268.02637 L 257.82104 268.02637 C 252.2992 268.02637 246.77734 265.81763 246.77734 259.1914 C 246.77734 252.56519 252.2992 250.35645 257.82104 250.35645 L 268.86475 250.35645 Z" fill="white"/><path d="M 268.86475 268.02637 L 257.82104 268.02637 C 252.2992 268.02637 246.77734 265.81763 246.77734 259.1914 C 246.77734 252.56519 252.2992 250.35645 257.82104 250.35645 L 268.86475 250.35645 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(251.77734 253.6914)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><circle cx="292.92035" cy="206.60938" r="1.3286213" fill="black"/><circle cx="292.92035" cy="206.60938" r="1.3286213" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><circle cx="340.00977" cy="215.63641" r="1.3286213" fill="black"/><circle cx="340.00977" cy="215.63641" r="1.3286213" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 338.95215 214.1444 L 338.95215 212.10938 C 333.45215 212.10938 333.45215 201.10779 338.95215 201.10779 L 338.95215 183.02148 L 316.89127 183.02148 L 298.05078 183.02448 C 298.0499 177.52448 287.0499 177.52623 287.05078 183.02623 L 280.03915 183.02734 L 278.03915 183.02734" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 292.61453 208.41235 L 292.61453 210.13641 C 298.11453 210.13641 298.11453 221.13857 292.61453 221.13857 L 292.61453 255.1914 L 284.67969 255.1914 L 278.15439 254.80078 L 276.15439 254.80078" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 442 264.4375 L 442 263.82782 L 278.36472 263.82782 L 276.36472 263.82782" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><circle cx="319.27808" cy="263.82782" r="1.3286278" fill="black"/><circle cx="319.27808" cy="263.82782" r="1.3286278" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 318.2537 262.31274 L 318.2537 252.81274 L 318.2537 221.13641 C 312.7537 221.13641 312.7537 201.10938 318.2537 201.10938 L 318.2537 192.05437 L 298.05078 192.05437 C 298.05078 186.55437 287.05078 186.55437 287.05078 192.05437 L 280.24948 192.05437 L 278.24948 192.05437" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="385.5874" y1="211" x2="434.64258" y2="211" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(292.5 116.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39648438" y="9" textLength="43.20703">lockStep</tspan></text><text transform="translate(143.5 96.371094)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".4868164" y="9" textLength="162.02637">(f `parDF` g) `seqDF` lockStep</tspan></text><path d="M 447.5 132.6443 L 514.48633 132.6443 C 517.24774 132.6443 519.48633 134.88287 519.48633 137.6443 L 519.48633 273.60931 C 519.48633 276.37073 517.24774 278.60931 514.48633 278.60931 L 447.5 278.60931 C 444.73859 278.60931 442.5 276.37073 442.5 273.60931 C 442.5 273.60931 442.5 273.60931 442.5 273.60931 L 442.5 137.6443 C 442.5 134.88287 444.73859 132.6443 447.5 132.6443 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(448.75488 158)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(445.50977 205.3768)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(487.98633 257.4686)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(491.23145 158)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(487.98633 205.3768)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(445.50977 257.4686)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(477.99316 120.32715)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">h</tspan></text><path d="M 183.05078 231.92477 L 192.55078 231.92477 L 268.05078 231.92477 C 268.05078 226.42477 279.05081 226.42477 279.05081 231.92477 L 287.1145 231.92477 C 287.1145 226.42477 298.11453 226.42477 298.11453 231.92477 L 312.75372 231.92477 C 312.75372 226.42477 323.75366 226.42477 323.75366 231.92477 L 422.58008 231.92477 L 422.58008 230.57812 L 422.58008 216.5 C 417.08008 216.5 417.08008 205.50002 422.58008 205.50002 L 422.58008 166.76953 L 424.81836 166.76953 L 435.0014 166.96637" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="520.06055" y1="211" x2="544.5923" y2="211" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="520.06055" y1="163" x2="545.0923" y2="163" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 551.62274 263.6914 L 551.9532 263.6914 L 521.09967 263.91309" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(173.00488 75.539062)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".48242188" y="9" textLength="216.03516">(f `parDF` g) `seqDF` lockStep `seqDF` h</tspan></text></g></g></svg>
+ doc/loopDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="25 132 438 216" width="438pt" height="18pc"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-05 14:15Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 49.765625 144.521484 L 434.7754 144.521484 C 437.5368 144.521484 439.7754 146.760056 439.7754 149.52148 L 439.7754 340.89453 C 439.7754 343.65594 437.5368 345.89453 434.7754 345.89453 L 49.765625 345.89453 C 47.0042 345.89453 44.765625 343.65594 44.765625 340.89453 C 44.765625 340.89453 44.765625 340.89453 44.765625 340.89453 L 44.765617 149.52148 C 44.765617 146.760056 47.004192 144.521484 49.765617 144.521484 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 209 160.92578 L 275.98633 160.92578 C 278.74774 160.92578 280.98633 163.16435 280.98633 165.92578 L 280.98633 290.95703 C 280.98633 293.71844 278.74774 295.95703 275.98633 295.95703 L 209 295.95703 C 206.23857 295.95703 204 293.71844 204 290.95703 C 204 290.95703 204 290.95703 204 290.95703 L 204 165.92578 C 204 163.16435 206.23857 160.92578 209 160.92578 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(210.00977 169.13272)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(207.00977 221.83203)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(249.48633 277.31631)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(252.48633 170.13272)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(249.48633 221.83203)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(207.00977 277.31631)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(239.49316 147.83203)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">h</tspan></text><path d="M 28.830471 172.6037 L 28.5 172.6037 L 203.35352 172.82538" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="281.5" y1="172" x2="451.03177" y2="172" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(315.5 148.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39648438" y="9" textLength="43.20703">stepLock</tspan></text><text transform="translate(221.61816 132.021484)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39648438" y="9" textLength="43.20703">loopDF h</tspan></text><path d="M 310.5 160.92578 L 365.7754 160.92578 C 368.5368 160.92578 370.7754 163.16435 370.7754 165.92578 L 370.7754 290.95703 C 370.7754 293.71844 368.5368 295.95703 365.7754 295.95703 L 310.5 295.95703 C 307.73859 295.95703 305.5 293.71844 305.5 290.95703 C 305.5 290.95703 305.5 290.95703 305.5 290.95703 L 305.5 165.92578 C 305.5 163.16435 307.73859 160.92578 310.5 160.92578 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(124 148.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39648438" y="9" textLength="43.20703">lockStep</tspan></text><path d="M 118 160.92578 L 174.05273 160.92578 C 176.81416 160.92578 179.05273 163.16435 179.05273 165.92578 L 179.05273 290.95703 C 179.05273 293.71844 176.81416 295.95703 174.05273 295.95703 L 118 295.95703 C 115.23858 295.95703 113 293.71844 113 290.95703 C 113 290.95703 113 290.95703 113 290.95703 L 112.99999 165.92578 C 112.99999 163.16435 115.23857 160.92578 117.99999 160.92578 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="179.05273" y1="228.44138" x2="196.5" y2="228.44136" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="280.98633" y1="228.44138" x2="298" y2="228.44136" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(129.009766 221.83203)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(129.009766 280.81631)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(323.5 221.83203)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(323.5 280.81631)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><line x1="203.47852" y1="283.58594" x2="185.63867" y2="283.58594" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="304.83984" y1="283.58594" x2="287" y2="283.58594" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 371.38672 229.45508 L 412.83203 229.45508 L 412.83203 320.91406 L 72.939453 320.91406 L 72.939453 229.93164 L 106.01758 229.93164" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 112.660156 287.98242 L 92.13281 287.98242 L 92.13281 307.29102 L 395.10352 307.29102 L 395.10352 287.80078 L 378.59766 287.80078" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 281.35352 176.21875 L 427.57617 176.21875 L 427.57617 335.07617 L 58.17578 335.07617 L 58.17578 178.08789 L 196.46486 178.08789" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 29.830471 225 L 29.5 225 L 52.675804 225.06163 C 52.690437 219.56165 63.690395 219.59091 63.675762 225.0909 L 112.853516 225.22168" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 458.52304 283.21521 L 458.85352 283.21521 L 433.07617 283.28024 C 433.06229 277.78027 422.06229 277.80804 422.07617 283.30801 L 418.33203 283.31744 C 418.31815 277.81747 407.31815 277.84525 407.33203 283.34521 L 371 283.43689" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 112.93176 283.52344 L 78.43936 283.72531 C 78.40718 278.2254 67.407364 278.28976 67.439545 283.78967 L 63.675686 283.8117 C 63.643505 278.3118 52.643692 278.37616 52.675873 283.87607 L 37.399826 283.96548" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 371 224.9375 L 422.07617 225.01627 C 422.08466 219.51627 433.08466 219.53322 433.07617 225.03322 L 451.03555 225.06091" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/></g></g></svg>
+ doc/parDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="51 116 262 165" width="262pt" height="165pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-04 10:51Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6000004 0 L 0 -2.1000001 L 0 2.1000001 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_4" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.5999994 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 104.20117 129.40234 L 249.70898 129.40234 C 252.47041 129.40234 254.70898 131.640915 254.70898 134.40234 L 254.70898 273.1875 C 254.70898 275.94891 252.47041 278.1875 249.70898 278.1875 L 104.20117 278.1875 C 101.43975 278.1875 99.20117 275.94891 99.20117 273.1875 C 99.20117 273.1875 99.20117 273.1875 99.20117 273.1875 L 99.201164 134.40234 C 99.201164 131.640915 101.439743 129.40234 104.201164 129.40234 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 126.990234 146.72656 L 224.05078 146.72656 C 226.81221 146.72656 229.05078 148.96513 229.05078 151.72656 L 229.05078 195.42578 C 229.05078 198.18721 226.81221 200.42578 224.05078 200.42578 L 126.990234 200.42578 C 124.22881 200.42578 121.990234 198.18721 121.990234 195.42578 C 121.990234 195.42578 121.990234 195.42578 121.990234 195.42578 L 121.990234 151.72656 C 121.990234 148.96513 124.22881 146.72656 126.990234 146.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(56.748047 154.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><path d="M 73.467186 159.92969 L 73.13672 159.92969 L 121.990234 160.15137" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><path d="M 73.0082 173.57617 L 72.828125 173.57617 L 121.990234 173.57614" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(128 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(125 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(197.97656 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(200.97656 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(197.97656 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(125 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(172.52051 133.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="229.05078" y1="160.15134" x2="285.64062" y2="160.15134" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="121.990234" y1="187.00095" x2="80.958473" y2="187.00095" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="229.05078" y1="173.57616" x2="285.42383" y2="173.57616" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 181.65234)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(146.98535 116.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29516602" y="9" textLength="59.409668">f `parDF` g</tspan></text><line x1="290.55469" y1="187.00098" x2="237.05078" y2="187.00098" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(300.22461 152.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(294.72461 167.69531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(295.46973 182.19531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><path d="M 126.990234 218.5 L 224.05078 218.5 C 226.81221 218.5 229.05078 220.73857 229.05078 223.5 L 229.05078 267.19922 C 229.05078 269.96063 226.81221 272.19922 224.05078 272.19922 L 126.990234 272.19922 C 124.22881 272.19922 121.990234 269.96063 121.990234 267.19922 C 121.990234 267.19922 121.990234 267.19922 121.990234 267.19922 L 121.990234 223.5 C 121.990234 220.73857 124.22881 218.5 126.990234 218.5 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(56.748047 226.27344)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><path d="M 73.467186 231.70312 L 73.13672 231.70312 L 121.990234 231.9248" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 239.84961)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><path d="M 73.0082 245.34961 L 72.828125 245.34961 L 121.990234 245.34958" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(128 226.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(125 239.84961)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(197.97656 253.6914)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(200.97656 226.00781)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(197.97656 239.84961)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(125 253.6914)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(172.52051 205.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">g</tspan></text><line x1="229.05078" y1="231.92477" x2="285.64062" y2="231.92477" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="121.990234" y1="258.77438" x2="80.958473" y2="258.77438" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="229.05078" y1="245.3496" x2="285.42383" y2="245.3496" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 253.42578)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><line x1="290.55469" y1="258.77441" x2="237.05078" y2="258.77441" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(300.22461 224.27344)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">d</tspan></text><text transform="translate(294.72461 239.46875)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">dEn</tspan></text><text transform="translate(295.46973 253.96875)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">dEn</tspan></text></g></g></svg>
+ doc/secondDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="51 116 262 163" width="262pt" height="163pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-04 10:49Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6000004 0 L 0 -2.1000001 L 0 2.1000001 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_4" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.5999994 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 104.20117 129.40234 L 249.70898 129.40234 C 252.47041 129.40234 254.70898 131.640915 254.70898 134.40234 L 254.70898 271.0918 C 254.70898 273.85321 252.47041 276.0918 249.70898 276.0918 L 104.20117 276.0918 C 101.43975 276.0918 99.20117 273.85321 99.20117 271.0918 C 99.20117 271.0918 99.20117 271.0918 99.20117 271.0918 L 99.201164 134.40234 C 99.201164 131.640915 101.439743 129.40234 104.201164 129.40234 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 126.990234 209.72656 L 224.05078 209.72656 C 226.81221 209.72656 229.05078 211.96513 229.05078 214.72656 L 229.05078 258.42578 C 229.05078 261.1872 226.81221 263.42578 224.05078 263.42578 L 126.990234 263.42578 C 124.22881 263.42578 121.990234 261.1872 121.990234 258.42578 C 121.990234 258.42578 121.990234 258.42578 121.990234 258.42578 L 121.990234 214.72656 C 121.990234 211.96513 124.22881 209.72656 126.990234 209.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(56.748047 217.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><path d="M 73.467186 222.92969 L 73.13672 222.92969 L 121.990234 223.15137" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 231.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><path d="M 73.0082 236.57617 L 72.828125 236.57617 L 121.990234 236.57614" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(128 217.23438)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(125 231.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(197.97656 244.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(200.97656 217.23438)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(197.97656 231.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(125 244.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(172.52051 196.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="229.05078" y1="223.15134" x2="285.64062" y2="223.15134" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="121.990234" y1="250.00095" x2="80.958473" y2="250.00095" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="229.05078" y1="236.57616" x2="285.42383" y2="236.57616" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 80.62266 179.7666 L 288.72266 179.7666 L 288.36679 179.7666" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 244.65234)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(294.02344 174.68359)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(299.02344 147)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><text transform="translate(294.02344 160.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(149.48535 116.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49560547" y="9" textLength="54.00879">secondDF f</tspan></text><line x1="290.55469" y1="250.00098" x2="237.05078" y2="250.00098" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(300.22461 215.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(294.72461 230.69531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(295.46973 245.19531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><path d="M 280.82266 166.8418 L 72.722656 166.8418 L 73.078514 166.8418" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 280.82266 153.8418 L 72.722656 153.8418 L 73.078514 153.8418" marker-end="url(#FilledArrow_Marker_3)" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 174.68359)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(56.248047 147)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><text transform="translate(51.248047 160.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text></g></g></svg>
+ doc/seqDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="51 116 417 104" width="417pt" height="104pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-05 09:21Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 105.390625 130.22656 L 413.1543 130.22656 C 415.9157 130.22656 418.1543 132.46513 418.1543 135.22656 L 418.1543 212.63867 C 418.1543 215.4001 415.9157 217.63867 413.1543 217.63867 L 105.390625 217.63867 C 102.629204 217.63867 100.390625 215.4001 100.390625 212.63867 C 100.390625 212.63867 100.390625 212.63867 100.390625 212.63867 L 100.390625 135.22656 C 100.390625 132.46513 102.629204 130.22656 105.390625 130.22656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 126.990234 146.72656 L 224.05078 146.72656 C 226.81221 146.72656 229.05078 148.96513 229.05078 151.72656 L 229.05078 195.42578 C 229.05078 198.18721 226.81221 200.42578 224.05078 200.42578 L 126.990234 200.42578 C 124.22881 200.42578 121.990234 198.18721 121.990234 195.42578 C 121.990234 195.42578 121.990234 195.42578 121.990234 195.42578 L 121.990234 151.72656 C 121.990234 148.96513 124.22881 146.72656 126.990234 146.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(56.748047 154.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><path d="M 73.467186 159.92969 L 73.13672 159.92969 L 121.990234 160.15137" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><path d="M 73.0082 173.57617 L 72.828125 173.57617 L 121.990234 173.57614" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(128 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(125 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(197.97656 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(200.97656 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(197.97656 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(125 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(172.52051 133.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="229.05078" y1="160.15134" x2="283.24063" y2="160.15134" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="121.990234" y1="187.00095" x2="80.958473" y2="187.00095" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="229.05078" y1="173.57616" x2="283.02383" y2="173.57616" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(51.248047 181.65234)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(230.5 116)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29516602" y="9" textLength="59.409668">f `seqDF` g</tspan></text><line x1="290.55469" y1="187.00098" x2="239.45078" y2="187.00098" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(257 146.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(252 162.26953)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(252 174.26953)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(450.79688 181.65234)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><text transform="translate(455.79688 153.96875)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">c</tspan></text><text transform="translate(450.79688 167.81055)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">cEn</tspan></text><path d="M 296.5 146.72656 L 393.56055 146.72656 C 396.32196 146.72656 398.56055 148.96513 398.56055 151.72656 L 398.56055 195.42578 C 398.56055 198.18721 396.32196 200.42578 393.56055 200.42578 L 296.5 200.42578 C 293.73859 200.42578 291.5 198.18721 291.5 195.42578 C 291.5 195.42578 291.5 195.42578 291.5 195.42578 L 291.5 151.72656 C 291.5 148.96513 293.73859 146.72656 296.5 146.72656 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(297.50977 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(294.50977 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(367.48633 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(370.48633 154.234375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(367.48633 168.07617)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(294.50977 181.91797)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(342.03027 133.72656)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">g</tspan></text><path d="M 446.04257 186.918 L 446.22266 186.918 L 398.56055 186.91797" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="398" y1="160.55713" x2="438.18985" y2="160.55713" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="398" y1="173.98195" x2="438.47305" y2="173.98195" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/></g></g></svg>
+ doc/stepLock.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="16 76 518 235" width="518pt" height="235pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-05 13:00Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><font-face font-family="Helvetica" font-size="9" units-per-em="1000" underline-position="-75.683594" underline-thickness="49.316406" slope="0" x-height="522.94922" cap-height="717.28516" ascent="770.01953" descent="-229.98047" font-weight="500"><font-face-src><font-face-name name="Helvetica"/></font-face-src></font-face><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_3" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6000004 0 L 0 -2.1000001 L 0 2.1000001 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_4" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.5999994 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_5" viewBox="-1 -4 8 8" markerWidth="8" markerHeight="8" color="black"><g><path d="M 5.6 0 L 0 -2.0999999 L 0 2.0999999 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 164.80078 124.5 L 298.23438 124.5 C 300.99579 124.5 303.23438 126.73858 303.23438 129.5 L 303.23438 275.875 C 303.23438 278.63641 300.99579 280.875 298.23438 280.875 L 164.80078 280.875 C 162.03935 280.875 159.80078 278.63641 159.80078 275.875 C 159.80078 275.875 159.80078 275.875 159.80078 275.875 L 159.80078 129.5 C 159.80078 126.73858 162.03935 124.5 164.80078 124.5 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 37.214844 91.375 L 496.19727 91.375 C 498.95868 91.375 501.19727 93.61358 501.19727 96.375 L 501.19727 303.71094 C 501.19727 306.47235 498.95868 308.71094 496.19727 308.71094 L 37.214844 308.71094 C 34.453419 308.71094 32.214844 306.47235 32.214844 303.71094 C 32.214844 303.71094 32.214844 303.71094 32.214844 303.71094 L 32.214836 96.375 C 32.214836 93.61358 34.453411 91.375 37.214836 91.375 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 47.19922 108.089844 L 314.11328 108.089844 C 316.8747 108.089844 319.11328 110.32842 319.11328 113.089844 L 319.11328 291.21484 C 319.11328 293.97626 316.8747 296.21484 314.11328 296.21484 L 47.19922 296.21484 C 44.437794 296.21484 42.19922 293.97626 42.19922 291.21484 C 42.19922 291.21484 42.19922 291.21484 42.19922 291.21484 L 42.19921 113.089844 C 42.19921 110.32842 44.437786 108.089844 47.19921 108.089844 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 227.46118 175.18359 L 238.50488 175.18359 C 244.02673 175.18359 249.54858 172.97485 249.54858 166.34863 C 249.54858 159.72241 244.02673 157.51367 238.50488 157.51367 L 227.46118 157.51367 Z" fill="white"/><path d="M 227.46118 175.18359 L 238.50488 175.18359 C 244.02673 175.18359 249.54858 172.97485 249.54858 166.34863 C 249.54858 159.72241 244.02673 157.51367 238.50488 157.51367 L 227.46118 157.51367 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(232.46118 160.84863)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><path d="M 63.339783 138.59375 L 130.32611 138.59375 C 133.08754 138.59375 135.32611 140.83232 135.32611 143.59375 L 135.32611 268.625 C 135.32611 271.38641 133.08754 273.625 130.32611 273.625 L 63.339783 273.625 C 60.578358 273.625 58.339783 271.38641 58.339783 268.625 C 58.339783 268.625 58.339783 268.625 58.339783 268.625 L 58.33978 143.59375 C 58.33978 140.83232 60.578354 138.59375 63.33978 138.59375 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(64.34955 146.80069)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(61.34955 199.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(103.82611 258.48428)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(106.82611 147.80069)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(103.82611 199.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(61.34955 258.48428)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(93.832947 125.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">h</tspan></text><text transform="translate(162.5 76.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".48242188" y="9" textLength="216.03516">h `seqDF` stepLock `seqDF` (f `parDF` g)</tspan></text><path d="M 19.330471 206.57925 L 19 206.57925 L 58.853516 206.80093" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 19.330471 153.47174 L 19 153.47174 L 58.853516 153.69342" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="58.771545" y1="264.01569" x2="29.739782" y2="264.01569" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 334.5 122.339844 L 480.0078 122.339844 C 482.76923 122.339844 485.0078 124.57842 485.0078 127.33984 L 485.0078 273.71484 C 485.0078 276.47626 482.76923 278.71484 480.0078 278.71484 L 334.5 278.71484 C 331.73859 278.71484 329.5 276.47626 329.5 273.71484 C 329.5 273.71484 329.5 273.71484 329.5 273.71484 L 329.5 127.33984 C 329.5 124.57842 331.73859 122.339844 334.5 122.339844 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 357.28906 139.66406 L 454.3496 139.66406 C 457.11102 139.66406 459.3496 141.90263 459.3496 144.66406 L 459.3496 188.36328 C 459.3496 191.12471 457.11102 193.36328 454.3496 193.36328 L 357.28906 193.36328 C 354.52765 193.36328 352.28906 191.12471 352.28906 188.36328 C 352.28906 188.36328 352.28906 188.36328 352.28906 188.36328 L 352.28906 144.66406 C 352.28906 141.90263 354.52765 139.66406 357.28906 139.66406 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(358.29883 147.171875)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(355.29883 161.01367)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(428.2754 174.85547)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(431.2754 147.171875)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(428.2754 161.01367)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(355.29883 174.85547)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(402.81934 126.66406)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">f</tspan></text><line x1="459.8496" y1="153.08885" x2="515.93945" y2="153.08884" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="459.84958" y1="166.51366" x2="515.72266" y2="166.51366" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(377.28418 109)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29516602" y="9" textLength="59.409668">f `parDF` g</tspan></text><path d="M 357.28906 211.4375 L 454.3496 211.4375 C 457.11102 211.4375 459.3496 213.67607 459.3496 216.4375 L 459.3496 260.13672 C 459.3496 262.89813 457.11102 265.13672 454.3496 265.13672 L 357.28906 265.13672 C 354.52765 265.13672 352.28906 262.89813 352.28906 260.13672 C 352.28906 260.13672 352.28906 260.13672 352.28906 260.13672 L 352.28906 216.4375 C 352.28906 213.67607 354.52765 211.4375 357.28906 211.4375 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(358.29883 218.94531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(355.29883 232.78711)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(428.2754 246.6289)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(431.2754 218.94531)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".19824219" y="9" textLength="21.603516">data</tspan></text><text transform="translate(428.2754 232.78711)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">valid</tspan></text><text transform="translate(355.29883 246.6289)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".49780273" y="9" textLength="27.004395">ready</tspan></text><text transform="translate(402.81934 198.4375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">g</tspan></text><line x1="459.8496" y1="224.86229" x2="515.93945" y2="224.86227" marker-end="url(#FilledArrow_Marker_3)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="459.84958" y1="238.2871" x2="515.72266" y2="238.2871" marker-end="url(#FilledArrow_Marker_4)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 135.40033 152.92075 L 342.78906 153.08887 L 344.78906 153.08887" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 225.4563 247.45703 L 236.5 247.45703 C 242.02185 247.45703 247.5437 245.24829 247.5437 238.62207 C 247.5437 231.99585 242.02185 229.78711 236.5 229.78711 L 225.4563 229.78711 Z" fill="white"/><path d="M 225.4563 247.45703 L 236.5 247.45703 C 242.02185 247.45703 247.5437 245.24829 247.5437 238.62207 C 247.5437 231.99585 242.02185 229.78711 236.5 229.78711 L 225.4563 229.78711 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(230.4563 233.12207)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><path d="M 191.95874 272.77426 L 180.91504 272.77426 C 175.39319 272.77426 169.87134 270.56552 169.87134 263.9393 C 169.87134 257.31308 175.39319 255.10434 180.91504 255.10434 L 191.95874 255.10434 Z" fill="white"/><path d="M 191.95874 272.77426 L 180.91504 272.77426 C 175.39319 272.77426 169.87134 270.56552 169.87134 263.9393 C 169.87134 257.31308 175.39319 255.10434 180.91504 255.10434 L 191.95874 255.10434 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(174.87134 258.4393)" fill="black"><tspan font-family="Helvetica" font-size="9" font-weight="500" x=".04077053" y="9" textLength="12.0058594">&&</tspan></text><line x1="169.87134" y1="263.9393" x2="142.82611" y2="263.9393" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 352.28906 179.93843 L 342.78906 179.93843 L 271.78906 179.93843 L 271.78906 259.54868 L 201.24838 259.54868 L 199.24838 259.54868" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 352.28906 251.71187 L 342.78906 251.71187 L 287.78906 251.71187 L 287.78906 268.57574 L 201.45874 268.57574 L 199.45874 268.57574" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><line x1="249.54858" y1="166.34863" x2="344.78906" y2="166.5016" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 247.5437 238.62207 L 266.2891 238.56212 C 266.27151 233.06215 277.27145 233.02698 277.28903 238.52695 L 344.7891 238.31107" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 135.32611 206.10934 L 144.82611 206.10934 L 181.82611 206.10934 L 181.82611 161.95801 L 218.17154 161.95801 L 220.17154 161.95801" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><circle cx="181.82611" cy="204.55278" r="1.3286148" fill="black"/><circle cx="181.82611" cy="204.55278" r="1.3286148" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 183.34058 205.578 L 192.84058 205.578 L 215.84058 205.578 L 215.84058 234.23145 L 216.16666 234.23145 L 218.16666 234.23145" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><circle cx="214.01781" cy="259.54868" r="1.3286213" fill="black"/><circle cx="214.01781" cy="259.54868" r="1.3286213" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 215.06876 258.05194 L 215.06876 248.55194 L 215.06876 243.25848 L 215.9563 243.25848 L 217.9563 243.25848" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><circle cx="207.03952" cy="268.54868" r="1.3286213" fill="black"/><circle cx="207.03952" cy="268.54868" r="1.3286213" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 207.41418 266.7587 L 207.41418 265.04868 C 201.91418 265.04868 201.91418 254.04921 207.41418 254.04921 L 207.41418 211.078 C 201.91418 211.078 201.91418 200.078 207.41418 200.078 L 207.41418 170.98505 L 217.96118 170.98505 L 219.96118 170.98505" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 135.90033 155.13574 L 287.93555 155.13574 L 287.93555 160.91028 C 293.43555 160.91028 293.43555 171.91028 287.93555 171.91028 L 287.93555 174.43843 C 293.43555 174.43843 293.43555 185.43843 287.93555 185.43843 L 287.93555 222.96094 L 287.93555 224.8623 L 342.78906 224.8623 L 344.78906 224.8623" marker-end="url(#FilledArrow_Marker_5)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(212.5 110.5)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39648438" y="9" textLength="43.20703">stepLock</tspan></text><text transform="translate(138.03711 95.4375)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39208984" y="9" textLength="97.21582">h `seqDF` stepLock</tspan></text><path d="M 521.52307 181.57925 L 521.85352 181.57925 L 460 181.80093" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 520.52307 253.07925 L 520.85352 253.07925 L 459 253.30093" marker-start="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/></g></g></svg>
+ doc/swapDF.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" version="1.1" viewBox="50 125 261 147" width="261pt" height="147pt"><metadata xmlns:dc="http://purl.org/dc/elements/1.1/"><dc:date>2014-11-04 11:00Z</dc:date><!-- Produced by OmniGraffle Professional 5.2.2 --></metadata><defs><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" viewBox="-9 -4 10 8" markerWidth="10" markerHeight="8" color="black"><g><path d="M -8 0 L 0 3 L 0 -3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/></g></marker><font-face font-family="Courier" font-size="9" units-per-em="1000" underline-position="-178.22266" underline-thickness="57.617188" slope="0" x-height="462.40234" cap-height="594.72656" ascent="753.90625" descent="-246.09375" font-weight="500"><font-face-src><font-face-name name="Courier"/></font-face-src></font-face></defs><g stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"><title>Canvas 1</title><rect fill="white" width="559" height="783"/><g><title>Layer 1</title><path d="M 104.20117 140.44531 L 249.70898 140.44531 C 252.47041 140.44531 254.70898 142.68388 254.70898 145.44531 L 254.70898 264.25 C 254.70898 267.01141 252.47041 269.25 249.70898 269.25 L 104.20117 269.25 C 101.43975 269.25 99.20117 267.01141 99.20117 264.25 C 99.20117 264.25 99.20117 264.25 99.20117 264.25 L 99.201164 145.44531 C 99.201164 142.68388 101.439743 140.44531 104.201164 140.44531 Z" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 79.82383 251.76645 L 133.046875 251.76562 L 220.6914 179.76562 L 287.92383 179.7666 L 287.56796 179.7666" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(293.22461 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(298.22461 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><text transform="translate(293.22461 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(160.48535 125.0625)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29736328" y="9" textLength="32.405273">swapDF</tspan></text><path d="M 280.02383 166.8418 L 220.12695 166.8418 L 133.02539 238.8418 L 71.92383 238.8418 L 72.279686 238.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 280.02383 153.8418 L 220.62695 153.8418 L 132.31055 225.8418 L 71.92383 225.8418 L 72.279686 225.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(50.44922 246.6836)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(55.44922 219)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(50.44922 232.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><path d="M 78.910744 179.7666 L 132.37305 179.7666 L 156.35889 199.28696 C 159.83057 195.0211 184.47632 215.07854 181.00464 219.34439 L 220.84375 251.7666 L 287.01074 251.7666 L 286.65488 251.7666" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(292.31152 174.68359)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><text transform="translate(297.31152 147)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">b</tspan></text><text transform="translate(292.31152 160.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">bEn</tspan></text><path d="M 279.11075 238.8418 L 221.34375 238.8418 L 189.07732 212.7093 C 192.53886 208.43524 167.86871 188.45496 164.40717 192.72902 L 132.6582 167.015625 L 71.010742 166.8418 L 71.3666 166.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><path d="M 279.11075 225.8418 L 220.53906 225.8418 L 196.71248 206.44077 C 200.18526 202.17581 175.60582 182.16174 172.13304 186.4267 L 132.115234 153.8418 L 71.010742 153.8418 L 71.3666 153.8418" marker-end="url(#FilledArrow_Marker)" marker-start="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/><text transform="translate(50 174.7666)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text><text transform="translate(55.5 147)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".29956055" y="9" textLength="5.400879">a</tspan></text><text transform="translate(50 160.8418)" fill="black"><tspan font-family="Courier" font-size="9" font-weight="500" x=".39868164" y="9" textLength="16.202637">aEn</tspan></text></g></g></svg>
− src/CLaSH/Bit.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--{-# OPTIONS_GHC -fno-warn-missing-methods #-}--module CLaSH.Bit- (Bit(..))-where--import Data.Bits-import Data.Default-import Language.Haskell.TH.Lift---- | Two-level logic-data Bit = L -- ^ Low- | H -- ^ High--instance Eq Bit where- (==) = eqBit--{-# NOINLINE eqBit #-}-eqBit :: Bit -> Bit -> Bool-eqBit L L = True-eqBit H H = True-eqBit _ _ = False--instance Show Bit where- show H = "1"- show L = "0"--instance Default Bit where- def = L--deriveLift ''Bit--{-# NOINLINE bAnd #-}-bAnd :: Bit -> Bit -> Bit-bAnd H H = H-bAnd _ _ = L--{-# NOINLINE bOr #-}-bOr :: Bit -> Bit -> Bit-bOr L L = L-bOr _ _ = H--{-# NOINLINE bXor #-}-bXor :: Bit -> Bit -> Bit-bXor L L = L-bXor H H = L-bXor _ _ = H--{-# NOINLINE bNot #-}-bNot :: Bit -> Bit-bNot L = H-bNot H = L--instance Bits Bit where- (.&.) = bAnd- (.|.) = bOr- xor = bXor- complement = bNot- bit = const H- testBit H _ = True- testBit _ _ = False- bitSizeMaybe = const (Just 1)- isSigned = const False- popCount H = 1- popCount _ = 0
+ src/CLaSH/Class/BitPack.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module CLaSH.Class.BitPack+ ( BitPack (..)+ , bitCoerce+ )+where++import GHC.TypeLits (KnownNat, Nat, type (+), type (*))+import Prelude hiding (map)++import CLaSH.Sized.BitVector (BitVector, (++#), high, low)+import CLaSH.Sized.Internal.BitVector (split#)+import CLaSH.Sized.Vector (Vec, concatBitVector#, map,+ unconcatBitVector#)++-- | Convert to and from a 'BitVector'+class BitPack a where+ -- | Number of 'CLaSH.Sized.BitVector.Bit's needed to represents elements+ -- of type @a@+ type BitSize a :: Nat+ -- | Convert element of type @a@ to a 'BitVector'+ --+ -- >>> pack (-5 :: Signed 6)+ -- 111011+ pack :: a -> BitVector (BitSize a)+ -- | Convert a 'BitVector' to an element of type @a@+ --+ -- >>> pack (-5 :: Signed 6)+ -- 111011+ -- >>> let x = pack (-5 :: Signed 6)+ -- >>> unpack x :: Unsigned 6+ -- 59+ -- >>> pack (59 :: Unsigned 6)+ -- 111011+ unpack :: BitVector (BitSize a) -> a++{-# INLINE bitCoerce #-}+-- | Coerce a value from one type to another through its bit representation.+--+-- >>> pack (-5 :: Signed 6)+-- 111011+-- >>> bitCoerce (-5 :: Signed 6) :: Unsigned 6+-- 59+-- >>> pack (59 :: Unsigned 6)+-- 111011+bitCoerce :: (BitPack a, BitPack b, BitSize a ~ BitSize b)+ => a+ -> b+bitCoerce = unpack . pack++instance BitPack Bool where+ type BitSize Bool = 1+ pack True = high+ pack False = low++ unpack bv = if bv == high then True else False++instance BitPack (BitVector n) where+ type BitSize (BitVector n) = n+ pack v = v+ unpack v = v++instance (KnownNat (BitSize a), KnownNat (BitSize b), BitPack a, BitPack b) =>+ BitPack (a,b) where+ type BitSize (a,b) = BitSize a + BitSize b+ pack (a,b) = pack a ++# pack b+ unpack ab = let (a,b) = split# ab in (unpack a, unpack b)++instance (KnownNat n, KnownNat (BitSize a), BitPack a) => BitPack (Vec n a) where+ type BitSize (Vec n a) = n * (BitSize a)+ pack = concatBitVector# . map pack+ unpack = map unpack . unconcatBitVector#
− src/CLaSH/Class/BitVector.hs
@@ -1,45 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-module CLaSH.Class.BitVector where--import CLaSH.Bit-import CLaSH.Sized.Vector-import GHC.TypeLits---- | Convert types from and to a 'Vec'tor of 'Bit's-class BitVector a where- -- | Number of 'Bit's needed to represents elements of type @a@- type BitSize a :: Nat- -- | Convert element of type @a@ to a 'Vec' of 'Bit's- toBV :: KnownNat (BitSize a) => a -> Vec (BitSize a) Bit- -- | Convert a 'Vec' of 'Bit's to an element of type @a@- fromBV :: KnownNat (BitSize a) => Vec (BitSize a) Bit -> a--instance BitVector Bit where- type BitSize Bit = 1- toBV = (:> Nil)- fromBV = vhead--instance BitVector Bool where- type BitSize Bool = 1- toBV = (:> Nil) . toBit- where- toBit True = H- toBit False = L- fromBV = fromBit . vhead- where- fromBit H = True- fromBit L = False--instance (KnownNat (BitSize a), KnownNat (BitSize b), BitVector a, BitVector b) => BitVector (a,b) where- type BitSize (a,b) = (BitSize a) + (BitSize b)- toBV (a,b) = toBV a <++> toBV b- fromBV bv = (fromBV (vtakeI bv), fromBV (vdropI bv))--instance (KnownNat n, KnownNat (BitSize a), BitVector a) => BitVector (Vec n a) where- type BitSize (Vec n a) = n * (BitSize a)- toBV = vconcat . vmap toBV- fromBV = vmap fromBV . vunconcatI
src/CLaSH/Class/Num.hs view
@@ -1,22 +1,72 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-module CLaSH.Class.Num where+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+module CLaSH.Class.Num+ ( -- * Arithmetic functions for arguments and results of different precision+ ExtendingNum (..)+ -- * Saturating arithmetic functions+ , SaturationMode (..)+ , SaturatingNum (..)+ , boundedPlus+ , boundedMin+ , boundedMult+ )+where -import GHC.TypeLits+-- * Arithmetic functions for arguments and results of different precision --- | Implicitly adding or subtracting values of two different (sub-)types.-class Add a b where+-- | 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. plus :: 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. minus :: a -> b -> AResult a b---- | Implicitly multiplying values of two different (sub-)types.-class Mult a b where+ -- | Type of the result of the multiplication type MResult a b- mult :: a -> b -> MResult a b+ -- | Multiply values of different (sub-)types, return a value of a (sub-)type+ -- that is potentially different from either argument.+ times :: a -> b -> MResult a b --- | Coerce a value to be represented by a different number of bits-class Resize f where- resize :: (KnownNat a, KnownNat b) => f a -> f 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.+ deriving Eq++-- | 'Num' operators in which overflow and underflow behaviour can be specified+-- using 'SaturationMode'.+class (Bounded a, Num a) => SaturatingNum a where+ -- | Addition with parametrisable over- and underflow behaviour+ satPlus :: SaturationMode -> a -> a -> a+ -- | Subtraction with parametrisable over- and underflow behaviour+ satMin :: SaturationMode -> a -> a -> a+ -- | Multiplication with parametrisable over- and underflow behaviour+ satMult :: SaturationMode -> a -> a -> a++{-# INLINE boundedPlus #-}+-- | Addition that clips to 'maxBound' on overflow, and 'minBound' on underflow+boundedPlus :: SaturatingNum a => a -> a -> a+boundedPlus = satPlus SatBound++{-# INLINE boundedMin #-}+-- | Subtraction that clips to 'maxBound' on overflow, and 'minBound' on+-- underflow+boundedMin :: SaturatingNum a => a -> a -> a+boundedMin = satMin SatBound++{-# INLINE boundedMult #-}+-- | Multiplication that clips to 'maxBound' on overflow, and 'minBound' on+-- underflow+boundedMult :: SaturatingNum a => a -> a -> a+boundedMult = satMult SatBound
+ src/CLaSH/Class/Resize.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}+module CLaSH.Class.Resize where++import GHC.TypeLits (KnownNat, Nat, type (+))++-- | Coerce a value to be represented by a different number of bits+class Resize (f :: Nat -> *) 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 + a)) => f a -> f (b + a)+ extend = resize+ -- | Add extra zero bits in front of the MSB+ zeroExtend :: (KnownNat a, KnownNat b, KnownNat (b + a)) => f a -> f (b + a)+ -- | Add extra sign bits in front of the MSB+ signExtend :: (KnownNat a, KnownNat (b + a)) => f a -> f (b + a)+ -- | Remove bits from the MSB+ truncateB :: KnownNat a => f (b + a) -> f a
src/CLaSH/Prelude.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -O0 -fno-omit-interface-pragmas #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-} {- | CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -25,37 +21,41 @@ explicitly clocked circuits in a multi-clock setting For now, "CLaSH.Prelude" is also the best starting point for exploring the- library. A tutorial module will be added within due time.+ library. A preliminary version of a tutorial can be found in "CLaSH.Tutorial". -} module CLaSH.Prelude ( -- * Creating synchronous sequential circuits- (<^>)- , registerP- -- * 'Arrow' interface for synchronous sequential circuits- , Comp (..)- , (^^^)- , registerC- , simulateC+ mealy+ , mealyB+ , (<^>)+ , registerB -- * BlockRAM primitives , blockRam , blockRamPow2- , blockRamC- , blockRamPow2C -- * Utility functions , window , windowD+ , isRising+ , isFalling -- * Testbench functions , sassert , stimuliGenerator , outputVerifier -- * Exported modules- -- ** Implicitly clocked synchronous signals- , module CLaSH.Signal.Implicit+ -- ** Synchronous signals+ , module CLaSH.Signal+ , module CLaSH.Signal.Delayed+ -- ** DataFlow interface+ , module CLaSH.Prelude.DataFlow -- ** Datatypes- , module CLaSH.Bit+ -- *** Bit vectors+ , module CLaSH.Sized.BitVector+ , module CLaSH.Prelude.BitIndex+ , module CLaSH.Prelude.BitReduction -- *** 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@@ -71,348 +71,103 @@ , Lift (..), deriveLift -- ** Type classes -- *** CLaSH- , module CLaSH.Class.BitVector+ , module CLaSH.Class.BitPack , module CLaSH.Class.Num+ , module CLaSH.Class.Resize -- *** Other- , module Control.Arrow , module Control.Applicative , module Data.Bits , module Data.Default+ , module Prelude ) where -import Control.Arrow import Control.Applicative-import Control.Category as Category import Data.Bits import Data.Default-import Debug.Trace (trace)-import CLaSH.Class.BitVector+import GHC.TypeLits+import Language.Haskell.TH.Lift (Lift(..),deriveLift)+import Prelude hiding ((++), (!!), concat, drop, foldl,+ foldl1, foldr, foldr1, head, init,+ iterate, last, length, map, repeat,+ replicate, reverse, scanl, scanr,+ splitAt, tail, take, unzip, zip,+ zipWith)++import CLaSH.Class.BitPack import CLaSH.Class.Num+import CLaSH.Class.Resize+import CLaSH.Prelude.BitIndex+import CLaSH.Prelude.BitReduction+import CLaSH.Prelude.BlockRam (blockRam, blockRamPow2)+import CLaSH.Prelude.Explicit (cregisterB, cwindow, cwindowD, cisRising,+ cisFalling)+import CLaSH.Prelude.Mealy (mealy, mealyB, (<^>))+import CLaSH.Prelude.DataFlow+import CLaSH.Prelude.Testbench (sassert, stimuliGenerator, outputVerifier) import CLaSH.Promoted.Nat import CLaSH.Promoted.Nat.TH import CLaSH.Promoted.Nat.Literals import CLaSH.Promoted.Ord+import CLaSH.Sized.BitVector import CLaSH.Sized.Fixed+import CLaSH.Sized.Index import CLaSH.Sized.Signed import CLaSH.Sized.Unsigned import CLaSH.Sized.Vector-import CLaSH.Bit-import CLaSH.Signal.Implicit-import GHC.TypeLits-import Language.Haskell.TH.Lift (Lift(..),deriveLift)+import CLaSH.Signal+import CLaSH.Signal.Delayed+import CLaSH.Signal.Explicit (systemClock) -{-# INLINABLE window #-}+{-# INLINE window #-} -- | Give a window over a 'Signal' -- -- > window4 :: Signal Int -> Vec 4 (Signal Int) -- > window4 = window ----- >>> simulateP window4 [1,2,3,4,5,...+-- >>> simulateB window4 [1,2,3,4,5,... -- [<1,0,0,0>, <2,1,0,0>, <3,2,1,0>, <4,3,2,1>, <5,4,3,2>,...-window :: (KnownNat (n + 1), Default a)- => Signal a -- ^ Signal to create a window over- -> Vec ((n + 1) + 1) (Signal a) -- ^ Window of at least size 2-window x = x :> prev- where- prev = registerP (vcopyI def) next- next = x +>> prev+window :: (KnownNat n, Default a)+ => Signal a -- ^ Signal to create a window over+ -> Vec (n + 1) (Signal a) -- ^ Window of at least size 1+window = cwindow systemClock -{-# INLINABLE windowD #-}+{-# INLINE windowD #-} -- | Give a delayed window over a 'Signal' -- -- > windowD3 :: Signal Int -> Vec 3 (Signal Int) -- > windowD3 = windowD ----- >>> simulateP windowD3 [1,2,3,4,...+-- >>> simulateB windowD3 [1,2,3,4,... -- [<0,0,0>, <1,0,0>, <2,1,0>, <3,2,1>, <4,3,2>,... windowD :: (KnownNat (n + 1), Default a) => Signal a -- ^ Signal to create a window over -> Vec (n + 1) (Signal a) -- ^ Window of at least size 1-windowD x = prev- where- prev = registerP (vcopyI def) next- next = x +>> prev--{-# INLINABLE (<^>) #-}--- | Create a synchronous function from a combinational function describing--- a mealy machine------ > mac :: Int -- Current state--- > -> (Int,Int) -- Input--- > -> (Int,Int) -- (Updated state, output)--- > mac s (x,y) = (s',s)--- > where--- > s' = x * y + s--- >--- > topEntity :: (Signal Int, Signal Int) -> Signal Int--- > topEntity = mac <^> 0------ >>> simulateP topEntity [(1,1),(2,2),(3,3),(4,4),...--- [0,1,5,14,30,...------ Synchronous sequential functions can be composed just like their combinational counterpart:------ > dualMac :: (Signal Int, Signal Int)--- > -> (Signal Int, Signal Int)--- > -> Signal Int--- > dualMac (a,b) (x,y) = s1 + s2--- > where--- > s1 = (mac <^> 0) (a,b)--- > s2 = (mac <^> 0) (x,y)-(<^>) :: (Pack i, Pack o)- => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@- -> s -- ^ Initial state- -> (SignalP i -> SignalP o) -- ^ Synchronous sequential function with input and output matching that of the mealy machine-f <^> iS = \i -> let (s',o) = unpack $ f <$> s <*> pack i- s = register iS s'- in unpack o+windowD = cwindowD systemClock -{-# INLINABLE registerP #-}+{-# INLINE registerB #-} -- | Create a 'register' function for product-type like signals (e.g. '(Signal a, Signal b)') -- -- > rP :: (Signal Int,Signal Int) -> (Signal Int, Signal Int)--- > rP = registerP (8,8)------ >>> simulateP rP [(1,1),(2,2),(3,3),...--- [(8,8),(1,1),(2,2),(3,3),...-registerP :: Pack a => a -> SignalP a -> SignalP a-registerP i = unpack Prelude.. register i Prelude.. pack--{-# NOINLINE blockRam #-}--- | Create a blockRAM with space for @n@ elements.------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > bram40 :: Signal (Unsigned 6) -> Signal (Unsigned 6) -> Signal Bool -> Signal Bit -> Signal Bit--- > bram40 = blockRam (vcopy d40 H)-blockRam :: (Pack a, KnownNat n, KnownNat m)- => Vec n a -- ^ Initial content of the BRAM, also determines the size ,@n@, of the BRAM.- -- NB: *MUST* be a constant.- -> Signal (Unsigned m) -- ^ Write address @w@- -> Signal (Unsigned m) -- ^ Read address @r@- -> Signal Bool -- ^ Write enable- -> Signal a -- ^ Value to write (at address @w@)- -> Signal a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle-blockRam binit wr rd en din = pack $ (bram' <^> (binit,undefined)) (wr,rd,en,din)- where- bram' (ram,o) (w,r,e,d) = ((ram',o'),o)- where- ram' | e = vreplace ram w d- | otherwise = ram- o' = ram ! r--{-# DEPRECATED blockRamC "'Comp' is deprecated and will be removed in version 0.6, use 'blockRam' instead" #-}--- | Create a blockRAM with space for @n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > bramC40 :: Comp (Unsigned 6, Unsigned 6, Bool, Bit) Bit--- > bramC40 = blockRamC (vcopy d40 H)-blockRamC :: (KnownNat n, KnownNat m, Pack a)- => Vec n a -- ^ Initial content of the BRAM, also determines the size ,@n@, of the BRAM.- -- NB: *MUST* be a constant.- -> Comp (Unsigned m, Unsigned m, Bool, a) a-blockRamC n = C ((\(wr,rd,en,din) -> blockRam n wr rd en din) Prelude.. unpack)--{-# INLINABLE blockRamPow2 #-}--- | Create a blockRAM with space for 2^@n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > bram32 :: Signal (Unsigned 5) -> Signal (Unsigned 5) -> Signal Bool -> Signal Bit -> Signal Bit--- > bram32 = blockRamPow2 (vcopy d32 H)-blockRamPow2 :: (KnownNat (2^n), KnownNat n, Pack a)- => Vec (2^n) a -- ^ Initial content of the BRAM, also determines the size ,@2^n@, of the BRAM.- -- NB: *MUST* be a constant.- -> Signal (Unsigned n) -- ^ Write address @w@- -> Signal (Unsigned n) -- ^ Read address @r@- -> Signal Bool -- ^ Write enable- -> Signal a -- ^ Value to write (at address @w@)- -> Signal a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle-blockRamPow2 = blockRam--{-# DEPRECATED blockRamPow2C "'Comp' is deprecated and will be removed in version 0.6, use 'blockRamPow2' instead" #-}--- | Create a blockRAM with space for 2^@n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > bramC32 :: Comp (Unsigned 5, Unsigned 5, Bool, Bit) Bit--- > bramC32 = blockRamPow2C (vcopy d32 H)-blockRamPow2C :: (KnownNat (2^n), KnownNat n, Pack a)- => Vec (2^n) a -- ^ Initial content of the BRAM, also determines the size ,@2^n@, of the BRAM.- -- NB: *MUST* be a constant.- -> Comp (Unsigned n, Unsigned n, Bool, a) a-blockRamPow2C n = C ((\(wr,rd,en,din) -> blockRamPow2 n wr rd en din) Prelude.. unpack)--{-# DEPRECATED Comp "Will be removed in version 0.6. Use 'Applicative' interface and ('<^>') instead" #-}--- | 'Comp'onent: an 'Arrow' interface to synchronous sequential functions-newtype Comp a b = C { asFunction :: Signal a -> Signal b }--instance Category Comp where- id = C Prelude.id- (C f) . (C g) = C (f Prelude.. g)--instance Arrow Comp where- arr = C Prelude.. fmap- first (C f) = C $ pack Prelude.. (f >< Prelude.id) Prelude.. unpack- where- (g >< h) (x,y) = (g x,h y)--instance ArrowLoop Comp where- loop (C f) = C $ simpleLoop (unpack Prelude.. f Prelude.. pack)- where- simpleLoop g b = let ~(c,d) = g (b,d)- in c--{-# DEPRECATED registerC "'Comp' is deprecated and will be removed in version 0.6, use 'register' instead" #-}--- | Create a 'register' 'Comp'onent------ > rC :: Comp (Int,Int) (Int,Int)--- > rC = registerC (8,8)+-- > rP = registerB (8,8) ----- >>> simulateC rP [(1,1),(2,2),(3,3),...+-- >>> simulateB rP [(1,1),(2,2),(3,3),... -- [(8,8),(1,1),(2,2),(3,3),...-registerC :: a -> Comp a a-registerC = C Prelude.. register--{-# DEPRECATED simulateC "'Comp' is deprecated and will be removed in version 0.6, use 'simulate' instead" #-}--- | Simulate a 'Comp'onent given a list of samples------ >>> simulateC (registerC 8) [1, 2, 3, ...--- [8, 1, 2, 3, ...-simulateC :: Comp a b -> [a] -> [b]-simulateC f = simulate (asFunction f)--{-# DEPRECATED (^^^) "Will be removed in version 0.6. Use 'Applicative' interface and ('<^>') instead" #-}-{-# INLINABLE (^^^) #-}--- | Create a synchronous 'Comp'onent from a combinational function describing--- a mealy machine------ > mac :: Int -- Current state--- > -> (Int,Int) -- Input--- > -> (Int,Int) -- (Updated state, output)--- > mac s (x,y) = (s',s)--- > where--- > s' = x * y + s--- >--- > topEntity :: Comp (Int,Int) Int--- > topEntity = mac ^^^ 0------ >>> simulateC topEntity [(1,1),(2,2),(3,3),(4,4),...--- [0,1,5,14,30,...------ Synchronous sequential must be composed using the 'Arrow' syntax------ > dualMac :: Comp (Int,Int,Int,Int) Int--- > dualMac = proc (a,b,x,y) -> do--- > rec s1 <- mac ^^^ 0 -< (a,b)--- > s2 <- mac ^^^ 0 -< (x,y)--- > returnA -< (s1 + s2)-(^^^) :: (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@- -> s -- ^ Initial state- -> Comp i o -- ^ Synchronous sequential 'Comp'onent with input and output matching that of the mealy machine-f ^^^ sI = C $ \i -> let (s',o) = unpack $ f <$> s <*> i- s = register sI s'- in o--{-# NOINLINE sassert #-}--- | Compares the first two arguments for equality and logs a warning when they--- are not equal. The second argument is considered the expected value. This--- function simply returns the third argument unaltered as its result. This--- function is used by 'outputVerifier'.------ This function is translated to the following VHDL:------ > sassert_block : block--- > begin--- > -- pragma translate_off--- > process(clk_1000,reset_1000,arg0,arg1) is--- > begin--- > if (rising_edge(clk_1000) or rising_edge(reset_1000)) then--- > assert (arg0 = arg1) report ("expected: " & to_string (arg1) & \", actual: \" & to_string (arg0)) severity error;--- > end if;--- > end process;--- > -- pragma translate_on--- > result <= arg2;--- > end block;------ And can, due to the pragmas, be used in synthesizable designs-sassert :: (Eq a, Show a)- => Signal a -- ^ Checked value- -> Signal a -- ^ Expected value- -> Signal b -- ^ Returned value- -> Signal b-sassert = liftA3- (\a' b' c' -> if a' == b' then c'- else trace ("\nexpected value: " ++ show b' ++ ", not equal to actual value: " ++ show a') c')--{-# INLINABLE stimuliGenerator #-}--- | To be used as a one of the functions to create the \"magical\" 'testInput'--- value, which the CλaSH compilers looks for to create the stimulus generator--- for the generated VHDL testbench.------ Example:------ > testInput :: Signal Int--- > testInput = stimuliGenerator $(v [(1::Int),3..21])------ >>> sample testInput--- [1,3,5,7,9,11,13,15,17,19,21,21,21,...-stimuliGenerator :: forall l a . KnownNat l- => Vec l a -- ^ Samples to generate- -> Signal a -- ^ Signal of given samples-stimuliGenerator samples =- let (r,o) = unpack (genT <$> register (fromInteger (maxIndex samples)) r)- in o- where- genT :: Unsigned l -> (Unsigned l, a)- genT s = (s',samples ! s)- where- s' = if s > 0 then s - 1- else s+registerB :: Bundle a => a -> Unbundled' a -> Unbundled' a+registerB = cregisterB systemClock -{-# INLINABLE outputVerifier #-}--- | To be used as a functions to generate the \"magical\" 'expectedOutput'--- function, which the CλaSH compilers looks for to create the signal verifier--- for the generated VHDL testbench.------ Example:------ > expectedOutput :: Signal Int -> Signal Bool--- > expectedOutput = outputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int]))------ >>> sample (expectedOutput (fromList ([0..10] ++ [10,10,10])))--- [--- expected value: 70, not equal to actual value: 0--- False,--- expected value: 99, not equal to actual value: 1--- False,False,False,False,False,--- expected value: 7, not equal to actual value: 6--- False,--- expected value: 8, not equal to actual value: 7--- False,--- expected value: 9, not equal to actual value: 8--- False,--- expected value: 10, not equal to actual value: 9--- False,True,True,...-outputVerifier :: forall l a . (KnownNat l, Eq a, Show a)- => Vec l a -- ^ Samples to compare with- -> Signal a -- ^ Signal to verify- -> Signal Bool -- ^ Indicator that all samples are verified-outputVerifier samples i =- let (s,o) = unpack (genT <$> register (fromInteger (maxIndex samples)) s)- (e,f) = unpack o- in sassert i e (register False f)- where- genT :: Unsigned l -> (Unsigned l, (a,Bool))- genT s = (s',(samples ! s,finished))- where- s' = if s >= 1 then s - 1- else s+{-# INLINE isRising #-}+-- | Give a pulse when the 'Signal' goes from 'minBound' to 'maxBound'+isRising :: (Bounded a, Eq a)+ => a -- ^ Starting value+ -> Signal a+ -> Signal Bool+isRising = cisRising systemClock - finished = s == 0+{-# INLINE isFalling #-}+-- | Give a pulse when the 'Signal' goes from 'maxBound' to 'minBound'+isFalling :: (Bounded a, Eq a)+ => a -- ^ Starting value+ -> Signal a+ -> Signal Bool+isFalling = cisFalling systemClock
+ src/CLaSH/Prelude/BitIndex.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}++module CLaSH.Prelude.BitIndex where++import GHC.TypeLits (KnownNat, type (+), type (-))++import CLaSH.Class.BitPack (BitPack (..))+import CLaSH.Promoted.Nat (SNat)+import CLaSH.Sized.Internal.BitVector (BitVector, Bit, index#, lsb#, msb#,+ replaceBit#, setSlice#, slice#, split#)++{-# INLINE (!) #-}+-- | Get the bit at the specified bit index.+--+-- __NB:__ Bit indices are __DESCENDING__.+--+-- >>> pack (7 :: Unsigned 6)+-- 000111+-- >>> (7 :: Unsigned 6) ! 1+-- 1+-- >>> (7 :: Unsigned 6) ! 5+-- 0+-- >>> (7 :: Unsigned 6) ! 6+-- *** Exception: (!): 6 is out of range [5..0]+(!) :: (BitPack a, KnownNat (BitSize a), Integral i) => a -> i -> Bit+(!) v i = index# (pack v) (fromIntegral i)++{-# INLINE slice #-}+-- | Get a slice between bit index @m@ and and bit index @n@.+--+-- __NB:__ Bit indices are __DESCENDING__.+--+-- >>> pack (7 :: Unsigned 6)+-- 000111+-- >>> slice (7 :: Unsigned 6) d4 d2+-- 001+-- >>> slice (7 :: Unsigned 6) d6 d4+-- <interactive>+-- Couldn't match type ‘7 + i0’ with ‘6’+-- The type variable ‘i0’ is ambiguous+-- Expected type: (6 + 1) + i0+-- Actual type: BitSize (Unsigned 6)+-- In the expression: slice (7 :: Unsigned 6) d6 d4+-- In an equation for ‘it’: it = slice (7 :: Unsigned 6) d6 d4+slice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => a -> SNat m -> SNat n+ -> BitVector (m + 1 - n)+slice v m n = 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)+-- 000111+-- >>> split (7 :: Unsigned 6) :: (BitVector 2, BitVector 4)+-- (00,0111)+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)+-- 111011+-- >>> replaceBit (-5 :: Signed 6) 4 0+-- -21+-- >>> pack (-21 :: Signed 6)+-- 101011+-- >>> replaceBit (-5 :: Signed 6) 5 0+-- 27+-- >>> pack (27 :: Signed 6)+-- 011011+-- >>> replaceBit (-5 :: Signed 6) 6 0+-- *** Exception: replaceBit: 6 is out of range [5..0]+replaceBit :: (BitPack a, KnownNat (BitSize a), Integral i) => a -> i -> Bit+ -> a+replaceBit v i b = unpack (replaceBit# (pack v) (fromIntegral i) b)++{-# INLINE setSlice #-}+-- | Set the bits between bit index @m@ and bit index @n@.+--+-- __NB:__ Bit indices are __DESCENDING__.+--+-- >>> pack (-5 :: Signed 6)+-- 111011+-- >>> setSlice (-5 :: Signed 6) d4 d3 0+-- -29+-- >>> pack (-29 :: Signed 6)+-- 100011+-- >>> setSlice (-5 :: Signed 6) d6 d5 0+-- <interactive>:25:1:+-- Couldn't match type ‘7 + i0’ with ‘6’+-- The type variable ‘i0’ is ambiguous+-- Expected type: (6 + 1) + i0+-- Actual type: BitSize (Signed 6)+-- In the expression: setSlice (- 5 :: Signed 6) d6 d5 0+-- In an equation for ‘it’: it = setSlice (- 5 :: Signed 6) d6 d5 0+setSlice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => a -> SNat m -> SNat n+ -> BitVector (m + 1 - n) -> a+setSlice v m n w = unpack (setSlice# (pack v) m n w)++{-# INLINE msb #-}+-- | Get the most significant bit.+--+-- >>> pack (-4 :: Signed 6)+-- 111100+-- >>> msb (-4 :: Signed 6)+-- 1+-- >>> pack (4 :: Signed 6)+-- 000100+-- >>> msb (4 :: Signed 6)+-- 0+msb :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+msb v = msb# (pack v)++{-# INLINE lsb #-}+-- | Get the least significant bit.+--+-- >>> pack (-9 :: Signed 6)+-- 110111+-- >>> lsb (-9 :: Signed 6)+-- 1+-- >>> pack (-8 :: Signed 6)+-- 111000+-- >>> lsb (-8 :: Signed 6)+-- 0+lsb :: BitPack a => a -> Bit+lsb v = lsb# (pack v)
+ src/CLaSH/Prelude/BitReduction.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}++module CLaSH.Prelude.BitReduction where++import GHC.TypeLits (KnownNat)++import CLaSH.Class.BitPack (BitPack (..))+import CLaSH.Sized.Internal.BitVector (Bit, reduceAnd#, reduceOr#, reduceXor#)++{-# INLINE reduceAnd #-}+-- | Are all bits set to '1'?+--+-- >>> pack (-2 :: Signed 6)+-- 111110+-- >>> reduceAnd (-2 :: Signed 6)+-- 0+-- >>> pack (-1 :: Signed 6)+-- 111111+-- >>> reduceAnd (-1 :: Signed 6)+-- 1+reduceAnd :: (BitPack a, KnownNat (BitSize a)) => a -> Bit+reduceAnd v = reduceAnd# (pack v)++{-# INLINE reduceOr #-}+-- | Is there at least one bit set to '1'?+--+-- >>> pack (5 :: Signed 6)+-- 000101+-- >>> reduceOr (5 :: Signed 6)+-- 1+-- >>> pack (0 :: Signed 6)+-- 000000+-- >>> reduceOr (0 :: Signed 6)+-- 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)+-- 000101+-- >>> reduceXor (5 :: Signed 6)+-- 0+-- >>> pack (28 :: Signed 6)+-- 011100+-- >>> reduceXor (28 :: Signed 6)+-- 1+-- >>> pack (-5 :: Signed 6)+-- 111011+-- >>> reduceXor (-5 :: Signed 6)+-- 1+reduceXor :: BitPack a => a -> Bit+reduceXor v = reduceXor# (pack v)
+ src/CLaSH/Prelude/BlockRam.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+module CLaSH.Prelude.BlockRam where++import GHC.TypeLits (KnownNat, type (^))+import Prelude hiding ((!!))++import CLaSH.Prelude.Mealy (cmealy)+import CLaSH.Signal (Signal)+import CLaSH.Signal.Explicit (CSignal, SClock, systemClock)+import CLaSH.Signal.Bundle (bundle)+import CLaSH.Sized.Unsigned (Unsigned)+import CLaSH.Sized.Vector (Vec, (!!), replace)++{-# INLINE blockRam #-}+-- | Create a blockRAM with space for @n@ elements.+--+-- * __NB__: Read value is delayed by 1 cycle+-- * __NB__: Initial output value is 'undefined'+--+-- > bram40 :: Signal (Unsigned 6) -> Signal (Unsigned 6) -> Signal Bool+-- > -> Signal Bit -> Signal Bit+-- > bram40 = blockRam (replicate d40 H)+blockRam :: (KnownNat n, KnownNat m)+ => Vec n a -- ^ Initial content of the BRAM, also+ -- determines the size, @n@, of the BRAM.+ --+ -- __NB__: __MUST__ be a constant.+ -> Signal (Unsigned m) -- ^ Write address @w@+ -> Signal (Unsigned m) -- ^ Read address @r@+ -> Signal Bool -- ^ Write enable+ -> Signal a -- ^ Value to write (at address @w@)+ -> Signal a+ -- ^ Value of the 'blockRAM' at address @r@ from the previous clock+ -- cycle+blockRam = cblockRam systemClock++{-# INLINE blockRamPow2 #-}+-- | Create a blockRAM with space for 2^@n@ elements+--+-- * __NB__: Read value is delayed by 1 cycle+-- * __NB__: Initial output value is 'undefined'+--+-- > bram32 :: Signal (Unsigned 5) -> Signal (Unsigned 5) -> Signal Bool+-- > -> Signal Bit -> Signal Bit+-- > bram32 = blockRamPow2 (replicate d32 H)+blockRamPow2 :: (KnownNat (2^n), KnownNat n)+ => Vec (2^n) a -- ^ Initial content of the BRAM, also+ -- determines the size, @2^n@, of the BRAM.+ --+ -- __NB__: __MUST__ be a constant.+ -> Signal (Unsigned n) -- ^ Write address @w@+ -> Signal (Unsigned n) -- ^ Read address @r@+ -> Signal Bool -- ^ Write enable+ -> Signal a -- ^ Value to write (at address @w@)+ -> Signal a+ -- ^ Value of the 'blockRAM' at address @r@ from the previous clock+ -- cycle+blockRamPow2 = blockRam++{-# NOINLINE cblockRam #-}+-- | Create a blockRAM with space for @n@ elements+--+-- * __NB__: Read value is delayed by 1 cycle+-- * __NB__: Initial output value is 'undefined'+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+-- >+-- > bram40 :: CSignal ClkA (Unsigned 6) -> CSignal ClkA (Unsigned 6)+-- > -> CSignal ClkA Bool -> CSignal ClkA Bit -> ClkA CSignal Bit+-- > bram40 = cblockRam clkA100 (replicate d40 H)+cblockRam :: (KnownNat n, KnownNat m)+ => SClock clk -- ^ 'Clock' to synchronize to+ -> Vec n a -- ^ Initial content of the BRAM, also+ -- determines the size, @n@, of the BRAM.+ --+ -- __NB__: __MUST__ be a constant.+ -> CSignal clk (Unsigned m) -- ^ Write address @w@+ -> CSignal clk (Unsigned m) -- ^ Read address @r@+ -> CSignal clk Bool -- ^ Write enable+ -> CSignal clk a -- ^ Value to write (at address @w@)+ -> CSignal clk a+ -- ^ Value of the 'blockRAM' at address @r@ from the previous clock+ -- cycle+cblockRam clk binit wr rd en din =+ cmealy clk bram' (binit,undefined) (bundle clk (wr,rd,en,din))+ where+ bram' (ram,o) (w,r,e,d) = ((ram',o'),o)+ where+ ram' | e = replace ram w d+ | otherwise = ram+ o' = ram !! r++{-# INLINE cblockRamPow2 #-}+-- | Create a blockRAM with space for 2^@n@ elements+--+-- * __NB__: Read value is delayed by 1 cycle+-- * __NB__: Initial output value is 'undefined'+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+-- >+-- > bramC32 :: CSignal ClkA (Unsigned 5) -> CSignal ClkA (Unsigned 5)+-- > -> CSignal ClkA Bool -> CSignal ClkA Bit -> CSignal ClkA Bit+-- > bramC32 = cblockRamPow2 clkA100 (replicate d32 H)+cblockRamPow2 :: (KnownNat n, KnownNat (2^n))+ => SClock clk -- ^ 'Clock' to synchronize to+ -> Vec (2^n) a -- ^ Initial content of the BRAM, also+ -- determines the size, @2^n@, of+ -- the BRAM.+ --+ -- __NB__: __MUST__ be a constant.+ -> CSignal clk (Unsigned n) -- ^ Write address @w@+ -> CSignal clk (Unsigned n) -- ^ Read address @r@+ -> CSignal clk Bool -- ^ Write enable+ -> CSignal clk a -- ^ Value to write (at address @w@)+ -> CSignal clk a+ -- ^ Value of the 'blockRAM' at address @r@ from the previous+ -- clock cycle+cblockRamPow2 = cblockRam
+ src/CLaSH/Prelude/DataFlow.hs view
@@ -0,0 +1,336 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Self-synchronising circuits based on data-flow principles.+module CLaSH.Prelude.DataFlow+ ( -- * Data types+ DataFlow+ , DataFlow'+ , df+ -- * Creating DataFlow circuits+ , liftDF+ , mealyDF+ -- * Composition combinators+ , idDF+ , seqDF+ , firstDF+ , swapDF+ , secondDF+ , parDF+ , loopDF+ -- * Lock-Step operation+ , lockStep+ , stepLock+ )+where++import Data.Functor ((<$>))+import Control.Applicative (Applicative (..))+import GHC.TypeLits (KnownNat, KnownSymbol)++import CLaSH.Signal ((.&&.), regEn, unbundle')+import CLaSH.Signal.Bundle (Bundle (..))+import CLaSH.Signal.Explicit (Clock (..), CSignal, SystemClock, sclock)++{- | Dataflow circuit with bidirectional synchronisation 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 clk iEn oEn i o+ = DF+ { df :: CSignal clk i -- Incoming data+ -> CSignal clk iEn -- Flagged with /valid/ bits @iEn@.+ -> CSignal clk oEn -- Incoming back-pressure, /ready/ edge.+ -> ( CSignal clk o -- Outgoing data.+ , CSignal clk oEn -- Flagged with /valid/ bits @oEn@.+ , CSignal clk iEn -- Outgoing back-pressure, /ready/ edge.+ )+ }+@++where:++ * @clk@ is the clock to which the circuit is synchronised.+ * @iEn@ is the type of the bidirectional incoming synchronisation channel.+ * @oEn@ is the type of the bidirectional outgoing synchronisation 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+parametrise in the types of the synchronisation channels.+-}+newtype DataFlow clk iEn oEn i o+ = DF+ { -- | Create an ordinary circuit from a 'DataFlow' circuit+ df :: CSignal clk i -- Incoming data+ -> CSignal clk iEn -- Flagged with /valid/ bits @iEn@.+ -> CSignal clk oEn -- Incoming back-pressure, /ready/ edge.+ -> ( CSignal clk o -- Outgoing data.+ , CSignal clk oEn -- Flagged with /valid/ bits @oEn@.+ , CSignal clk iEn -- Outgoing back-pressure, /ready/ edge.+ )+ }++-- | Dataflow circuit synchronised to the 'SystemClock'.+type DataFlow' iEn oEn i o = DataFlow SystemClock iEn oEn i o++-- | Create a 'DataFlow' circuit from a circuit description with the appropriate+-- type:+--+-- > CSignal clk i -- Incoming data.+-- > -> CSignal clk Bool -- Flagged with a single /valid/ bit.+-- > -> CSignal clk Bool -- Incoming back-pressure, /ready/ bit.+-- > -> ( CSignal clk o -- Outgoing data.+-- > , CSignal clk oEn -- Flagged with a single /valid/ bit.+-- > , CSignal clk 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 :: (CSignal clk i -> CSignal clk Bool -> CSignal clk Bool+ -> (CSignal clk o, CSignal clk Bool, CSignal clk Bool))+ -> DataFlow clk Bool Bool i o+liftDF = DF++-- | Create a 'DataFlow' circuit from a Mealy machine description as those of+-- "CLaSH.Prelude.Mealy"+mealyDF :: (s -> i -> (s,o))+ -> s+ -> DataFlow' Bool Bool i o+mealyDF f iS = DF (\i iV oR -> let en = iV .&&. oR+ (s',o) = unbundle' (f <$> s <*> i)+ s = regEn iS en s'+ in (o,iV,oR))++-- | Identity circuit+--+-- <<doc/idDF.svg>>+idDF :: DataFlow clk en en a a+idDF = DF (\a val rdy -> (a,val,rdy))++-- | Sequential composition of two 'DataFlow' circuits.+--+-- <<doc/seqDF.svg>>+seqDF :: DataFlow clk aEn bEn a b+ -> DataFlow clk bEn cEn b c+ -> DataFlow clk 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.+--+-- <<doc/firstDF.svg>>+firstDF :: (KnownSymbol nm, KnownNat rate)+ => DataFlow (Clk nm rate) aEn bEn a b+ -> DataFlow (Clk nm rate) (aEn,cEn) (bEn,cEn) (a,c) (b,c)+firstDF (DF f) = DF (\ac acV bcR -> let clk = sclock+ (a,c) = unbundle clk ac+ (aV,cV) = unbundle clk acV+ (bR,cR) = unbundle clk bcR+ (b,bV,aR) = f a aV bR+ bc = bundle clk (b,c)+ bcV = bundle clk (bV,cV)+ acR = bundle clk (aR,cR)+ in (bc,bcV,acR)+ )++-- | Swap the two communication channels.+--+-- <<doc/swapDF.svg>>+swapDF :: (KnownSymbol nm, KnownNat rate)+ => DataFlow (Clk nm rate) (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.+--+-- <<doc/secondDF.svg>>+secondDF :: (KnownSymbol nm, KnownNat rate)+ => DataFlow (Clk nm rate) aEn bEn a b+ -> DataFlow (Clk nm rate) (cEn,aEn) (cEn,bEn) (c,a) (c,b)+secondDF f = swapDF `seqDF` firstDF f `seqDF` swapDF++-- | Compose two 'DataFlow' circuits in parallel.+--+-- <<doc/parDF.svg>>+parDF :: (KnownSymbol nm, KnownNat rate)+ => DataFlow (Clk nm rate) aEn bEn a b+ -> DataFlow (Clk nm rate) cEn dEn c d+ -> DataFlow (Clk nm rate) (aEn,cEn) (bEn,dEn) (a,c) (b,d)+f `parDF` g = firstDF f `seqDF` secondDF g++-- | Feed back the second halve of the communication channel.+--+-- Given:+--+-- > f `seqDF` (loopDF h) `seqDF` g+--+-- The circuits @f@, @h@, and @g@, will operate in /lock-step/. Which means that+-- there it only progress when all three circuits are producing /valid/ data+-- and all three circuits are /ready/ to receive new data. The 'loopDF' function+-- uses the 'lockStep' and 'stepLock' functions to achieve the /lock-step/+-- operation.+--+-- <<doc/loopDF.svg>>+loopDF :: forall nm rate a b d . (KnownSymbol nm, KnownNat rate)+ => DataFlow (Clk nm rate) Bool Bool (a,d) (b,d)+ -> DataFlow (Clk nm rate) Bool Bool a b+loopDF f = loopDF' h+ where+ h :: DataFlow (Clk nm rate) (Bool,Bool) (Bool,Bool) (a,d) (b,d)+ h = lockStep `seqDF` f `seqDF` stepLock++ loopDF' :: DataFlow (Clk nm rate) (Bool,Bool) (Bool,Bool) (a,d) (b,d)+ -> DataFlow (Clk nm rate) Bool Bool a b+ loopDF' (DF f') = DF (\a aV bR -> let clk = sclock+ (bd,bdV,adR) = f' ad adV bdR+ (b,d) = unbundle clk bd+ (bV,dV) = unbundle clk bdV+ (aR,dR) = unbundle clk adR+ ad = bundle clk (a,d)+ adV = bundle clk (aV,dV)+ bdR = bundle clk (bR,dR)+ in (b,bV,aR)+ )++-- | Have parallel compositions operate in lock-step.+class LockStep a b where+ -- | Reduce the synchronisation 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 synchronisation 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 synchronisation signals are+ -- properly connected:+ --+ -- > (f `parDF` g) `seqDF` lockStep `seqDF` h+ --+ -- <<doc/lockStep.svg>>+ --+ -- Note that '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 :: (KnownNat rate,KnownSymbol nm)+ => DataFlow (Clk nm rate) a Bool b b++ -- | Extend the synchronisation 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 synchronisation 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 synchronisation signals are+ -- properly connected:+ --+ -- > h `seqDF` stepLock `seqDF` (f `parDF` g)+ --+ -- <<doc/stepLock.svg>>+ --+ -- Note that '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` lockStep` `seqDF` q+ --+ -- Does the right thing.+ stepLock :: (KnownNat rate,KnownSymbol nm)+ => DataFlow (Clk nm rate) 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 clk = sclock+ (xV,yV) = unbundle clk xyV+ val = xV .&&. yV+ xR = yV .&&. rdy+ yR = xV .&&. rdy+ xyR = bundle clk (xR,yR)+ in (xy,val,xyR)))++ stepLock = (DF (\xy val xyR -> let clk = sclock+ (xR,yR) = unbundle clk xyR+ rdy = xR .&&. yR+ xV = val .&&. yR+ yV = val .&&. xR+ xyV = bundle clk (xV,yV)+ in (xy,xyV,rdy))) `seqDF` (stepLock `parDF` stepLock)+
src/CLaSH/Prelude/Explicit.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -O0 -fno-omit-interface-pragmas #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-} {- | This module defines the explicitly clocked counterparts of the functions@@ -17,21 +13,17 @@ -} module CLaSH.Prelude.Explicit ( -- * Creating synchronous sequential circuits- sync- , cregisterP- -- * 'Arrow' interface for synchronous sequential circuits- , CComp (..)- , syncA- , cregisterC- , csimulateC+ cmealy+ , cmealyB+ , cregisterB -- * BlockRAM primitives , cblockRam , cblockRamPow2- , blockRamCC- , blockRamPow2CC -- * Utility functions , cwindow , cwindowD+ , cisRising+ , cisFalling -- * Testbench functions , csassert , cstimuliGenerator@@ -42,230 +34,30 @@ ) where -import Data.Default (Default (..))-import Debug.Trace (trace)-import Control.Applicative (Applicative (..), (<$>),liftA3)-import Control.Arrow (Arrow (..), ArrowLoop (..))-import Control.Category as Category-import GHC.TypeLits (KnownNat,type (^), type (+))+import Control.Applicative (liftA2)+import Data.Default (Default (..))+import GHC.TypeLits (KnownNat, type (+), natVal)+import Prelude hiding (repeat) -import CLaSH.Promoted.Nat (snat)+import CLaSH.Prelude.BlockRam (cblockRam, cblockRamPow2)+import CLaSH.Prelude.Mealy (cmealy, cmealyB)+import CLaSH.Prelude.Testbench (csassert, cstimuliGenerator, coutputVerifier) import CLaSH.Signal.Explicit-import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.Sized.Vector (Vec (..), (!), (+>>), maxIndex, vcopyI, vreplace)--{-# INLINABLE sync #-}--- | Create a synchronous function from a combinational function describing--- a mealy machine------ > mac :: Int -- Current state--- > -> (Int,Int) -- Input--- > -> (Int,Int) -- (Updated state, output)--- > mac s (x,y) = (s',s)--- > where--- > s' = x * y + s--- >--- > clk100 = Clock d100--- >--- > topEntity :: (CSignal 100 Int, CSignal 100 Int) -> CSignal 100 Int--- > topEntity = sync clk100 mac 0------ >>> csimulateP clk100 clk100 topEntity [(1,1),(2,2),(3,3),(4,4),...--- [0,1,5,14,30,...------ Synchronous sequential functions can be composed just like their combinational counterpart:------ > dualMac :: (CSignal 100 Int, CSignal 100 Int)--- > -> (CSignal 100 Int, CSignal 100 Int)--- > -> CSignal 100 Int--- > dualMac (a,b) (x,y) = s1 + s2--- > where--- > s1 = sync clk100 mac 0 (a,b)--- > s2 = sync clk100 mac 0 (x,y)-sync :: (CPack i, CPack o)- => Clock clk -- ^ 'Clock' to synchronize to- -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@- -> s -- ^ Initial state- -> (CSignalP clk i -> CSignalP clk o) -- ^ Synchronous sequential function with input and output matching that of the mealy machine-sync clk f iS = \i -> let (s',o) = cunpack clk $ f <$> s <*> cpack clk i- s = cregister clk iS s'- in cunpack clk o+import CLaSH.Sized.Vector (Vec (..), (+>>), asNatProxy, repeat) -{-# INLINABLE cregisterP #-}--- | Create a 'register' function for product-type like signals (e.g. '(Signal a, Signal b)')+{-# INLINE cregisterB #-}+-- | Create a 'register' function for product-type like signals (e.g.+-- '(Signal a, Signal b)') -- -- > clk100 = Clock d100 -- > -- > rP :: (CSignal 100 Int, CSignal 100 Int) -> (CSignal 100 Int, CSignal 100 Int)--- > rP = cregisterP d100 (8,8)------ >>> csimulateP clk100 clk100 rP [(1,1),(2,2),(3,3),...--- [(8,8),(1,1),(2,2),(3,3),...-cregisterP :: CPack a => Clock clk -> a -> CSignalP clk a -> CSignalP clk a-cregisterP clk i = cunpack clk Prelude.. cregister clk i Prelude.. cpack clk--{-# DEPRECATED CComp "Will be removed in version 0.6. Use 'Applicative' interface and 'sync' instead" #-}--- | 'CComp'onent: an 'Arrow' interface to explicitly clocked synchronous--- sequential functions-newtype CComp t a b = CC { asCFunction :: CSignal t a -> CSignal t b }--instance Category (CComp t) where- id = CC Prelude.id- (CC f) . (CC g) = CC (f Prelude.. g)--instance KnownNat t => Arrow (CComp t) where- arr = CC Prelude.. fmap- first (CC f) = let clk = Clock snat- in CC $ cpack clk Prelude.. (f >< Prelude.id) Prelude.. cunpack clk- where- (g >< h) (x,y) = (g x,h y)--instance KnownNat t => ArrowLoop (CComp t) where- loop (CC f) = let clk = Clock snat- in CC $ simpleLoop (cunpack clk Prelude.. f Prelude.. cpack clk)- where- simpleLoop g b = let ~(c,d) = g (b,d)- in c--{-# DEPRECATED syncA "Will be removed in version 0.6. Use 'Applicative' interface and 'sync' instead" #-}-{-# INLINABLE syncA #-}--- | Create a synchronous 'CComp'onent from a combinational function describing--- a mealy machine------ > mac :: Int -- Current state--- > -> (Int,Int) -- Input--- > -> (Int,Int) -- (Updated state, output)--- > mac s (x,y) = (s',s)--- > where--- > s' = x * y + s--- >--- > clk100 = Clock d100--- >--- > topEntity :: CComp 100 (Int,Int) Int--- > topEntity = syncA clk100 mac 0------ >>> simulateC topEntity [(1,1),(2,2),(3,3),(4,4),...--- [0,1,5,14,30,...------ Synchronous sequential must be composed using the 'Arrow' syntax------ > dualMac :: CComp 100 (Int,Int,Int,Int) Int--- > dualMac = proc (a,b,x,y) -> do--- > rec s1 <- syncA clk100 mac 0 -< (a,b)--- > s2 <- syncA clk100 mac 0 -< (x,y)--- > returnA -< (s1 + s2)-syncA :: Clock clk -- ^ 'Clock' to synchronize to- -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: @state -> input -> (newstate,output)@- -> s -- ^ Initial state- -> CComp clk i o -- ^ Synchronous sequential 'Comp'onent with input and output matching that of the mealy machine-syncA clk f sI = CC $ \i -> let (s',o) = cunpack clk $ f <$> s <*> i- s = cregister clk sI s'- in o--{-# DEPRECATED cregisterC "'CComp' is deprecated and will be removed in version 0.6, use 'cregister' instead" #-}--- | Create a 'cregister' 'CComp'onent------ > clk100 = Clock d100--- >--- > rC :: CComp 100 (Int,Int) (Int,Int)--- > rC = cregisterC clk100 (8,8)+-- > rP = cregisterB d100 (8,8) ----- >>> simulateC rP [(1,1),(2,2),(3,3),...+-- >>> csimulateB clk100 clk100 rP [(1,1),(2,2),(3,3),... -- [(8,8),(1,1),(2,2),(3,3),...-cregisterC :: Clock clk -> a -> CComp clk a a-cregisterC clk = CC Prelude.. cregister clk--{-# DEPRECATED csimulateC "'CComp' is deprecated and will be removed in version 0.6, use 'csimulate' instead" #-}--- | Simulate a 'Comp'onent given a list of samples------ > clk100 = Clock d100--- >>> csimulateC (cregisterC clk100 8) [1, 2, 3, ...--- [8, 1, 2, 3, ...-csimulateC :: CComp clk a b -> [a] -> [b]-csimulateC f = csimulate (asCFunction f)--{-# NOINLINE cblockRam #-}--- | Create a blockRAM with space for @n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > clk100 = Clock d100--- >--- > bram40 :: CSignal 100 (Unsigned 6) -> CSignal 100 (Unsigned 6)--- > -> CSignal 100 Bool -> CSignal 100 Bit -> 100 CSignal Bit--- > bram40 = cblockRam clk100 (vcopy d40 H)-cblockRam :: (CPack a, KnownNat n, KnownNat m)- => Clock clk -- ^ 'Clock' to synchronize to- -> Vec n a -- ^ Initial content of the BRAM, also determines the size ,@n@, of the BRAM.- -- NB: *MUST* be a constant.- -> CSignal clk (Unsigned m) -- ^ Write address @w@- -> CSignal clk (Unsigned m) -- ^ Read address @r@- -> CSignal clk Bool -- ^ Write enable- -> CSignal clk a -- ^ Value to write (at address @w@)- -> CSignal clk a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle-cblockRam clk binit wr rd en din = cpack clk $ (sync clk bram' (binit,undefined)) (wr,rd,en,din)- where- bram' (ram,o) (w,r,e,d) = ((ram',o'),o)- where- ram' | e = vreplace ram w d- | otherwise = ram- o' = ram ! r--{-# DEPRECATED blockRamCC "'CComp' is deprecated and will be removed in version 0.6, use 'cblockRam' instead" #-}--- | Create a blockRAM with space for @n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > clk100 = Clock d100--- >--- > bramC40 :: CComp 100 (Unsigned 6, Unsigned 6, Bool, Bit) Bit--- > bramC40 = blockRamCC clk100 (vcopy d40 H)-blockRamCC :: (KnownNat n, KnownNat m, CPack a, Default a)- => Clock clk -- ^ 'Clock' to synchronize to- -> Vec n a -- ^ Initial content of the BRAM, also determines the size ,@n@, of the BRAM.- -- NB: *MUST* be a constant.- -> CComp clk (Unsigned m, Unsigned m, Bool, a) a-blockRamCC clk n = CC ((\(wr,rd,en,din) -> cblockRam clk n wr rd en din) Prelude.. cunpack clk)--{-# INLINABLE cblockRamPow2 #-}--- | Create a blockRAM with space for 2^@n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > clk100 = Clock d100--- >--- > bramC32 :: CSignal 100 (Unsigned 5) -> CSignal 100 (Unsigned 5) -> CSignal 100 Bool -> CSignal 100 Bit -> CSignal 100 Bit--- > bramC32 = cblockRamPow2 clk100 (vcopy d32 H)-cblockRamPow2 :: (KnownNat n, KnownNat (2^n), CPack a)- => Clock clk -- ^ 'Clock' to synchronize to- -> Vec (2^n) a -- ^ Initial content of the BRAM, also determines the size ,@2^n@, of the BRAM.- -- NB: *MUST* be a constant.- -> CSignal clk (Unsigned n) -- ^ Write address @w@- -> CSignal clk (Unsigned n) -- ^ Read address @r@- -> CSignal clk Bool -- ^ Write enable- -> CSignal clk a -- ^ Value to write (at address @w@)- -> CSignal clk a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle-cblockRamPow2 = cblockRam--{-# DEPRECATED blockRamPow2CC "'CComp' is deprecated and will be removed in version 0.6, use 'cblockRamPow2' instead" #-}--- | Create a blockRAM with space for 2^@n@ elements------ * NB: Read value is delayed by 1 cycle--- * NB: Initial output value is `undefined`------ > clk100 = Clock d100--- >--- > bramC32 :: CComp 100 (Unsigned 5, Unsigned 5, Bool, Bit) Bit--- > bramC32 = blockRamPow2CC clk100 (vcopy d32 Bit)-blockRamPow2CC :: (KnownNat n, KnownNat (2^n), CPack a)- => Clock clk -- ^ 'Clock' to synchronize to- -> Vec (2^n) a -- ^ Initial content of the BRAM, also determines the size ,@2^n@, of the BRAM.- -- NB: *MUST* be a constant.- -> CComp clk (Unsigned n, Unsigned n, Bool, a) a-blockRamPow2CC clk n = CC ((\(wr,rd,en,din) -> cblockRamPow2 clk n wr rd en din) Prelude.. cunpack clk)+cregisterB :: Bundle a => SClock clk -> a -> Unbundled clk a -> Unbundled clk a+cregisterB clk i = unbundle clk Prelude.. cregister clk i Prelude.. bundle clk {-# INLINABLE cwindow #-} -- | Give a window over a 'CSignal'@@ -273,16 +65,20 @@ -- > window4 :: Signal Int -> Vec 4 (Signal Int) -- > window4 = window ----- >>> csimulateP window4 [1,2,3,4,5,...+-- >>> csimulateB window4 [1,2,3,4,5,... -- [<1,0,0,0>, <2,1,0,0>, <3,2,1,0>, <4,3,2,1>, <5,4,3,2>,...-cwindow :: (KnownNat (n + 1), Default a)- => Clock clk -- ^ Clock to which the incoming signal is synchronized- -> CSignal clk a -- ^ Signal to create a window over- -> Vec ((n + 1) + 1) (CSignal clk a) -- ^ Window of at least size 2-cwindow clk x = x :> prev+cwindow :: (KnownNat n, Default a)+ => SClock clk -- ^ Clock to which the incoming+ -- signal is synchronized+ -> CSignal clk a -- ^ Signal to create a window over+ -> Vec (n + 1) (CSignal clk a) -- ^ Window of at least size 1+cwindow clk x = res where- prev = cregisterP clk (vcopyI def) next- next = x +>> prev+ res = x :> prev+ prev = case natVal (asNatProxy prev) of+ 0 -> repeat def+ _ -> let next = x +>> prev+ in cregisterB clk (repeat def) next {-# INLINABLE cwindowD #-} -- | Give a delayed window over a 'CSignal'@@ -290,117 +86,38 @@ -- > windowD3 :: Signal Int -> Vec 3 (Signal Int) -- > windowD3 = windowD ----- >>> csimulateP windowD3 [1,2,3,4,...+-- >>> csimulateB windowD3 [1,2,3,4,... -- [<0,0,0>, <1,0,0>, <2,1,0>, <3,2,1>, <4,3,2>,... cwindowD :: (KnownNat (n + 1), Default a)- => Clock clk -- ^ Clock to which the incoming signal is synchronized- -> CSignal clk a -- ^ Signal to create a window over- -> Vec (n + 1) (CSignal clk a) -- ^ Window of at least size 1+ => SClock clk -- ^ Clock to which the incoming signal+ -- is synchronized+ -> CSignal clk a -- ^ Signal to create a window over+ -> Vec (n + 1) (CSignal clk a) -- ^ Window of at least size 1 cwindowD clk x = prev where- prev = cregisterP clk (vcopyI def) next+ prev = cregisterB clk (repeat def) next next = x +>> prev -{-# NOINLINE csassert #-}--- | Compares the first two arguments for equality and logs a warning when they--- are not equal. The second argument is considered the expected value. This--- function simply returns the third argument unaltered as its result. This--- function is used by 'coutputVerifier'.--------- This function is translated to the following VHDL:------ > csassert_block : block--- > begin--- > -- pragma translate_off--- > process(clk_t,reset_t,arg0,arg1) is--- > begin--- > if (rising_edge(clk_t) or rising_edge(reset_t)) then--- > assert (arg0 = arg1) report ("expected: " & to_string (arg1) & \", actual: \" & to_string (arg0)) severity error;--- > end if;--- > end process;--- > -- pragma translate_on--- > result <= arg2;--- > end block;------ And can, due to the pragmas, be used in synthesizable designs-csassert :: (Eq a,Show a)- => CSignal t a -- ^ Checked value- -> CSignal t a -- ^ Expected value- -> CSignal t b -- ^ Return valued- -> CSignal t b-csassert = liftA3- (\a' b' c' -> if a' == b' then c'- else trace ("\nexpected value: " ++ show b' ++ ", not equal to actual value: " ++ show a') c')--{-# INLINABLE cstimuliGenerator #-}--- | To be used as a one of the functions to create the \"magical\" 'testInput'--- value, which the CλaSH compilers looks for to create the stimulus generator--- for the generated VHDL testbench.------ Example:------ > clk2 = Clock d2--- >--- > testInput :: CSignal 2 Int--- > testInput = cstimuliGenerator $(v [(1::Int),3..21]) clk2------ >>> csample testInput--- [1,3,5,7,9,11,13,15,17,19,21,21,21,...-cstimuliGenerator :: forall l clk a . KnownNat l- => Vec l a -- ^ Samples to generate- -> Clock clk -- ^ Clock to synchronize the output signal to- -> CSignal clk a -- ^ Signal of given samples-cstimuliGenerator samples clk =- let (r,o) = cunpack clk (genT <$> cregister clk (fromInteger (maxIndex samples)) r)- in o+{-# INLINABLE cisRising #-}+-- | Give a pulse when the 'CSignal' goes from 'minBound' to 'maxBound'+cisRising :: (Bounded a, Eq a)+ => SClock clk+ -> a -- ^ Starting value+ -> CSignal clk a+ -> CSignal clk Bool+cisRising clk is s = liftA2 edgeDetect prev s where- genT :: Unsigned l -> (Unsigned l,a)- genT s = (s',samples ! s)- where- s' = if s > 0 then s - 1- else s+ prev = cregister clk is s+ edgeDetect old new = old == minBound && new == maxBound -{-# INLINABLE coutputVerifier #-}--- | To be used as a functions to generate the \"magical\" 'expectedOutput'--- function, which the CλaSH compilers looks for to create the signal verifier--- for the generated VHDL testbench.------ Example:------ > clk7 = Clock d7--- >--- > expectedOutput :: CSignal 7 Int -> CSignal 7 Bool--- > expectedOutput = coutputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int])) clk7------ >>> csample (expectedOutput (cfromList ([0..10] ++ [10,10,10])))--- [--- expected value: 70, not equal to actual value: 0--- False,--- expected value: 99, not equal to actual value: 1--- False,False,False,False,False,--- expected value: 7, not equal to actual value: 6--- False,--- expected value: 8, not equal to actual value: 7--- False,--- expected value: 9, not equal to actual value: 8--- False,--- expected value: 10, not equal to actual value: 9--- False,True,True,...-coutputVerifier :: forall l clk a . (KnownNat l, Eq a, Show a)- => Vec l a -- ^ Samples to compare with- -> Clock clk -- ^ Clock the input signal is synchronized to- -> CSignal clk a -- ^ Signal to verify- -> CSignal clk Bool -- ^ Indicator that all samples are verified-coutputVerifier samples clk i =- let (s,o) = cunpack clk (genT <$> cregister clk (fromInteger (maxIndex samples)) s)- (e,f) = cunpack clk o- in csassert i e (cregister clk False f)+{-# INLINABLE cisFalling #-}+-- | Give a pulse when the 'CSignal' goes from 'maxBound' to 'minBound'+cisFalling :: (Bounded a, Eq a)+ => SClock clk+ -> a -- ^ Starting value+ -> CSignal clk a+ -> CSignal clk Bool+cisFalling clk is s = liftA2 edgeDetect prev s where- genT :: Unsigned l -> (Unsigned l,(a,Bool))- genT s = (s',(samples ! s,finished))- where- s' = if s >= 1 then s - 1- else s-- finished = s == 0+ prev = cregister clk is s+ edgeDetect old new = old == maxBound && new == minBound
+ src/CLaSH/Prelude/Mealy.hs view
@@ -0,0 +1,167 @@+module CLaSH.Prelude.Mealy+ ( -- * Mealy machine synchronised to the system clock+ mealy+ , mealyB+ , (<^>)+ -- * Mealy machine synchronised to an arbitrary clock+ , cmealy+ , cmealyB+ )+where++import Control.Applicative ((<$>), (<*>))++import CLaSH.Signal (Signal, Unbundled')+import CLaSH.Signal.Explicit (CSignal, SClock, cregister, systemClock)+import CLaSH.Signal.Bundle (Bundle (..), Unbundled)++{-# INLINE mealy #-}+-- | Create a synchronous function from a combinational function describing+-- a mealy machine+--+-- > mac :: Int -- Current state+-- > -> (Int,Int) -- Input+-- > -> (Int,Int) -- (Updated state, output)+-- > mac s (x,y) = (s',s)+-- > where+-- > s' = x * y + s+-- >+-- > topEntity :: Signal (Int, Int) -> Signal Int+-- > topEntity = mealy mac 0+--+-- >>> simulate topEntity [(1,1),(2,2),(3,3),(4,4),...+-- [0,1,5,14,30,...+--+-- Synchronous sequential functions can be composed just like their+-- combinational counterpart:+--+-- > dualMac :: (Signal Int, Signal Int)+-- > -> (Signal Int, Signal Int)+-- > -> Signal Int+-- > dualMac (a,b) (x,y) = s1 + s2+-- > where+-- > s1 = mealy mac 0 (bundle' (a,x))+-- > s2 = mealy mac 0 (bundle' (b,y))+mealy :: (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form:+ -- @state -> input -> (newstate,output)@+ -> s -- ^ Initial state+ -> (Signal i -> Signal o)+ -- ^ Synchronous sequential function with input and output matching that+ -- of the mealy machine+mealy = cmealy systemClock++{-# INLINE mealyB #-}+-- | 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'' (i1,c)))+-- @+--+-- 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 (i1,c)+mealyB :: (Bundle i, Bundle o)+ => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form:+ -- @state -> input -> (newstate,output)@+ -> s -- ^ Initial state+ -> (Unbundled' i -> Unbundled' o)+ -- ^ Synchronous sequential function with input and output matching that+ -- of the mealy machine+mealyB = cmealyB systemClock++{-# INLINE (<^>) #-}+-- | Infix version of 'mealyB'+(<^>) :: (Bundle i, Bundle o)+ => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form:+ -- @state -> input -> (newstate,output)@+ -> s -- ^ Initial state+ -> (Unbundled' i -> Unbundled' o)+ -- ^ Synchronous sequential function with input and output matching that+ -- of the mealy machine+(<^>) = mealyB++{-# INLINABLE cmealy #-}+-- | Create a synchronous function from a combinational function describing+-- a mealy machine+--+-- > mac :: Int -- Current state+-- > -> (Int,Int) -- Input+-- > -> (Int,Int) -- (Updated state, output)+-- > mac s (x,y) = (s',s)+-- > where+-- > s' = x * y + s+-- >+-- > clk100 = Clock d100+-- >+-- > topEntity :: CSignal 100 (Int, Int) -> CSignal 100 Int+-- > topEntity = cmealy clk100 mac 0+--+-- >>> csimulate clk100 clk100 topEntity [(1,1),(2,2),(3,3),(4,4),...+-- [0,1,5,14,30,...+--+-- Synchronous sequential functions can be composed just like their+-- combinational counterpart:+--+-- > dualMac :: (CSignal 100 Int, CSignal 100 Int)+-- > -> (CSignal 100 Int, CSignal 100 Int)+-- > -> CSignal 100 Int+-- > dualMac (a,b) (x,y) = s1 + s2+-- > where+-- > s1 = cmealy clk100 mac 0 (bundle clk100 (a,x))+-- > s2 = cmealy clk100 mac 0 (bundle clk100 (b,y))+cmealy :: SClock clk -- ^ 'Clock' to synchronize to+ -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form:+ -- @state -> input -> (newstate,output)@+ -> s -- ^ Initial state+ -> (CSignal clk i -> CSignal clk o)+ -- ^ Synchronous sequential function with input and output matching that+ -- of the mealy machine+cmealy clk f iS = \i -> let (s',o) = unbundle clk $ f <$> s <*> i+ s = cregister clk iS s'+ in o++{-# INLINE cmealyB #-}+-- | A version of 'cmealy' 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 'cmealy', we have to+-- write:+--+-- @+-- g clk a b c = (b1,b2,i2)+-- where+-- (i1,b1) = 'unbundle' clk (cmealy clk f 0 ('bundle' clk (a,b)))+-- (i2,b2) = 'unbundle' clk (cmealy clk f 3 ('bundle' clk (i1,c)))+-- @+--+-- Using 'cmealyB' however we can write:+--+-- > g a b c = (b1,b2,i2)+-- > where+-- > (i1,b1) = cmealyB clk f 0 (a,b)+-- > (i2,b2) = cmealyB clk f 3 (i1,c)+cmealyB :: (Bundle i, Bundle o)+ => SClock clk+ -> (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form:+ -- @state -> input -> (newstate,output)@+ -> s -- ^ Initial state+ -> (Unbundled clk i -> Unbundled clk o)+ -- ^ Synchronous sequential function with input and output matching that+ -- of the mealy machine+cmealyB clk f iS i = unbundle clk (cmealy clk f iS (bundle clk i))
+ src/CLaSH/Prelude/Testbench.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE ScopedTypeVariables #-}++module CLaSH.Prelude.Testbench+ ( -- * Testbench functions for circuits synchronised to the system slock+ sassert+ , stimuliGenerator+ , outputVerifier+ -- * Testbench functions for circuits synchronised to arbitrary clocks+ , csassert+ , cstimuliGenerator+ , coutputVerifier+ )+where++import Control.Applicative ((<$>), liftA3)+import Debug.Trace (trace)+import GHC.TypeLits (KnownNat)+import Prelude hiding ((!!))++import CLaSH.Signal (Signal)+import CLaSH.Signal.Explicit (CSignal, SClock, cregister, systemClock)+import CLaSH.Signal.Bundle (unbundle)+import CLaSH.Sized.Index (Index)+import CLaSH.Sized.Vector (Vec, (!!), maxIndex)++{-# INLINE sassert #-}+-- | Compares the first two arguments for equality and logs a warning when they+-- are not equal. The second argument is considered the expected value. This+-- function simply returns the third argument unaltered as its result. This+-- function is used by 'outputVerifier'.+--+-- This function is translated to the following VHDL:+--+-- > sassert_block : block+-- > begin+-- > -- pragma translate_off+-- > process(clk_1000,reset_1000,arg0,arg1) is+-- > begin+-- > if (rising_edge(clk_1000) or rising_edge(reset_1000)) then+-- > assert (arg0 = arg1) report ("expected: " & to_string (arg1) & \", actual: \" & to_string (arg0)) severity error;+-- > end if;+-- > end process;+-- > -- pragma translate_on+-- > result <= arg2;+-- > end block;+--+-- And can, due to the pragmas, be used in synthesizable designs+sassert :: (Eq a, Show a)+ => Signal a -- ^ Checked value+ -> Signal a -- ^ Expected value+ -> Signal b -- ^ Returned value+ -> Signal b+sassert = csassert++{-# INLINE stimuliGenerator #-}+-- | To be used as a one of the functions to create the \"magical\" 'testInput'+-- value, which the CλaSH compilers looks for to create the stimulus generator+-- for the generated VHDL testbench.+--+-- Example:+--+-- > testInput :: Signal Int+-- > testInput = stimuliGenerator $(v [(1::Int),3..21])+--+-- >>> sample testInput+-- [1,3,5,7,9,11,13,15,17,19,21,21,21,...+stimuliGenerator :: forall l a . KnownNat l+ => Vec l a -- ^ Samples to generate+ -> Signal a -- ^ Signal of given samples+stimuliGenerator = cstimuliGenerator systemClock++{-# INLINE outputVerifier #-}+-- | To be used as a functions to generate the \"magical\" 'expectedOutput'+-- function, which the CλaSH compilers looks for to create the signal verifier+-- for the generated VHDL testbench.+--+-- Example:+--+-- > expectedOutput :: Signal Int -> Signal Bool+-- > expectedOutput = outputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int]))+--+-- >>> sample (expectedOutput (fromList ([0..10] ++ [10,10,10])))+-- [+-- expected value: 70, not equal to actual value: 0+-- False,+-- expected value: 99, not equal to actual value: 1+-- False,False,False,False,False,+-- expected value: 7, not equal to actual value: 6+-- False,+-- expected value: 8, not equal to actual value: 7+-- False,+-- expected value: 9, not equal to actual value: 8+-- False,+-- expected value: 10, not equal to actual value: 9+-- False,True,True,...+outputVerifier :: forall l a . (KnownNat l, Eq a, Show a)+ => Vec l a -- ^ Samples to compare with+ -> Signal a -- ^ Signal to verify+ -> Signal Bool -- ^ Indicator that all samples are verified+outputVerifier = coutputVerifier systemClock++{-# NOINLINE csassert #-}+-- | Compares the first two arguments for equality and logs a warning when they+-- are not equal. The second argument is considered the expected value. This+-- function simply returns the third argument unaltered as its result. This+-- function is used by 'coutputVerifier'.+--+--+-- This function is translated to the following VHDL:+--+-- > csassert_block : block+-- > begin+-- > -- pragma translate_off+-- > process(clk_t,reset_t,arg0,arg1) is+-- > begin+-- > if (rising_edge(clk_t) or rising_edge(reset_t)) then+-- > assert (arg0 = arg1) report ("expected: " & to_string (arg1) & \", actual: \" & to_string (arg0)) severity error;+-- > end if;+-- > end process;+-- > -- pragma translate_on+-- > result <= arg2;+-- > end block;+--+-- And can, due to the pragmas, be used in synthesizable designs+csassert :: (Eq a,Show a)+ => CSignal t a -- ^ Checked value+ -> CSignal t a -- ^ Expected value+ -> CSignal t b -- ^ Return valued+ -> CSignal t b+csassert = liftA3+ (\a' b' c' -> if a' == b' then c'+ else trace (concat [ "\nexpected value: "+ , show b'+ , ", not equal to actual value: "+ , show a'+ ]) c')++{-# INLINABLE cstimuliGenerator #-}+-- | To be used as a one of the functions to create the \"magical\" 'testInput'+-- value, which the CλaSH compilers looks for to create the stimulus generator+-- for the generated VHDL testbench.+--+-- Example:+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA :: SClock ClkA+-- > clkA = sclock+-- >+-- > testInput :: CSignal clkA Int+-- > testInput = cstimuliGenerator clkA $(v [(1::Int),3..21])+--+-- >>> csample testInput+-- [1,3,5,7,9,11,13,15,17,19,21,21,21,...+cstimuliGenerator :: forall l clk a . KnownNat l+ => SClock clk -- ^ Clock to which to synchronize the+ -- output signal+ -> Vec l a -- ^ Samples to generate+ -> CSignal clk a -- ^ Signal of given samples+cstimuliGenerator clk samples =+ let (r,o) = unbundle clk (genT <$> cregister clk 0 r)+ in o+ where+ genT :: Index l -> (Index l,a)+ genT s = (s',samples !! s)+ where+ maxI = fromInteger (maxIndex samples)++ s' = if s < maxI+ then s + 1+ else s++{-# INLINABLE coutputVerifier #-}+-- | To be used as a functions to generate the \"magical\" 'expectedOutput'+-- function, which the CλaSH compilers looks for to create the signal verifier+-- for the generated VHDL testbench.+--+-- Example:+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA :: SClock ClkA+-- > clkA = sclock+-- >+-- > expectedOutput :: CSignal ClkA Int -> CSignal ClkA Bool+-- > expectedOutput = coutputVerifier clkA $(v ([70,99,2,3,4,5,7,8,9,10]::[Int]))+--+-- >>> csample (expectedOutput (cfromList ([0..10] ++ [10,10,10])))+-- [+-- expected value: 70, not equal to actual value: 0+-- False,+-- expected value: 99, not equal to actual value: 1+-- False,False,False,False,False,+-- expected value: 7, not equal to actual value: 6+-- False,+-- expected value: 8, not equal to actual value: 7+-- False,+-- expected value: 9, not equal to actual value: 8+-- False,+-- expected value: 10, not equal to actual value: 9+-- False,True,True,...+coutputVerifier :: forall l clk a . (KnownNat l, Eq a, Show a)+ => SClock clk -- ^ Clock to which the input signal is+ -- synchronized to+ -> Vec l a -- ^ Samples to compare with+ -> CSignal clk a -- ^ Signal to verify+ -> CSignal clk Bool -- ^ Indicator that all samples are verified+coutputVerifier clk samples i =+ let (s,o) = unbundle clk (genT <$> cregister clk 0 s)+ (e,f) = unbundle clk o+ in csassert i e (cregister clk False f)+ where+ genT :: Index l -> (Index l,(a,Bool))+ genT s = (s',(samples !! s,finished))+ where+ maxI = fromInteger (maxIndex samples)++ s' = if s < maxI+ then s + 1+ else s++ finished = s == maxI
src/CLaSH/Promoted/Nat.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module CLaSH.Promoted.Nat- ( SNat, snat, withSNat, snatToInteger+ ( SNat (..), snat, withSNat, snatToInteger , UNat (..), toUNat, addUNat, multUNat, powUNat ) where@@ -16,29 +16,37 @@ -- | 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+-- * "CLaSH.Promoted.Nat.TH" has functions to easily create large ranges of new+-- 'SNat' literals data SNat (n :: Nat) = KnownNat n => SNat (Proxy n) instance Show (SNat n) where show (SNat p) = 'd' : show (natVal p) +{-# INLINE snat #-} -- | Create a singleton literal for a type-level natural number snat :: KnownNat n => SNat n snat = SNat Proxy +{-# 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 Proxy) +{-# INLINE snatToInteger #-} snatToInteger :: SNat n -> Integer snatToInteger (SNat p) = natVal p -- | Unary representation of a type-level natural+--+-- __NB__: Not synthesisable data UNat :: Nat -> * where UZero :: UNat 0 USucc :: UNat n -> UNat (n + 1) --- | Convert a singleton natural number to it's unary representation+-- | Convert a singleton natural number to its unary representation+--+-- __NB__: Not synthesisable toUNat :: SNat n -> UNat n toUNat (SNat p) = fromI (natVal p) where@@ -47,18 +55,24 @@ fromI n = unsafeCoerce (USucc (fromI (n - 1))) -- | Add two singleton natural numbers+--+-- __NB__: Not synthesisable addUNat :: UNat n -> UNat m -> UNat (n + m) addUNat UZero y = y addUNat x UZero = x addUNat (USucc x) y = unsafeCoerce (USucc (addUNat x y)) -- | Multiply two singleton natural numbers+--+-- __NB__: Not synthesisable multUNat :: UNat n -> UNat m -> UNat (n * m) multUNat UZero _ = UZero multUNat _ UZero = UZero multUNat (USucc x) y = unsafeCoerce (addUNat y (multUNat x y)) -- | Exponential of two singleton natural numbers+--+-- __NB__: Not synthesisable powUNat :: UNat n -> UNat m -> UNat (n ^ m) powUNat _ UZero = USucc UZero powUNat x (USucc y) = unsafeCoerce (multUNat x (powUNat x y))
src/CLaSH/Promoted/Nat/TH.hs view
@@ -7,7 +7,7 @@ -- | Create an 'SNat' literal ----- > $(decLiteralD "d" 1200)+-- > $(decLiteralD 1200) -- -- >>> :t d1200 -- d1200 :: SNat 1200
+ src/CLaSH/Promoted/Symbol.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+module CLaSH.Promoted.Symbol where++import Data.Proxy (Proxy (..))+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)++-- | Singleton value for a type-level string @s@+data SSymbol (s :: Symbol) = KnownSymbol s => SSymbol (Proxy s)++instance Show (SSymbol s) where+ show (SSymbol s) = symbolVal s++{-# INLINE ssymbol #-}+-- | Create a singleton literal for a type-level natural number+ssymbol :: KnownSymbol s => SSymbol s+ssymbol = SSymbol Proxy++{-# INLINE ssymbolToString #-}+ssymbolToString :: SSymbol s -> String+ssymbolToString (SSymbol s) = symbolVal s
+ src/CLaSH/Signal.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE MagicHash #-}++module CLaSH.Signal+ ( -- * Implicitly clocked synchronous signal+ Signal+ -- * Basic circuit functions+ , signal+ , register+ , regEn+ , mux+ -- * Boolean connectives+ , (.&&.), (.||.), not1+ -- * Product/Signal isomorphism+ , Bundle+ , Unbundled'+ , bundle'+ , unbundle'+ -- * Simulation functions (not synthesisable)+ , simulate+ , simulateB+ -- * List \<-\> Signal conversion (not synthesisable)+ , sample+ , sampleN+ , fromList+ -- * Type classes+ -- ** 'Eq'-like+ , (.==.), (./=.)+ -- ** 'Ord'-like+ , compare1, (.<.), (.<=.), (.>=.), (.>.)+ -- ** 'Enum'-like+ , fromEnum1+ -- ** 'Rational'-like+ , toRational1+ -- ** 'Integral'-like+ , toInteger1+ -- ** 'Bits'-like+ , testBit1+ , popCount1+ , shift1+ , rotate1+ , setBit1+ , clearBit1+ , shiftL1+ , unsafeShiftL1+ , shiftR1+ , unsafeShiftR1+ , rotateL1+ , rotateR1+ )+where++import CLaSH.Signal.Internal (CSignal, register#, regEn#, signal#, (.==.), (./=.),+ compare1, (.<.), (.<=.), (.>=.), (.>.), fromEnum1,+ toRational1, toInteger1, testBit1, popCount1,+ shift1, rotate1, setBit1, clearBit1, shiftL1,+ unsafeShiftL1, shiftR1, unsafeShiftR1, rotateL1,+ rotateR1, (.||.), (.&&.), not1, mux)+import CLaSH.Signal.Explicit (SystemClock, cfromList, csample, csampleN,+ systemClock)+import CLaSH.Signal.Bundle (Bundle (..), Unbundled)++-- * Implicitly clocked synchronous signal++-- | Signal synchronised to the \"system\" clock, which has a period of 1000.+type Signal a = CSignal SystemClock a++-- * Basic circuit functions++{-# INLINE signal #-}+-- | Create a constant 'Signal' from a combinational value+--+-- >>> sample (signal 4)+-- [4, 4, 4, 4, ...+signal :: a -> Signal a+signal = signal#++{-# INLINE register #-}+-- | 'register' @i s@ delays the values in 'Signal' @s@ for one cycle, and sets+-- the value at time 0 to @i@+--+-- >>> sampleN 3 (register 8 (fromList [1,2,3,4]))+-- [8,1,2]+register :: a -> Signal a -> Signal a+register = register# systemClock++{-# INLINE regEn #-}+-- | Version of 'register' that only updates its content when its second argument+-- is asserted. So given:+--+-- @+-- oscillate = register False ('not1' oscillate)+-- count = regEn 0 oscillate (count + 1)+-- @+--+-- We get:+--+-- >>> sampleN 8 oscillate+-- [False,True,False,True,False,True,False,True]+-- >>> sampleN 8 count+-- [0,0,1,1,2,2,3,3]+regEn :: a -> Signal Bool -> Signal a -> Signal a+regEn = regEn# systemClock++-- * Product/Signal isomorphism++-- | Isomorphism between a 'Signal' of a product type (e.g. a tuple) and a+-- product type of 'Signal's.+type Unbundled' a = Unbundled SystemClock a++{-# INLINE unbundle' #-}+-- | Example:+--+-- > unbundle' :: Signal (a,b) -> (Signal a, Signal b)+--+-- However:+--+-- > unbundle' :: Signal Bit -> Signal Bit+unbundle' :: Bundle a => Signal a -> Unbundled' a+unbundle' = unbundle systemClock++{-# INLINE bundle' #-}+-- | Example:+--+-- > bundle' :: (Signal a, Signal b) -> Signal (a,b)+--+-- However:+--+-- > bundle' :: Signal Bit -> Signal Bit+bundle' :: Bundle a => Unbundled' a -> Signal a+bundle' = bundle systemClock++-- * Simulation functions (not synthesisable)++-- | Simulate a (@'Signal' a -> 'Signal' b@) function given a list of samples of+-- type @a@+--+-- >>> simulate (register 8) [1, 2, 3, ...+-- [8, 1, 2, 3, ...+--+-- __NB__: This function is not synthesisable+simulate :: (Signal a -> Signal b) -> [a] -> [b]+simulate f = sample . f . fromList++-- | Simulate a (@'Bundled' a -> 'Bundled' b@) function given a list of samples+-- of type @a@+--+-- >>> simulateB (wrap . register (8,8) . unwrap) [(1,1), (2,2), (3,3), ...+-- [(8,8), (1,1), (2,2), (3,3), ...+--+-- __NB__: This function is not synthesisable+simulateB :: (Bundle a, Bundle b) => (Unbundled' a -> Unbundled' b) -> [a] -> [b]+simulateB f = simulate (bundle' . f . unbundle')++-- * List \<-\> Signal conversion (not synthesisable)++-- | Get an infinite list of samples from a 'Signal'+--+-- The elements in the list correspond to the values of the 'Signal' at+-- consecutive clock cycles+--+-- > sample s == [s0, s1, s2, s3, ...+--+-- __NB__: This function is not synthesisable+sample :: Signal a -> [a]+sample = csample++-- | Get a list of @n@ samples from a 'Signal'+--+-- The elements in the list correspond to the values of the 'Signal' at+-- consecutive clock cycles+--+-- > sampleN 3 s == [s0, s1, s2]+--+-- __NB__: This function is not synthesisable+sampleN :: Int -> Signal a -> [a]+sampleN = csampleN++-- | Create a 'Signal' from a list+--+-- Every element in the list will correspond to a value of the signal for one+-- clock cycle.+--+-- >>> sampleN 2 (fromList [1,2,3,4,5])+-- [1,2]+--+-- __NB__: This function is not synthesisable+fromList :: [a] -> Signal a+fromList = cfromList
+ src/CLaSH/Signal/Bundle.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-}++-- | The Product/Signal isomorphism+module CLaSH.Signal.Bundle+ ( Bundle (..)+ )+where++import Control.Applicative ((<$>), (<*>), liftA2)+import Data.Traversable (sequenceA)+import GHC.TypeLits (KnownNat)+import Prelude hiding (head, map, tail)++import CLaSH.Signal.Internal (Clock, CSignal (..), SClock)+import CLaSH.Sized.BitVector (BitVector)+import CLaSH.Sized.Fixed (Fixed)+import CLaSH.Sized.Index (Index)+import CLaSH.Sized.Signed (Signed)+import CLaSH.Sized.Unsigned (Unsigned)+import CLaSH.Sized.Vector (Vec)++-- | Isomorphism between a 'CSignal' of a product type (e.g. a tuple) and a+-- product type of 'CSignal's.+--+-- Instances of 'Bundle' must satisfy the following laws:+--+-- @+-- bundle . unbundle = 'id'+-- unbundle . bundle = 'id'+-- @+class Bundle a where+ type Unbundled (clk :: Clock) a+ type Unbundled clk a = CSignal clk a+ -- | Example:+ --+ -- > bundle :: (CSignal clk a, CSignal clk b) -> CSignal clk (a,b)+ --+ -- However:+ --+ -- > bundle :: CSignal clk Bit -> CSignal clk Bit+ bundle :: SClock clk -> Unbundled clk a -> CSignal clk a++ {-# INLINE bundle #-}+ default bundle :: SClock clk -> CSignal clk a -> CSignal clk a+ bundle _ s = s+ -- | Example:+ --+ -- > unbundle :: CSignal clk (a,b) -> (CSignal clk a, CSignal clk b)+ --+ -- However:+ --+ -- > unbundle :: CSignal clk Bit -> CSignal clk Bit+ unbundle :: SClock clk -> CSignal clk a -> Unbundled clk a++ {-# INLINE unbundle #-}+ default unbundle :: SClock clk -> CSignal clk a -> CSignal clk a+ unbundle _ s = s++instance Bundle Bool+instance Bundle Integer+instance Bundle Int+instance Bundle Float+instance Bundle Double+instance Bundle ()+instance Bundle (Maybe a)+instance Bundle (Either a b)++instance Bundle (BitVector n)+instance Bundle (Index n)+instance Bundle (Fixed rep int frac)+instance Bundle (Signed n)+instance Bundle (Unsigned n)++instance Bundle (a,b) where+ type Unbundled t (a,b) = (CSignal t a, CSignal t b)+ bundle _ = uncurry (liftA2 (,))+ unbundle _ tup = (fmap fst tup, fmap snd tup)++instance Bundle (a,b,c) where+ type Unbundled t (a,b,c) = (CSignal t a, CSignal t b, CSignal t c)+ bundle _ (a,b,c) = (,,) <$> a <*> b <*> c+ unbundle _ tup = (fmap (\(x,_,_) -> x) tup+ ,fmap (\(_,x,_) -> x) tup+ ,fmap (\(_,_,x) -> x) tup+ )++instance Bundle (a,b,c,d) where+ type Unbundled t (a,b,c,d) = ( CSignal t a, CSignal t b, CSignal t c+ , CSignal t d+ )+ bundle _ (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d+ unbundle _ tup = (fmap (\(x,_,_,_) -> x) tup+ ,fmap (\(_,x,_,_) -> x) tup+ ,fmap (\(_,_,x,_) -> x) tup+ ,fmap (\(_,_,_,x) -> x) tup+ )++instance Bundle (a,b,c,d,e) where+ type Unbundled t (a,b,c,d,e) = ( CSignal t a, CSignal t b, CSignal t c+ , CSignal t d, CSignal t e+ )+ bundle _ (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e+ unbundle _ tup = (fmap (\(x,_,_,_,_) -> x) tup+ ,fmap (\(_,x,_,_,_) -> x) tup+ ,fmap (\(_,_,x,_,_) -> x) tup+ ,fmap (\(_,_,_,x,_) -> x) tup+ ,fmap (\(_,_,_,_,x) -> x) tup+ )++instance Bundle (a,b,c,d,e,f) where+ type Unbundled t (a,b,c,d,e,f) = ( CSignal t a, CSignal t b, CSignal t c+ , CSignal t d, CSignal t e, CSignal t f+ )+ bundle _ (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f+ unbundle _ tup = (fmap (\(x,_,_,_,_,_) -> x) tup+ ,fmap (\(_,x,_,_,_,_) -> x) tup+ ,fmap (\(_,_,x,_,_,_) -> x) tup+ ,fmap (\(_,_,_,x,_,_) -> x) tup+ ,fmap (\(_,_,_,_,x,_) -> x) tup+ ,fmap (\(_,_,_,_,_,x) -> x) tup+ )++instance Bundle (a,b,c,d,e,f,g) where+ type Unbundled t (a,b,c,d,e,f,g) = ( CSignal t a, CSignal t b, CSignal t c+ , CSignal t d, CSignal t e, CSignal t f+ , CSignal t g+ )+ bundle _ (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f+ <*> g+ unbundle _ tup = (fmap (\(x,_,_,_,_,_,_) -> x) tup+ ,fmap (\(_,x,_,_,_,_,_) -> x) tup+ ,fmap (\(_,_,x,_,_,_,_) -> x) tup+ ,fmap (\(_,_,_,x,_,_,_) -> x) tup+ ,fmap (\(_,_,_,_,x,_,_) -> x) tup+ ,fmap (\(_,_,_,_,_,x,_) -> x) tup+ ,fmap (\(_,_,_,_,_,_,x) -> x) tup+ )++instance Bundle (a,b,c,d,e,f,g,h) where+ type Unbundled t (a,b,c,d,e,f,g,h) = ( CSignal t a, CSignal t b, CSignal t c+ , CSignal t d, CSignal t e, CSignal t f+ , CSignal t g, CSignal t h+ )+ bundle _ (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f+ <*> g <*> h+ unbundle _ tup = (fmap (\(x,_,_,_,_,_,_,_) -> x) tup+ ,fmap (\(_,x,_,_,_,_,_,_) -> x) tup+ ,fmap (\(_,_,x,_,_,_,_,_) -> x) tup+ ,fmap (\(_,_,_,x,_,_,_,_) -> x) tup+ ,fmap (\(_,_,_,_,x,_,_,_) -> x) tup+ ,fmap (\(_,_,_,_,_,x,_,_) -> x) tup+ ,fmap (\(_,_,_,_,_,_,x,_) -> x) tup+ ,fmap (\(_,_,_,_,_,_,_,x) -> x) tup+ )++instance KnownNat n => Bundle (Vec n a) where+ type Unbundled t (Vec n a) = Vec n (CSignal t a)+ -- The 'Traversable' instance of 'Vec' is not synthesisable, so we must+ -- define 'bundle' as a primitive.+ bundle = vecBundle#+ unbundle _ = sequenceA++{-# NOINLINE vecBundle# #-}+vecBundle# :: SClock t -> Vec n (CSignal t a) -> CSignal t (Vec n a)+vecBundle# _ = sequenceA
+ src/CLaSH/Signal/Delayed.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module CLaSH.Signal.Delayed+ ( -- * Delay-annotated synchronous signals+ DSignal+ , dsignal+ , delay+ , delayI+ , feedback+ -- * Signal \<-\> DSignal conversion+ , fromSignal+ , toSignal+ , unsafeFromSignal+ -- * List \<-\> DSignal conversion (not synthesisable)+ , dsample+ , dsampleN+ , dfromList+ )+where++import Data.Coerce (coerce)+import Data.Default (Default(..))+import Control.Applicative (Applicative (..))+import GHC.TypeLits (KnownNat, Nat, type (-))+import Language.Haskell.TH.Syntax (Lift)+import Prelude hiding (head, length, repeat)++import CLaSH.Sized.Vector (Vec, head, length, repeat, shiftInAt0,+ singleton)++import CLaSH.Signal (Signal, fromList, register, sample, sampleN,+ bundle', unbundle')++-- | A synchronized signal with samples of type @a@, synchronized to \"system\"+-- clock (period 1000), that has accumulated @delay@ amount of samples delay+-- along its path.+newtype DSignal (delay :: Nat) a =+ DSignal { -- | Strip a 'DSignal' from its delay information.+ toSignal :: Signal a+ }+ deriving (Show,Default,Lift,Functor,Applicative,Num)++-- | Create a 'DSignal' from a list+--+-- Every element in the list will correspond to a value of the signal for one+-- clock cycle.+--+-- >>> dsampleN 2 (fromList [1,2,3,4,5])+-- [1,2]+--+-- __NB__: This function is not synthesisable+dfromList :: [a] -> DSignal 0 a+dfromList = coerce . fromList++-- | Get an infinite list of samples from a 'DSignal'+--+-- The elements in the list correspond to the values of the 'DSignal' at+-- consecutive clock cycles+--+-- > dsample s == [s0, s1, s2, s3, ...+--+-- __NB__: This function is not synthesisable+dsample :: DSignal t a -> [a]+dsample = sample . coerce++-- | Get a list of @n@ samples from a 'DSignal'+--+-- The elements in the list correspond to the values of the 'DSignal' at+-- consecutive clock cycles+--+-- > dsampleN 3 s == [s0, s1, s2]+--+-- __NB__: This function is not synthesisable+dsampleN :: Int -> DSignal t a -> [a]+dsampleN n = sampleN n . coerce+++-- | Create a constant 'DSignal' from a combinational value+--+-- >>> dsample (dsignal 4)+-- [4, 4, 4, 4, ...+dsignal :: a -> DSignal n a+dsignal = pure++-- | Delay a 'DSignal' for @m@ periods.+--+-- > delay3 :: DSignal (n - 3) Int -> DSignal n Int+-- > delay3 = delay (0 :> 0 :> 0 :> Nil)+--+-- >>> dsampleN 6 (delay3 (dfromList [1..]))+-- [0,0,0,1,2,3]+delay :: forall a n m . KnownNat m+ => Vec m a+ -> DSignal (n - m) a+ -> DSignal n a+delay m ds = coerce (delay' (coerce ds))+ where+ delay' :: Signal a -> Signal a+ delay' s = case length m of+ 0 -> s+ _ -> let (r',o) = shiftInAt0 (unbundle' r) (singleton s)+ r = register m (bundle' r')+ in head o++-- | Delay a 'DSignal' for @m@ periods, where @m@ is derived from the context.+--+-- > delay2 :: DSignal (n - 2) Int -> DSignal n Int+-- > delay2 = delayI+--+-- >>> dsampleN 6 (delay2 (dfromList [1..])+-- [0,0,1,2,3,4]+delayI :: (Default a, KnownNat m)+ => DSignal (n - m) a+ -> DSignal n a+delayI = delay (repeat def)++-- | Feed the delayed result of a function back to its input:+--+-- @+-- mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int+-- mac x y = 'feedback' (mac' x y)+-- where+-- mac' :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int+-- -> (DSignal 0 Int, DSignal 1 Int)+-- mac' a b acc = let acc' = a * b + acc+-- in (acc, delay ('singleton' 0) acc')+-- @+--+-- >>> dsampleN 6 (mac (dfromList [1..]) (dfromList [1..]))+-- [0,1,5,14,30,55]+feedback :: (DSignal (n - m - 1) a -> (DSignal (n - m - 1) a,DSignal n a))+ -> DSignal (n - m - 1) a+feedback f = let (o,r) = f (coerce r) in o++-- | 'Signal's are not delayed+--+-- > sample s == dsample (fromSignal s)+fromSignal :: Signal a -> DSignal 0 a+fromSignal = coerce+++-- | __Unsafely__ convert a 'Signal' to /any/ 'DSignal'.+--+-- __NB__: Should only be used to interface with functions specified in terms of+-- 'Signal'.+unsafeFromSignal :: Signal a -> DSignal n a+unsafeFromSignal = DSignal
src/CLaSH/Signal/Explicit.hs view
@@ -1,270 +1,147 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-} module CLaSH.Signal.Explicit ( -- * Explicitly clocked synchronous signal -- $relativeclocks CSignal -- * Clock domain crossing+ -- ** Clock , Clock (..)+ , SClock (..)+ , sclock+ , withSClock+ , SystemClock+ , systemClock+ -- ** Synchronisation primitive , veryUnsafeSynchronizer- , fromImplicit- , fromExplicit- -- * Basic circuit functions+ -- * Basic circuit functions , csignal , cregister- , CPack (..)- -- * Simulation functions+ , cregEn+ -- * Product/Signal isomorphism+ , Bundle (..)+ -- * Simulation functions (not synthesisable) , csimulate- , csimulateP- -- * List \<-\> CSignal conversion+ , csimulateB+ -- * List \<-\> CSignal conversion (not synthesisable) , csample , csampleN , cfromList ) where -import Data.Coerce (coerce)-import Control.Applicative (Applicative (..), (<$>), liftA2)-import GHC.TypeLits (Nat)--import CLaSH.Bit (Bit)-import CLaSH.Promoted.Nat (snatToInteger)-import CLaSH.Sized.Fixed (Fixed)-import CLaSH.Sized.Signed (Signed)-import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.Sized.Vector (Vec(..), vmap, vhead, vtail)--import CLaSH.Signal.Implicit-import CLaSH.Signal.Types--{-# NOINLINE cregister #-}+import qualified Data.Foldable as F+import GHC.TypeLits (KnownNat, KnownSymbol) -{-# NOINLINE veryUnsafeSynchronizer #-}-{-# NOINLINE fromImplicit #-}-{-# NOINLINE fromExplicit #-}+import CLaSH.Promoted.Nat (snat, snatToInteger)+import CLaSH.Promoted.Symbol (ssymbol)+import CLaSH.Signal.Internal (CSignal (..), Clock (..), SClock (..), signal#,+ register#, regEn#)+import CLaSH.Signal.Bundle (Bundle (..), Unbundled) {- $relativeclocks #relativeclocks#-CλaSH supports explicitly clocked 'Signal's in the form of: \"@'CSignal' clk a@\",-where @clk@ is a 'Nat'ural number corresponding to the clock period of the clock-the signal is synchronized to. NB: \"Bad things\"™ happen when you actually use-a clock period of @0@, so don't do that!--The clock periods are however dimension-less, they do not refer to any explicit-time-scale (e.g. nano-seconds). The reason for the lack of an explicit time-scale-is that the CλaSH compiler would not be able guarantee that the circuit can run-at the specified frequency.--The clock periods are just there to indicate relative frequency differences-between two different clocks. That is, a \"@'CSignal' 500 a@\" is synchronized-to a clock that runs 6.5 times faster than the clock to which a-\"@'CSignal' 3250 a@\" is synchronized to. NB: You should be judicious using a-clock with period @1@ as you can never create a clock that runs faster later on!--}+CλaSH supports explicitly clocked 'CLaSH.Signal's in the form of: --- | Create a 'CSignal' from a list------ Every element in the list will correspond to a value of the signal for one--- clock cycle.------ NB: Simulation only!------ >>> csampleN 2 (cfromList [1,2,3,4,5])--- [1,2]-cfromList :: [a] -> CSignal t a-cfromList = coerce . fromList+@+'CSignal' (clk :: 'Clock') a+@ --- | Get an infinite list of samples from a 'CSignal'------ The elements in the list correspond to the values of the 'CSignal' at--- consecutive clock cycles------ > csample s == [s0, s1, s2, s3, ...-csample :: CSignal t a -> [a]-csample = sample . coerce+Where @a@ is the type of the elements, and @clk@ is the clock to which the+signal is synchronised. The type-parameter, @clk@, is of the kind 'Clock' which+has types of the following shape: --- | Get a list of @n@ samples from a 'CSignal'------ The elements in the list correspond to the values of the 'CSignal' at--- consecutive clock cycles------ > csampleN 3 s == [s0, s1, s2]-csampleN :: Int -> CSignal t a -> [a]-csampleN n = sampleN n . coerce+@+Clk \{\- name :: \-\} 'GHC.TypeLits.Symbol' \{\- period :: \-\} 'GHC.TypeLits.Nat'+@ --- | 'cregister' @i s@ delays the values in 'CSignal' @s@ for one cycle, and sets--- the value at time 0 to @i@------ > clk100 = Clock d100------ >>> csampleN 3 (cregister d100 8 (fromList [1,2,3,4]))--- [8,1,2]-cregister :: Clock clk -> a -> CSignal clk a -> CSignal clk a-cregister _ i s = coerce (register i (coerce s))+Where @name@ is a type-level string ('GHC.TypeLits.Symbol') representing the the+name of the clock, and @period@ is a type-level natural number ('GHC.TypeLits.Nat')+representing the clock period. Two concrete instances of a 'Clk' could be: --- | Simulate a (@'CSignal' clk1 a -> 'Signal' clk2 b@) function given a list of--- samples of type @a@------ >>> simulate (register 8) [1, 2, 3, ...--- [8, 1, 2, 3, ...-csimulate :: (CSignal clk1 a -> CSignal clk2 b) -> [a] -> [b]-csimulate f = csample . f . cfromList+> type ClkA500 = Clk "A500" 500+> type ClkB3250 = Clk "B3250" 3250 --- | Isomorphism between a @'CSignal' clk@ of a product type (e.g. a tuple) and a--- product type of @'CSignal' clk@'s------ Instances of 'CPack' must satisfy the following laws:------ @--- cpack clk . cunpack clk = 'id'--- cunpack clk . cpack clk = 'id'--- @-class CPack a where- type CSignalP (clk :: Nat) a- type CSignalP clk a = CSignal clk a- -- | Example:- --- -- > cpack :: Clock clk -> (CSignal clk a, CSignal clk b) -> CSignal clk (a,b)- --- -- However:- --- -- > cpack :: Clock clk -> CSignal clk Bit -> CSignal clk Bit- cpack :: Clock clk -> CSignalP clk a -> CSignal clk a+The periods of these clocks are however dimension-less, they do not refer to any+explicit time-scale (e.g. nano-seconds). The reason for the lack of an explicit+time-scale is that the CλaSH compiler would not be able guarantee that the+circuit can run at the specified frequency. The clock periods are just there to+indicate relative frequency differences between two different clocks. That is, a+signal: - default cpack :: Clock clk -> CSignal clk a -> CSignal clk a- cpack _ s = s- -- | Example:- --- -- > cunpack :: Clock clk -> CSignal clk (a,b) -> (CSignal clk a, CSignal clk b)- --- -- However:- --- -- > cunpack :: Clock clk -> CSignal clk Bit -> CSignal clk Bit- cunpack :: Clock clk -> CSignal clk a -> CSignalP clk a+@+'CSignal' ClkA500 a+@ - default cunpack :: Clock clk -> CSignal clk a -> CSignal clk a- cunpack _ s = s+is synchronized to a clock that runs 6.5 times faster than the clock to which+the signal: -instance CPack Bit-instance CPack (Signed n)-instance CPack (Unsigned n)-instance CPack (Fixed frac rep size)-instance CPack Bool-instance CPack Integer-instance CPack Int-instance CPack Float-instance CPack Double-instance CPack ()-instance CPack (Maybe a)-instance CPack (Either a b)+@+'CSignal' ClkB3250 a+@ -instance CPack (a,b) where- type CSignalP t (a,b) = (CSignal t a, CSignal t b)- cpack _ = uncurry (liftA2 (,))- cunpack _ tup = (fmap fst tup, fmap snd tup)+is synchronized to. -instance CPack (a,b,c) where- type CSignalP t (a,b,c) = (CSignal t a, CSignal t b, CSignal t c)- cpack _ (a,b,c) = (,,) <$> a <*> b <*> c- cunpack _ tup = (fmap (\(x,_,_) -> x) tup- ,fmap (\(_,x,_) -> x) tup- ,fmap (\(_,_,x) -> x) tup- )+* __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 faster!+-} -instance CPack (a,b,c,d) where- type CSignalP t (a,b,c,d) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d)- cpack _ (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d- cunpack _ tup = (fmap (\(x,_,_,_) -> x) tup- ,fmap (\(_,x,_,_) -> x) tup- ,fmap (\(_,_,x,_) -> x) tup- ,fmap (\(_,_,_,x) -> x) tup- )+-- * Clock domain crossing -instance CPack (a,b,c,d,e) where- type CSignalP t (a,b,c,d,e) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e)- cpack _ (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e- cunpack _ tup = (fmap (\(x,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,x) -> x) tup- )+-- ** Clock -instance CPack (a,b,c,d,e,f) where- type CSignalP t (a,b,c,d,e,f) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f)- cpack _ (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f- cunpack _ tup = (fmap (\(x,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,x) -> x) tup- )+{-# INLINE sclock #-}+-- | Create a singleton clock+sclock :: (KnownSymbol name, KnownNat period)+ => SClock (Clk name period)+sclock = SClock ssymbol snat -instance CPack (a,b,c,d,e,f,g) where- type CSignalP t (a,b,c,d,e,f,g) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f, CSignal t g)- cpack _ (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g- cunpack _ tup = (fmap (\(x,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,x) -> x) tup- )+{-# INLINE withSClock #-}+withSClock :: (KnownSymbol name, KnownNat period)+ => (SClock (Clk name period) -> a)+ -> a+withSClock f = f (SClock ssymbol snat) -instance CPack (a,b,c,d,e,f,g,h) where- type CSignalP t (a,b,c,d,e,f,g,h) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f, CSignal t g, CSignal t h)- cpack _ (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h- cunpack _ tup = (fmap (\(x,_,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,_,x) -> x) tup- )+-- | The standard system clock with a period of 1000+type SystemClock = Clk "system" 1000 -instance CPack (Vec n a) where- type CSignalP t (Vec n a) = Vec n (CSignal t a)- cpack clk vs = mkCSignal (vmap (shead . coerce) vs) (cpack clk (vmap cstail vs))- cunpack _ (CSignal (Nil :- _)) = Nil- cunpack clk vs@(CSignal ((_ :> _) :- _)) = fmap vhead vs :> cunpack clk (fmap vtail vs)+{-# INLINE systemClock #-}+-- | The singleton clock for 'SystemClock'+systemClock :: SClock SystemClock+systemClock = sclock --- | Simulate a (@'CSignalP' clk1 a -> 'CSignalP' clk2 b@) function given a list--- of samples of type @a@+-- ** Synchronisation primitive+{-# NOINLINE veryUnsafeSynchronizer #-}+-- | The 'veryUnsafeSynchronizer' function is a primitive that must be used to+-- connect one clock domain to the other, and will be synthesised to a (bundle+-- of) wire(s) in the eventual circuit. This function should only be used as+-- part of a proper synchronisation component, such as the following dual+-- flip-flop synchronizer: ----- > clk100 = Clock d100+-- > dualFlipFlop :: SClock clkA -> SClock clkB+-- > -> CSignal clkA Bit -> CSignal clkB Bit+-- > dualFlipFlop clkA clkB = cregister clkB low . cregister clkB low+-- > . veryUnsafeSynchronizer clkA clkB ----- >>> csimulateP clk100 clk100 (cunpack clk100 . cregister clk100 (8,8) . cpack clk100) [(1,1), (2,2), (3,3), ...--- [(8,8), (1,1), (2,2), (3,3), ...-csimulateP :: (CPack a, CPack b)- => Clock clk1 -- ^ 'Clock' of the incoming signal- -> Clock clk2 -- ^ 'Clock' of the outgoing signal- -> (CSignalP clk1 a -> CSignalP clk2 b) -- ^ Function to simulate- -> [a] -> [b]-csimulateP clk1 clk2 f = csimulate (cpack clk2 . f . cunpack clk1)---- | Synchronisation function that is basically a represented by a (bundle of)--- wire(s) in hardware. This function should only be used as part of a proper--- synchronisation component, such as a dual flip-flop synchronizer, or a FIFO--- with an asynchronous memory element:+-- The 'veryUnsafeSynchronizer' works in such a way that, given 2 clocks: ----- > dualFlipFlop :: Clock clk1 -> Clock clk2--- > -> CSignal clk1 Bit -> CSignal clk2 Bit--- > dualFlipFlop clk1 clk2 = cregister clk2 L . cregister clk2 L . veryUnsafeSynchronizer clk1 clk2+-- > type Clk7 = Clk "clk7" 7+-- >+-- > clk7 :: SClock Clk7+-- > clk7 = sclock ----- The 'veryUnsafeSynchronizer' works in such a way that, given 2 clocks:+-- and ----- > clk7 = Clock d7--- > clk2 = Clock d2+-- > type Clk2 = Clk "clk2" 2+-- >+-- > clk2 :: SClock Clk2+-- > clk2 = sclock ----- Oversampling followed by compression is the identity function plus 2 initial values:+-- Oversampling followed by compression is the identity function plus 2 initial+-- values: -- -- > cregister clk7 i $ -- > veryUnsafeSynchronizer clk2 clk7 $@@ -278,34 +155,35 @@ -- -- Something we can easily observe: ----- > oversampling = cregister clk2 99 . veryUnsafeSynchronizer clk7 clk2 . cregister clk7 50+-- > oversampling = cregister clk2 99 . veryUnsafeSynchronizer clk7 clk2+-- > . cregister clk7 50 -- > almostId = cregister clk7 70 . veryUnsafeSynchronizer clk2 clk7--- > . cregister clk2 99 . veryUnsafeSynchronizer clk7 clk2 . cregister clk7 50--- >+-- > . cregister clk2 99 . veryUnsafeSynchronizer clk7 clk2+-- > . cregister clk7 50 -- -- >>> csample (oversampling (cfromList [1..10])) -- [99, 50,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, ... -- >>> csample (almostId (cfromList [1..10])) -- [70, 99,1,2,3,4,5,6,7,8,9,10,...-veryUnsafeSynchronizer :: Clock clk1 -- ^ 'Clock' of the incoming signal- -> Clock clk2 -- ^ 'Clock' of the outgoing signal+veryUnsafeSynchronizer :: SClock clk1 -- ^ 'Clock' of the incoming signal+ -> SClock clk2 -- ^ 'Clock' of the outgoing signal -> CSignal clk1 a -> CSignal clk2 a-veryUnsafeSynchronizer (Clock clk1) (Clock clk2) s = s'+veryUnsafeSynchronizer (SClock _ period1) (SClock _ period2) s = s' where- t1 = fromInteger (snatToInteger clk1)- t2 = fromInteger (snatToInteger clk2)+ t1 = fromInteger (snatToInteger period1)+ t2 = fromInteger (snatToInteger period2) s' | t1 < t2 = compress t2 t1 s | t1 > t2 = oversample t1 t2 s | otherwise = same s same :: CSignal clk1 a -> CSignal clk2 a-same (CSignal s) = CSignal s+same (s :- ss) = s :- same ss oversample :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a-oversample high low (CSignal (s :- ss)) = CSignal (s :- oversampleS (reverse (repSchedule high low)) ss)+oversample high low (s :- ss) = s :- oversampleS (reverse (repSchedule high low)) ss -oversampleS :: [Int] -> Signal a -> Signal a+oversampleS :: [Int] -> CSignal clk1 a -> CSignal clk2 a oversampleS sched = oversample' sched where oversample' [] s = oversampleS sched s@@ -315,9 +193,9 @@ prefixN n x s = x :- prefixN (n-1) x s compress :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a-compress high low (CSignal s) = CSignal (compressS (repSchedule high low) s)+compress high low s = compressS (repSchedule high low) s -compressS :: [Int] -> Signal a -> Signal a+compressS :: [Int] -> CSignal clk1 a -> CSignal clk2 a compressS sched = compress' sched where compress' [] s = compressS sched s@@ -333,10 +211,120 @@ | cnt < th = repSchedule' (cnt+low) th (rep + 1) | otherwise = rep : repSchedule' (cnt + low) (th + high) 1 --- | Implicitly clocked signals have a clock with period 1000-fromImplicit :: Signal a -> CSignal 1000 a-fromImplicit s = CSignal s+-- * Basic circuit functions --- | Implicitly clocked signals have a clock with period 1000-fromExplicit :: CSignal 1000 a -> Signal a-fromExplicit (CSignal s) = s+{-# INLINE csignal #-}+-- | Create a constant 'CSignal' from a combinational value+--+-- >>> csample (csignal 4)+-- [4, 4, 4, 4, ...+csignal :: a -> CSignal clk a+csignal = signal#++{-# INLINE cregister #-}+-- | \"@'cregister' i s@\" delays the values in 'CSignal' @s@ for one cycle,+-- and sets the value at time 0 to @i@+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+--+-- >>> csampleN 3 (cregister clkA100 8 (fromList [1,2,3,4]))+-- [8,1,2]+cregister :: SClock clk -> a -> CSignal clk a -> CSignal clk a+cregister = register#++{-# INLINE cregEn #-}+-- | Version of 'cregister' that only updates its content when its second+-- argument is asserted. So given:+--+-- @+-- type ClkA = Clk \"A\" 100+-- clkA :: SClock Clka+-- clkA = sclock+--+-- oscillate = cregister clkA False ('not1' oscillate)+-- count = cregEn clkA 0 oscillate (count + 1)+-- @+--+-- We get:+--+-- >>> csampleN 8 oscillate+-- [False,True,False,True,False,True,False,True]+-- >>> csampleN 8 count+-- [0,0,1,1,2,2,3,3]+cregEn :: SClock clk -> a -> CSignal clk Bool -> CSignal clk a -> CSignal clk a+cregEn = regEn#++-- * Simulation functions++-- | Simulate a (@'CSignal' clk1 a -> 'CSignal' clk2 b@) function given a list+-- of samples of type @a@+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+--+-- >>> csimulate (cregister clkA100 8) [1, 2, 3, ...+-- [8, 1, 2, 3, ...+--+-- __NB__: This function is not synthesisable+csimulate :: (CSignal clk1 a -> CSignal clk2 b) -> [a] -> [b]+csimulate f = csample . f . cfromList++-- | Simulate a (@'CSignalP' clk1 a -> 'CSignalP' clk2 b@) function given a list+-- of samples of type @a@+--+-- > type ClkA = Clk "A" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+--+-- >>> csimulateB clkA100 clkA100 (cunpack clkA100 . cregister clkA100 (8,8) . cpack clkA100) [(1,1), (2,2), (3,3), ...+-- [(8,8), (1,1), (2,2), (3,3), ...+--+-- __NB__: This function is not synthesisable+csimulateB :: (Bundle a, Bundle b)+ => SClock clk1 -- ^ 'Clock' of the incoming signal+ -> SClock clk2 -- ^ 'Clock' of the outgoing signal+ -> (Unbundled clk1 a -> Unbundled clk2 b) -- ^ Function to simulate+ -> [a] -> [b]+csimulateB clk1 clk2 f = csimulate (bundle clk2 . f . unbundle clk1)++-- * List \<-\> CSignal conversion++-- | Get an infinite list of samples from a 'CSignal'+--+-- The elements in the list correspond to the values of the 'CSignal' at+-- consecutive clock cycles+--+-- > csample s == [s0, s1, s2, s3, ...+--+-- __NB__: This function is not synthesisable+csample :: CSignal clk a -> [a]+csample = F.foldr (:) []++-- | Get a list of @n@ samples from a 'CSignal'+--+-- The elements in the list correspond to the values of the 'CSignal' at+-- consecutive clock cycles+--+-- > csampleN 3 s == [s0, s1, s2]+--+-- __NB__: This function is not synthesisable+csampleN :: Int -> CSignal clk a -> [a]+csampleN n = take n . csample++-- | Create a 'CSignal' from a list+--+-- Every element in the list will correspond to a value of the signal for one+-- clock cycle.+--+-- >>> csampleN 2 (cfromList [1,2,3,4,5])+-- [1,2]+--+-- __NB__: This function is not synthesisable+cfromList :: [a] -> CSignal clk a+cfromList = foldr (:-) (error "finite list")
− src/CLaSH/Signal/Implicit.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeFamilies #-}--module CLaSH.Signal.Implicit- ( -- * Implicitly clocked synchronous signal- Signal- -- * Basic circuit functions- , signal- , register- , Pack(..)- , (<^), (^>)- -- * Simulation functions- , simulate- , simulateP- -- * List \<-\> Signal conversion- , sample- , sampleN- , fromList- )-where--import Control.Applicative (Applicative (..), (<$>), liftA2)--import CLaSH.Bit (Bit)-import CLaSH.Sized.Fixed (Fixed)-import CLaSH.Sized.Signed (Signed)-import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.Sized.Vector (Vec(..), vmap, vhead, vtail)--import CLaSH.Signal.Types--{-# NOINLINE register #-}---- | Create a 'Signal' from a list------ Every element in the list will correspond to a value of the signal for one--- clock cycle.------ NB: Simulation only!------ >>> sampleN 2 (fromList [1,2,3,4,5])--- [1,2]-fromList :: [a] -> Signal a-fromList [] = error "finite list"-fromList (x:xs) = x :- fromList xs---- | Get an infinite list of samples from a 'Signal'------ The elements in the list correspond to the values of the 'Signal' at--- consecutive clock cycles------ > sample s == [s0, s1, s2, s3, ...-sample :: Signal a -> [a]-sample ~(x :- xs) = x : sample xs---- | Get a list of @n@ samples from a 'Signal'------ The elements in the list correspond to the values of the 'Signal' at--- consecutive clock cycles------ > sampleN 3 s == [s0, s1, s2]-sampleN :: Int -> Signal a -> [a]-sampleN 0 _ = []-sampleN n ~(x :- xs) = x : (sampleN (n-1) xs)---- | 'register' @i s@ delays the values in 'Signal' @s@ for one cycle, and sets--- the value at time 0 to @i@------ >>> sampleN 3 (register 8 (fromList [1,2,3,4]))--- [8,1,2]-register :: a -> Signal a -> Signal a-register i s = i :- s---- | Simulate a (@'Signal' a -> 'Signal' b@) function given a list of samples of--- type @a@------ >>> simulate (register 8) [1, 2, 3, ...--- [8, 1, 2, 3, ...-simulate :: (Signal a -> Signal b) -> [a] -> [b]-simulate f = sample . f . fromList---- | Isomorphism between a 'Signal' of a product type (e.g. a tuple) and a--- product type of 'Signal's.------ Instances of 'Pack' must satisfy the following laws:------ @--- pack . unpack = 'id'--- unpack . pack = 'id'--- @-class Pack a where- type SignalP a- type SignalP a = Signal a- -- | Example:- --- -- > pack :: (Signal a, Signal b) -> Signal (a,b)- --- -- However:- --- -- > pack :: Signal Bit -> Signal Bit- pack :: SignalP a -> Signal a-- default pack :: Signal a -> Signal a- pack s = s- -- | Example:- --- -- > unpack :: Signal (a,b) -> (Signal a, Signal b)- --- -- However:- --- -- > unpack :: Signal Bit -> Signal Bit- unpack :: Signal a -> SignalP a-- default unpack :: Signal a -> Signal a- unpack s = s--instance Pack Bit-instance Pack (Signed n)-instance Pack (Unsigned n)-instance Pack (Fixed frac rep size)-instance Pack Bool-instance Pack Integer-instance Pack Int-instance Pack Float-instance Pack Double-instance Pack ()-instance Pack (Maybe a)-instance Pack (Either a b)--instance Pack (a,b) where- type SignalP (a,b) = (Signal a, Signal b)- pack = uncurry (liftA2 (,))- unpack tup = (fmap fst tup, fmap snd tup)--instance Pack (a,b,c) where- type SignalP (a,b,c) = (Signal a, Signal b, Signal c)- pack (a,b,c) = (,,) <$> a <*> b <*> c- unpack tup = (fmap (\(x,_,_) -> x) tup- ,fmap (\(_,x,_) -> x) tup- ,fmap (\(_,_,x) -> x) tup- )--instance Pack (a,b,c,d) where- type SignalP (a,b,c,d) = (Signal a, Signal b, Signal c, Signal d)- pack (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d- unpack tup = (fmap (\(x,_,_,_) -> x) tup- ,fmap (\(_,x,_,_) -> x) tup- ,fmap (\(_,_,x,_) -> x) tup- ,fmap (\(_,_,_,x) -> x) tup- )--instance Pack (a,b,c,d,e) where- type SignalP (a,b,c,d,e) = (Signal a, Signal b, Signal c, Signal d, Signal e)- pack (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e- unpack tup = (fmap (\(x,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,x) -> x) tup- )--instance Pack (a,b,c,d,e,f) where- type SignalP (a,b,c,d,e,f) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f)- pack (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f- unpack tup = (fmap (\(x,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,x) -> x) tup- )--instance Pack (a,b,c,d,e,f,g) where- type SignalP (a,b,c,d,e,f,g) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f, Signal g)- pack (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g- unpack tup = (fmap (\(x,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,x) -> x) tup- )--instance Pack (a,b,c,d,e,f,g,h) where- type SignalP (a,b,c,d,e,f,g,h) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f, Signal g, Signal h)- pack (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h- unpack tup = (fmap (\(x,_,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,x,_,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,x,_,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,x,_,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,x,_,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,x,_,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,x,_) -> x) tup- ,fmap (\(_,_,_,_,_,_,_,x) -> x) tup- )--instance Pack (Vec n a) where- type SignalP (Vec n a) = Vec n (Signal a)- pack vs = vmap shead vs :- pack (vmap stail vs)- unpack (Nil :- _) = Nil- unpack vs@((_ :> _) :- _) = fmap vhead vs :> (unpack (fmap vtail vs))---- | Simulate a (@'SignalP' a -> 'SignalP' b@) function given a list of samples--- of type @a@------ >>> simulateP (unpack . register (8,8) . pack) [(1,1), (2,2), (3,3), ...--- [(8,8), (1,1), (2,2), (3,3), ...-simulateP :: (Pack a, Pack b) => (SignalP a -> SignalP b) -> [a] -> [b]-simulateP f = simulate (pack . f . unpack)---- | Operator lifting, use in conjunction with ('^>')------ > add2 :: Signal Int -> Signal Int--- > add2 x = x <^(+)^> (signal 2)------ >>> simulate add2 [1,2,3,...--- [3,4,5,...-(<^) :: Applicative f => f a -> (a -> b -> c) -> f b -> f c-v <^ f = liftA2 f v---- | Operator lifting, use in conjunction with ('<^')------ > add2 :: Signal Int -> Signal Int--- > add2 x = x <^(+)^> (signal 2)------ >>> simulate add2 [1,2,3,...--- [3,4,5,...-(^>) :: Applicative f => (f a -> f b) -> f a -> f b-f ^> v = f v
+ src/CLaSH/Signal/Internal.hs view
@@ -0,0 +1,361 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+module CLaSH.Signal.Internal+ ( -- * Datatypes+ Clock (..)+ , SClock (..)+ , CSignal (..)+ -- * Basic circuits+ , register#+ , regEn#+ , mux+ -- * Boolean connectives+ , (.&&.), (.||.), not1+ -- * Type classes+ -- ** 'Eq'-like+ , (.==.), (./=.)+ -- ** 'Ord'-like+ , compare1, (.<.), (.<=.), (.>=.), (.>.)+ -- ** 'Functor'+ , mapSignal#+ -- ** 'Applicative'+ , signal#+ , appSignal#+ -- ** 'Foldable'+ , foldr#+ -- ** 'Traversable'+ , traverse#+ -- ** 'Enum'-like+ , fromEnum1+ -- ** 'Rational'-like+ , toRational1+ -- ** 'Integral'-like+ , toInteger1+ -- ** 'Bits'-like+ , testBit1+ , popCount1+ , shift1+ , rotate1+ , setBit1+ , clearBit1+ , shiftL1+ , unsafeShiftL1+ , shiftR1+ , unsafeShiftR1+ , rotateL1+ , rotateR1+ )+where++import Control.Applicative (Applicative (..), (<$>), liftA2, liftA3)+import Data.Bits (Bits (..), FiniteBits (..))+import Data.Default (Default (..))+import Data.Foldable (Foldable (..))+import Data.Traversable (Traversable (..))+import GHC.TypeLits (Nat, Symbol)+import Language.Haskell.TH.Syntax (Lift (..))++import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..))+import CLaSH.Promoted.Nat (SNat)+import CLaSH.Promoted.Symbol (SSymbol)++-- | A clock with a name ('Symbol') and period ('Nat')+data Clock = Clk Symbol Nat++-- | Singleton value for a type-level 'Clock' with the given @name@ and @period@+data SClock (clk :: Clock)+ where+ SClock :: SSymbol name -> SNat period -> SClock (Clk name period)++infixr 5 :-+-- | A synchronized signal with samples of type @a@, explicitly synchronized to+-- a clock @clk@+--+-- __NB__: The constructor, @(':-')@, is __not__ synthesisable.+data CSignal (clk :: Clock) a = a :- CSignal clk a++instance Show a => Show (CSignal clk a) where+ show (x :- xs) = show x ++ " " ++ show xs++instance Lift a => Lift (CSignal clk a) where+ lift ~(x :- _) = [| signal# x |]++instance Default a => Default (CSignal clk a) where+ def = signal# def++instance Functor (CSignal clk) where+ fmap = mapSignal#++{-# NOINLINE mapSignal# #-}+mapSignal# :: (a -> b) -> CSignal clk a -> CSignal clk b+mapSignal# f (a :- as) = f a :- mapSignal# f as++instance Applicative (CSignal clk) where+ pure = signal#+ (<*>) = appSignal#++{-# NOINLINE signal# #-}+signal# :: a -> CSignal clk a+signal# a = let s = a :- s in s++{-# NOINLINE appSignal# #-}+appSignal# :: CSignal clk (a -> b) -> CSignal clk a -> CSignal clk b+appSignal# (f :- fs) ~(a :- as) = f a :- appSignal# fs as++instance Num a => Num (CSignal clk a) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ negate = fmap negate+ abs = fmap abs+ signum = fmap signum+ fromInteger = signal# . fromInteger++-- | __NB__: Not synthesisable+--+-- __NB__: In \"@'foldr' f z s@\":+--+-- * The function @f@ should be /lazy/ in its second argument.+-- * The @z@ element will never be used.+instance Foldable (CSignal clk) where+ foldr = foldr#++{-# NOINLINE foldr# #-}+-- | __NB__: Not synthesisable+--+-- __NB__: In \"@'foldr#' f z s@\":+--+-- * The function @f@ should be /lazy/ in its second argument.+-- * The @z@ element will never be used.+foldr# :: (a -> b -> b) -> b -> CSignal clk a -> b+foldr# f z (a :- s) = a `f` (foldr# f z s)++instance Traversable (CSignal clk) where+ traverse = traverse#++{-# NOINLINE traverse# #-}+traverse# :: Applicative f => (a -> f b) -> CSignal clk a -> f (CSignal clk b)+traverse# f (a :- s) = (:-) <$> f a <*> traverse# f s++infixr 2 .||.+-- | Version of ('||') that returns a 'CSignal' of 'Bool'+(.||.) :: CSignal clk Bool -> CSignal clk Bool -> CSignal clk Bool+(.||.) = liftA2 (||)++infixr 3 .&&.+-- | Version of ('&&') that returns a 'CSignal' of 'Bool'+(.&&.) :: CSignal clk Bool -> CSignal clk Bool -> CSignal clk Bool+(.&&.) = liftA2 (&&)++-- | Version of 'not' that operates on 'CSignal's of 'Bool'+not1 :: CSignal clk Bool -> CSignal clk Bool+not1 = fmap not++{-# NOINLINE register# #-}+register# :: SClock clk -> a -> CSignal clk a -> CSignal clk a+register# _ i s = i :- s++{-# NOINLINE regEn# #-}+regEn# :: SClock clk -> a -> CSignal clk Bool -> CSignal clk a -> CSignal clk a+regEn# clk i b s = r+ where+ r = register# clk i s'+ s' = mux b s r++{-# INLINE mux #-}+-- | A multiplexer. Given "@'mux' b t f@", output @t@ when @b@ is 'True', and @f@+-- when @b@ is 'False'.+mux :: CSignal clk Bool -> CSignal clk a -> CSignal clk a -> CSignal clk a+mux = liftA3 (\b t f -> if b then t else f)++instance Bounded a => Bounded (CSignal clk a) where+ minBound = signal# minBound+ maxBound = signal# maxBound++instance ExtendingNum a b => ExtendingNum (CSignal clk a) (CSignal clk b) where+ type AResult (CSignal clk a) (CSignal clk b) = CSignal clk (AResult a b)+ plus = liftA2 plus+ minus = liftA2 minus+ type MResult (CSignal clk a) (CSignal clk b) = CSignal clk (MResult a b)+ times = liftA2 times++instance SaturatingNum a => SaturatingNum (CSignal clk a) where+ satPlus s = liftA2 (satPlus s)+ satMin s = liftA2 (satMin s)+ satMult s = liftA2 (satMult s)++-- | __WARNING__: ('==') and ('/=') are undefined, use ('.==.') and ('./=.')+-- instead+instance Eq (CSignal clk a) where+ (==) = error "(==)' undefined for 'CSignal', use '(.==.)' instead"+ (/=) = error "(/=)' undefined for 'CSignal', use '(./=.)' instead"++infix 4 .==.+-- | Version of ('==') that returns a 'CSignal' of 'Bool'+(.==.) :: Eq a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(.==.) = liftA2 (==)++infix 4 ./=.+-- | Version of ('/=') that returns a 'CSignal' of 'Bool'+(./=.) :: Eq a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(./=.) = liftA2 (/=)++-- | __WARNING__: 'compare', ('<'), ('>='), ('>'), and ('<=') are+-- undefined, use 'compare1', ('.<.'), ('.>=.'), ('.>.'), and ('.<=.') instead+instance Ord a => Ord (CSignal clk a) where+ compare = error "'compare' undefined for 'CSignal', use 'compare1' instead"+ (<) = error "'(<)' undefined for 'CSignal', use '(.<.)' instead"+ (>=) = error "'(>=)' undefined for 'CSignal', use '(.>=.)' instead"+ (>) = error "'(>)' undefined for 'CSignal', use '(.>.)' instead"+ (<=) = error "'(<=)' undefined for 'CSignal', use '(.<=.)' instead"+ max = liftA2 max+ min = liftA2 min++-- | Version of 'compare' that returns a 'CSignal' of 'Ordering'+compare1 :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Ordering+compare1 = liftA2 compare++infix 4 .<.+-- | Version of ('<') that returns a 'CSignal' of 'Bool'+(.<.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(.<.) = liftA2 (<)++infix 4 .<=.+-- | Version of ('<=') that returns a 'CSignal' of 'Bool'+(.<=.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(.<=.) = liftA2 (<=)++infix 4 .>.+-- | Version of ('>') that returns a 'CSignal' of 'Bool'+(.>.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(.>.) = liftA2 (>)++infix 4 .>=.+-- | Version of ('>=') that returns a 'CSignal' of 'Bool'+(.>=.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+(.>=.) = liftA2 (>=)++-- | __WARNING__: 'fromEnum' is undefined, use 'fromEnum1' instead+instance Enum a => Enum (CSignal clk a) where+ succ = fmap succ+ pred = fmap pred+ toEnum = signal# . toEnum+ fromEnum = error "'fromEnum' undefined for 'CSignal', use 'fromEnum1'"+ enumFrom = sequenceA . fmap enumFrom+ enumFromThen = (sequenceA .) . liftA2 enumFromThen+ enumFromTo = (sequenceA .) . liftA2 enumFromTo+ enumFromThenTo = ((sequenceA .) .) . liftA3 enumFromThenTo++-- | Version of 'fromEnum' that returns a 'CSignal' of 'Int'+fromEnum1 :: Enum a => CSignal clk a -> CSignal clk Int+fromEnum1 = fmap fromEnum++-- | __WARNING__: 'toRational' is undefined, use 'toRational1' instead+instance (Num a, Ord a) => Real (CSignal clk a) where+ toRational = error "'toRational' undefined for 'CSignal', use 'toRational1'"++-- | Version of 'toRational' that returns a 'CSignal' of 'Rational'+toRational1 :: Real a => CSignal clk a -> CSignal clk Rational+toRational1 = fmap toRational++-- | __WARNING__: 'toInteger' is undefined, use 'toInteger1' instead+instance Integral a => Integral (CSignal clk a) where+ quot = liftA2 quot+ rem = liftA2 rem+ div = liftA2 div+ mod = liftA2 mod+ quotRem a b = (quot a b, rem a b)+ divMod a b = (div a b, mod a b)+ toInteger = error "'toInteger' undefined for 'CSignal', use 'toInteger1'"++-- | Version of 'toRational' that returns a 'CSignal' of 'Integer'+toInteger1 :: Integral a => CSignal clk a -> CSignal clk Integer+toInteger1 = fmap toInteger++-- | __WARNING__: 'testBit' and 'popCount' are undefined, use 'testBit1' and+-- 'popCount1' instead+instance Bits a => Bits (CSignal clk a) where+ (.&.) = liftA2 (.&.)+ (.|.) = liftA2 (.|.)+ xor = liftA2 xor+ complement = fmap complement+ shift a i = fmap (`shift` i) a+ rotate a i = fmap (`rotate` i) a+ zeroBits = signal# zeroBits+ bit = signal# . bit+ setBit a i = fmap (`setBit` i) a+ clearBit a i = fmap (`clearBit` i) a+ testBit = error "'testBit' undefined for 'CSignal', use 'testbit1'"+ bitSizeMaybe _ = bitSizeMaybe (undefined :: a)+ bitSize _ = bitSize (undefined :: a)+ isSigned _ = isSigned (undefined :: a)+ shiftL a i = fmap (`shiftL` i) a+ unsafeShiftL a i = fmap (`unsafeShiftL` i) a+ shiftR a i = fmap (`shiftR` i) a+ unsafeShiftR a i = fmap (`unsafeShiftR` i) a+ rotateL a i = fmap (`rotateL` i) a+ rotateR a i = fmap (`rotateR` i) a+ popCount = error "'popCount' undefined for 'CSignal', use 'popCount1'"++instance FiniteBits a => FiniteBits (CSignal clk a) where+ finiteBitSize _ = finiteBitSize (undefined :: a)++-- | Version of 'testBit' that has a 'CSignal' of 'Int' as indexing argument,+-- and a result of 'CSignal' of 'Bool'+testBit1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk Bool+testBit1 = liftA2 testBit++-- | Version of 'popCount' that returns a 'CSignal' of 'Int'+popCount1 :: Bits a => CSignal clk a -> CSignal clk Int+popCount1 = fmap popCount++-- | Version of 'shift' that has a 'CSignal' of 'Int' as indexing argument+shift1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+shift1 = liftA2 shift++-- | Version of 'rotate' that has a 'CSignal' of 'Int' as indexing argument+rotate1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+rotate1 = liftA2 rotate++-- | Version of 'setBit' that has a 'CSignal' of 'Int' as indexing argument+setBit1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+setBit1 = liftA2 setBit++-- | Version of 'clearBit' that has a 'CSignal' of 'Int' as indexing argument+clearBit1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+clearBit1 = liftA2 clearBit++-- | Version of 'shiftL' that has a 'CSignal' of 'Int' as indexing argument+shiftL1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+shiftL1 = liftA2 shiftL++-- | Version of 'unsafeShiftL' that has a 'CSignal' of 'Int' as indexing argument+unsafeShiftL1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+unsafeShiftL1 = liftA2 unsafeShiftL++-- | Version of 'shiftR' that has a 'CSignal' of 'Int' as indexing argument+shiftR1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+shiftR1 = liftA2 shiftR++-- | Version of 'unsafeShiftR' that has a 'CSignal' of 'Int' as indexing argument+unsafeShiftR1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+unsafeShiftR1 = liftA2 unsafeShiftR++-- | Version of 'rotateL' that has a 'CSignal' of 'Int' as indexing argument+rotateL1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+rotateL1 = liftA2 rotateL++-- | Version of 'rotateR' that has a 'CSignal' of 'Int' as indexing argument+rotateR1 :: Bits a => CSignal clk a -> CSignal clk Int -> CSignal clk a+rotateR1 = liftA2 rotateR++instance Fractional a => Fractional (CSignal clk a) where+ (/) = liftA2 (/)+ recip = fmap recip+ fromRational = signal# . fromRational
− src/CLaSH/Signal/Types.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TemplateHaskell #-}-module CLaSH.Signal.Types where--import Data.Coerce (coerce)-import Data.Default (Default (..))-import Control.Applicative (Applicative (..), liftA2)-import GHC.TypeLits (Nat)-import Language.Haskell.TH.Syntax (Lift (..))--import CLaSH.Promoted.Nat (SNat)--infixr 5 :---- | A synchronized signal with samples of type @a@, implicitly synchronized to--- an unnamed global clock-data Signal a = a :- Signal a---- | A synchronized signal with samples of type @a@, explicitly synchronized to--- a clock with period @clk@-newtype CSignal (clk :: Nat) a = CSignal (Signal a)- deriving (Show,Default,Lift,Functor,Applicative)---- | A clock with period @clk@-newtype Clock (clk :: Nat) = Clock (SNat clk)--instance Show a => Show (Signal a) where- show (x :- xs) = show x ++ " " ++ show xs--instance Lift a => Lift (Signal a) where- lift ~(x :- _) = [| signal x |]--instance Default a => Default (Signal a) where- def = signal def--{-# NOINLINE signal #-}-{-# NOINLINE mapSignal #-}-{-# NOINLINE appSignal #-}---- | Create a constant 'Signal' from a combinational value------ >>> sample (signal 4)--- [4, 4, 4, 4, ...-signal :: a -> Signal a-signal a = let s = a :- s in s--mapSignal :: (a -> b) -> Signal a -> Signal b-mapSignal f (a :- as) = f a :- mapSignal f as--appSignal :: Signal (a -> b) -> Signal a -> Signal b-appSignal (f :- fs) ~(a :- as) = f a :- appSignal fs as--instance Functor Signal where- fmap = mapSignal--instance Applicative Signal where- pure = signal- (<*>) = appSignal--shead :: Signal a -> a-shead (x :- _) = x--stail :: Signal a -> Signal a-stail (_ :- xs) = xs--mkCSignal :: a -> CSignal clk a -> CSignal clk a-mkCSignal a (CSignal s) = CSignal (a :- s)--cstail :: CSignal t a -> CSignal t a-cstail (CSignal s) = CSignal (stail s)---- | Create a constant 'CSignal' from a combinational value------ >>> csample (csignal 4)--- [4, 4, 4, 4, ...-csignal :: a -> CSignal t a-csignal a = coerce (signal a)--instance Num a => Num (Signal a) where- (+) = liftA2 (+)- (-) = liftA2 (-)- (*) = liftA2 (*)- negate = fmap negate- abs = fmap abs- signum = fmap signum- fromInteger = signal . fromInteger--instance Num a => Num (CSignal t a) where- (+) = liftA2 (+)- (-) = liftA2 (-)- (*) = liftA2 (*)- negate = fmap negate- abs = fmap abs- signum = fmap signum- fromInteger = csignal . fromInteger
src/CLaSH/Sized/Fixed.hs view
@@ -1,22 +1,26 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--{-# OPTIONS_GHC -fexpose-all-unfoldings -fno-strictness #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- | Fixed point numbers -- -- * The 'Num' operators for the given types saturate on overflow, -- and use truncation as the rounding method.------ * Use @$$('fLit' d)@ to create 'Fixed' point number literals.+-- * 'Fixed' has an instance for 'Fractional' meaning you use fractional+-- literals @(3.75 :: 'SFixed' 4 18)@.+-- * Both integer literals and fractional literals are clipped to 'minBound' and+-- 'maxBound'.+-- * There is no 'Floating' instance for 'Fixed', but you can use @$$('fLit' d)@+-- to create 'Fixed' point literal from 'Double' constant at compile-time. -- * Use <#constraintsynonyms Constraint synonyms> when writing type signatures -- for polymorphic functions that use 'Fixed' point numbers. --@@ -29,66 +33,79 @@ SFixed, sf, unSF -- * 'UFixed': 'Unsigned' 'Fixed' point numbers , UFixed, uf, unUF- -- * 'Fixed' point literals+ -- * Division+ , divide+ -- * Compile-time 'Double' conversion , fLit -- * 'Fixed' point wrapper- , Fixed (..), resizeF, fracShift, satN2+ , Fixed (..), resizeF, fracShift -- * Constraint synonyms -- $constraintsynonyms -- ** Constraint synonyms for 'SFixed'- , NumSFixed, AddSFixed, MultSFixed, ResizeSFC+ , NumSFixedC, ENumSFixedC, FracSFixedC, ResizeSFC, DivideSC -- ** Constraint synonyms for 'UFixed'- , NumUFixed, AddUFixed, MultUFixed, ResizeUFC+ , NumUFixedC, ENumUFixedC, FracUFixedC, ResizeUFC, DivideUC -- ** Constraint synonyms for 'Fixed' wrapper- , NumFixed, AddFixed, MultFixed, ResizeFC, SatN2C- -- ** Constraint synonyms for 'Signed' and 'Unsigned'- , SatN2SC, SatN2UC+ , NumFixedC, ENumFixedC, FracFixedC, ResizeFC, DivideC -- * Proxy- , asFracProxy, asRepProxy+ , asRepProxy, asIntProxy ) where -import Control.Arrow-import Data.Bits-import Data.Default-import Data.List-import Data.Maybe-import Data.Proxy-import Data.Ratio-import Data.Typeable-import GHC.TypeLits-import Language.Haskell.TH-import Language.Haskell.TH.Syntax(Lift(..))+import Control.Arrow ((***), second)+import Data.Bits (Bits (..))+import Data.Default (Default (..))+import Data.List (find)+import Data.Maybe (fromJust)+import Data.Proxy (Proxy (..))+import Data.Ratio ((%), denominator, numerator)+import Data.Typeable (Typeable, TypeRep, typeRep)+import GHC.TypeLits (KnownNat, Nat, type (+), natVal)+import Language.Haskell.TH (Q, TExp, TypeQ, appT, conT, litT, mkName,+ numTyLit, sigE)+import Language.Haskell.TH.Syntax (Lift(..)) -import CLaSH.Bit-import CLaSH.Class.BitVector-import CLaSH.Class.Num-import CLaSH.Promoted.Nat-import CLaSH.Promoted.Ord-import CLaSH.Sized.Signed-import CLaSH.Sized.Unsigned-import CLaSH.Sized.Vector+import CLaSH.Class.BitPack (BitPack (..))+import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..),+ SaturationMode (..), boundedPlus, boundedMin,+ boundedMult)+import CLaSH.Class.Resize (Resize (..))+import CLaSH.Promoted.Nat (SNat)+import CLaSH.Promoted.Ord (Max)+import CLaSH.Sized.Signed (Signed)+import CLaSH.Sized.Unsigned (Unsigned) -- | 'Fixed'-point number -- -- Where: ----- * @frac@ denotes the position of the virtual @point@ counting from the LSB--- -- * @rep@ is the underlying representation ----- * @size@ is the number of bits used to represent the number+-- * @int@ is the number of bits used to represent the integer part ----- The 'Num' operators for this type saturate on overflow,--- and use truncation as the rounding method.-newtype Fixed (frac :: Nat) (rep :: Nat -> *) (size :: Nat) = Fixed { unFixed :: rep size }- deriving (Eq,Ord)+-- * @frac@ is the number of bits used to represent the fractional part+--+-- The 'Num' operators for this type saturate to 'maxBound' on overflow and+-- 'minBound' on underflow, and use truncation as the rounding method.+newtype Fixed (rep :: Nat -> *) (int :: Nat) (frac :: Nat) =+ Fixed { unFixed :: rep (int + frac) } +deriving instance Eq (rep (int + frac)) => Eq (Fixed rep int frac)+deriving instance Ord (rep (int + frac)) => Ord (Fixed rep int frac)+deriving instance Enum (rep (int + frac)) => Enum (Fixed rep int frac)+deriving instance Bounded (rep (int + frac)) => Bounded (Fixed rep int frac)+deriving instance Default (rep (int + frac)) => Default (Fixed rep int frac)++-- | Instance functions do not saturate.+-- Meaning that \"@`'shiftL'` 1 == 'satMult' 'SatWrap' 2'@\""+deriving instance Bits (rep (int + frac)) => Bits (Fixed rep int frac)+ -- | Signed 'Fixed'-point number, with @int@ integer bits (including sign-bit) -- and @frac@ fractional bits. ----- * The range 'SFixed' @int@ @frac@ numbers is: [-(2^(@int@ -1)) .. 2^(@int@-1) - 2^-@frac@ ]+-- * The range 'SFixed' @int@ @frac@ numbers is: [-(2^(@int@ -1)) ..+-- 2^(@int@-1) - 2^-@frac@ ] -- * The resolution of 'SFixed' @int@ @frac@ numbers is: 2^@frac@ -- * The 'Num' operators for this type saturate on overflow, -- and use truncation as the rounding method.@@ -97,23 +114,24 @@ -- 3.9375 -- >>> minBound :: SFixed 3 4 -- -4.0--- >>> (1 :: SFixed 3 4) + (2 :: SFixed 3 4)+-- >>> 1 + 2 :: SFixed 3 4 -- 3.0--- >>> (2 :: SFixed 3 4) + (3 :: SFixed 3 4)+-- >>> 2 + 3 :: SFixed 3 4 -- 3.9375--- >>> (-2 :: SFixed 3 4) + (-3 :: SFixed 3 4)+-- >>> (-2) + (-3) :: SFixed 3 4 -- -4.0--- >>> ($$(fLit 1.375) :: SFixed 3 4) * ($$(fLit -0.8125) :: SFixed 3 4)+-- >>> 1.375 * (-0.8125) :: SFixed 3 4 -- -1.125--- >>> ($$(fLit 1.375) :: SFixed 3 4) `mult` ($$(fLit -0.8125) :: SFixed 3 4) :: SFixed 6 8+-- >>> (1.375 :: SFixed 3 4) `times` (-0.8125 :: SFixed 3 4) :: SFixed 6 8 -- -1.1171875 -- >>> (2 :: SFixed 3 4) `plus` (3 :: SFixed 3 4) :: SFixed 4 4 -- 5.0 -- >>> (-2 :: SFixed 3 4) `plus` (-3 :: SFixed 3 4) :: SFixed 4 4 -- -5.0-type SFixed int frac = Fixed frac Signed (int + frac)+type SFixed = Fixed Signed --- | Unsigned 'Fixed'-point number, with @int@ integer bits and @frac@ fractional bits+-- | Unsigned 'Fixed'-point number, with @int@ integer bits and @frac@+-- fractional bits -- -- * The range 'UFixed' @int@ @frac@ numbers is: [0 .. 2^@int@ - 2^-@frac@ ] -- * The resolution of 'UFixed' @int@ @frac@ numbers is: 2^@frac@@@ -124,15 +142,15 @@ -- 7.9375 -- >>> minBound :: UFixed 3 4 -- 0.0--- >>> (1 :: UFixed 3 4) + (2 :: UFixed 3 4)+-- >>> 1 + 2 :: UFixed 3 4 -- 3.0--- >>> (2 :: UFixed 3 4) + (6 :: UFixed 3 4)+-- >>> 2 + 6 :: UFixed 3 4 -- 7.9375--- >>> (1 :: UFixed 3 4) - (3 :: UFixed 3 4)+-- >>> 1 - 3 :: UFixed 3 4 -- 0.0--- >>> ($$(fLit 1.375) :: UFixed 3 4) * ($$(fLit 0.8125) :: UFixed 3 4)+-- >>> 1.375 * 0.8125 :: UFixed 3 4 -- 1.0625--- >>> ($$(fLit 1.375) :: UFixed 3 4) `mult` ($$(fLit 0.8125) :: UFixed 3 4) :: UFixed 6 8+-- >>> (1.375 :: UFixed 3 4) `times` (0.8125 :: UFixed 3 4) :: UFixed 6 8 -- 1.1171875 -- >>> (2 :: UFixed 3 4) `plus` (6 :: UFixed 3 4) :: UFixed 4 4 -- 8.0@@ -141,8 +159,9 @@ -- -- >>> (1 :: UFixed 3 4) `minus` (3 :: UFixed 3 4) :: UFixed 4 4 -- 14.0-type UFixed int frac = Fixed frac Unsigned (int + frac)+type UFixed = Fixed Unsigned +{-# INLINE sf #-} -- | Treat a 'Signed' integer as a @Signed@ 'Fixed'-@point@ integer -- -- >>> sf d4 (-22 :: Signed 7)@@ -152,11 +171,13 @@ -> SFixed int frac sf _ fRep = Fixed fRep +{-# INLINE unSF #-} -- | See the underlying representation of a Signed Fixed-point integer unSF :: SFixed int frac -> Signed (int + frac) unSF (Fixed fRep) = fRep +{-# INLINE uf #-} -- | Treat an 'Unsigned' integer as a @Unsigned@ 'Fixed'-@point@ number -- -- >>> uf d4 (92 :: Unsigned 7)@@ -166,27 +187,31 @@ -> UFixed int frac uf _ fRep = Fixed fRep +{-# INLINE unUF #-} -- | See the underlying representation of an Unsigned Fixed-point integer unUF :: UFixed int frac -> Unsigned (int + frac) unUF (Fixed fRep) = fRep -asFracProxy :: Fixed frac rep size -> Proxy frac-asFracProxy _ = Proxy--asRepProxy :: Fixed frac rep size -> Proxy rep+{-# INLINE asRepProxy #-}+asRepProxy :: Fixed rep int frac -> Proxy rep asRepProxy _ = Proxy +{-# INLINE asIntProxy #-}+asIntProxy :: Fixed rep int frac -> Proxy int+asIntProxy _ = Proxy+ -- | Get the position of the virtual @point@ of a 'Fixed'-@point@ number-fracShift :: KnownNat frac => Fixed frac rep size -> Int-fracShift f = fromInteger (natVal (asFracProxy f))+fracShift :: KnownNat frac => Fixed rep int frac -> Int+fracShift fx = fromInteger (natVal fx) -instance ( Show (rep size), Bits (rep size), KnownNat frac+instance ( size ~ (int + frac), Show (rep size), Bits (rep size), KnownNat frac , Integral (rep size)- ) => Show (Fixed frac rep size) where- show f@(Fixed fRep) = i ++ "." ++ (uncurry pad . second (show . numerator) .- fromJust . find ((==1) . denominator . snd) .- iterate (succ *** (*10)) . (,) 0 $ (nom % denom))+ ) => Show (Fixed rep int frac) where+ show f@(Fixed fRep) =+ i ++ "." ++ (uncurry pad . second (show . numerator) .+ fromJust . find ((==1) . denominator . snd) .+ iterate (succ *** (*10)) . (,) 0 $ (nom % denom)) where pad n str = replicate (n - length str) '0' ++ str @@ -208,9 +233,12 @@ lines of constraints: @-mac :: ( 1 <= (int + frac), (((int + frac) + 1) + 1) ~ ((int + frac) + 2)- , KnownNat (frac + frac), KnownNat ((int + frac) + (int + frac))- , KnownNat ((int + frac) + 2), KnownNat (int + frac), KnownNat frac+mac :: ( KnownNat frac+ , KnownNat (frac + frac)+ , KnownNat (int + frac)+ , KnownNat (1 + (int + frac))+ , KnownNat ((int + frac) + (int + frac))+ , ((int + int) + (frac + frac)) ~ ((int + frac) + (int + frac)) ) => SFixed int frac -> SFixed int frac@@ -222,169 +250,239 @@ But with constraint synonyms, you can write the type signature like this: @-mac :: NumSFixed int frac+mac1 :: 'NumSFixedC' int frac => SFixed int frac -> SFixed int frac -> SFixed int frac -> SFixed int frac-mac s x y = s + (x * y)+mac1 s x y = s + (x * y) @ -Where 'NumSFixed' refers to the @Constraints@ needed by the operators of+Where 'NumSFixedC' refers to the @Constraints@ needed by the operators of the 'Num' class for the 'SFixed' datatype.--} --- | Constraint for the 'Mult' instance of 'Fixed'-type MultFixed rep (frac1 :: Nat) (frac2 :: Nat) (size1 :: Nat) (size2 :: Nat)- = ( Mult (rep size1) (rep size2)- , MResult (rep size1) (rep size2) ~ rep (size1 + size2)- )+Although the number of constraints for the @mac@ function defined earlier might+be considered small, here is an \"this way lies madness\" example where you+really want to use constraint kinds: --- | Constraint for the 'Mult' instance of 'SFixed'-type MultSFixed int1 frac1 int2 frac2 = MultFixed Signed frac1 frac2 (int1 + frac1) (int2 + frac2)+@+mac2 :: ( KnownNat frac1+ , KnownNat frac2+ , KnownNat frac3+ , KnownNat (Max frac1 frac2)+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2)+ , KnownNat (int3 + frac3)+ , KnownNat (frac1 + frac2)+ , KnownNat (Max (frac1 + frac2) frac3)+ , KnownNat (((int1 + int2) + (frac1 + frac2)) + (int3 + frac3))+ , KnownNat ((int1 + int2) + (frac1 + frac2))+ , KnownNat (1 + Max (int1 + frac1) (int2 + frac2))+ , KnownNat (1 + Max (int1 + int2) int3 + Max (frac1 + frac2) frac3)+ , KnownNat ((1 + Max int1 int2) + Max frac1 frac2)+ , KnownNat ((1 + Max ((int1 + int2) + (frac1 + frac2)) (int3 + frac3)))+ , ((int1 + frac1) + (int2 + frac2)) ~ ((int1 + int2) + (frac1 + frac2))+ , (((int1 + int2) + int3) + ((frac1 + frac2) + frac3)) ~ (((int1 + int2) + (frac1 + frac2)) + (int3 + frac3))+ )+ => SFixed int1 frac1+ -> SFixed int2 frac2+ -> SFixed int3 frac3+ -> SFixed (1 + Max (int1 + int2) int3) (Max (frac1 + frac2) frac3)+mac2 x y s = (x \`times\` y) \`plus\` s+@ --- | Constraint for the 'Mult' instance of 'UFixed'-type MultUFixed int1 frac1 int2 frac2 = MultFixed Unsigned frac1 frac2 (int1 + frac1) (int2 + frac2)+Which, with the proper constraint kinds can be reduced to: --- | When used in a polymorphic setting, use the following <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms>--- for less verbose type signatures:------ * @'MultFixed' rep frac1 frac2 size1 size2@ for: 'Fixed'--- * @'MultSFixed' int1 frac1 int2 frac2@ for: 'SFixed'--- * @'MultUFixed' int1 frac1 int2 frac2@ for: 'UFixed'-instance MultFixed rep frac1 frac2 size1 size2 => Mult (Fixed frac1 rep size1) (Fixed frac2 rep size2) where- type MResult (Fixed frac1 rep size1) (Fixed frac2 rep size2) = Fixed (frac1 + frac2) rep (size1 + size2)- mult (Fixed fRep1) (Fixed fRep2) = Fixed (mult fRep1 fRep2)+@+mac3 :: ( 'ENumSFixedC' int1 frac1 int2 frac2+ , 'ENumSFixedC' (int1 + int2) (frac1 + frac2) int3 frac3+ )+ => SFixed int1 frac1+ -> SFixed int2 frac2+ -> SFixed int3 frac3+ -> SFixed (1 + Max (int1 + int2) int3) (Max (frac1 + frac2) frac3)+mac3 x y s = (x \`times\` y) \`plus\` s+@+-} --- | Constraint for the 'Add' instance of 'Fixed'-type AddFixed rep (frac1 :: Nat) (frac2 :: Nat) (size1 :: Nat) (size2 :: Nat)- = ( ResizeFC rep frac1 (Max frac1 frac2) size1 ((Max size1 size2) + 1)- , ResizeFC rep frac2 (Max frac1 frac2) size2 ((Max size1 size2) + 1)- , Num (rep (Max size1 size2 + 1))+-- | Constraint for the 'ExtendingNum' instance of 'Fixed'+type ENumFixedC rep int1 frac1 int2 frac2+ = ( ResizeFC rep int1 frac1 (1 + Max int1 int2) (Max frac1 frac2)+ , ResizeFC rep int2 frac2 (1 + Max int1 int2) (Max frac1 frac2)+ , Bounded (rep ((1 + Max int1 int2) + Max frac1 frac2))+ , Num (rep ((1 + Max int1 int2) + Max frac1 frac2))+ , ExtendingNum (rep (int1 + frac1)) (rep (int2 + frac2))+ , MResult (rep (int1 + frac1)) (rep (int2 + frac2)) ~+ rep ((int1 + int2) + (frac1 + frac2)) ) --- | Constraint for the 'Add' instance of 'SFixed'-type AddSFixed int1 frac1 int2 frac2 = AddFixed Signed frac1 frac2 (int1 + frac1) (int2 + frac2)+-- | Constraint for the 'ExtendingNum' instance of 'SFixed'+type ENumSFixedC int1 frac1 int2 frac2+ = ( KnownNat frac1+ , KnownNat frac2+ , KnownNat (Max frac1 frac2)+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2)+ , KnownNat ((int1 + int2) + (frac1 + frac2))+ , KnownNat (1 + Max (int1 + frac1) (int2 + frac2))+ , KnownNat ((1 + Max int1 int2) + Max frac1 frac2)+ , ((int1 + frac1) + (int2 + frac2)) ~ ((int1 + int2) + (frac1 + frac2))+ ) --- | Constraint for the 'Add' instance of 'UFixed'-type AddUFixed int1 frac1 int2 frac2 = AddFixed Unsigned frac1 frac2 (int1 + frac1) (int2 + frac2)+-- | Constraint for the 'ExtendingNum' instance of 'UFixed'+type ENumUFixedC int1 frac1 int2 frac2 =+ ENumSFixedC int1 frac1 int2 frac2 --- | When used in a polymorphic setting, use the following <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms>--- for less verbose type signatures:+-- | When used in a polymorphic setting, use the following+-- <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms> for less+-- verbose type signatures: ----- * @'AddFixed' rep frac1 frac2 size1 size2@ for: 'Fixed'--- * @'AddSFixed' int1 frac1 int2 frac2@ for: 'SFixed'--- * @'AddUFixed' int1 frac1 int2 frac2@ for: 'UFixed'-instance AddFixed rep frac1 frac2 size1 size2 => Add (Fixed frac1 rep size1) (Fixed frac2 rep size2) where- type AResult (Fixed frac1 rep size1) (Fixed frac2 rep size2) = Fixed (Max frac1 frac2) rep ((Max size1 size2) + 1)- plus f1 f2 = let (Fixed f1R) = resizeF f1 :: Fixed (Max frac1 frac2) rep ((Max size1 size2) + 1)- (Fixed f2R) = resizeF f2 :: Fixed (Max frac1 frac2) rep ((Max size1 size2) + 1)- in Fixed (f1R + f2R)- minus f1 f2 = let (Fixed f1R) = resizeF f1 :: Fixed (Max frac1 frac2) rep ((Max size1 size2) + 1)- (Fixed f2R) = resizeF f2 :: Fixed (Max frac1 frac2) rep ((Max size1 size2) + 1)- in Fixed (f1R - f2R)+-- * @'ENumFixedC' rep frac1 frac2 size1 size2@ for: 'Fixed'+-- * @'ENumSFixedC' int1 frac1 int2 frac2@ for: 'SFixed'+-- * @'ENumUFixedC' int1 frac1 int2 frac2@ for: 'UFixed'+instance ENumFixedC rep int1 frac1 int2 frac2 =>+ ExtendingNum (Fixed rep int1 frac1) (Fixed rep int2 frac2) where+ type AResult (Fixed rep int1 frac1) (Fixed rep int2 frac2) =+ Fixed rep (1 + Max int1 int2) (Max frac1 frac2)+ plus f1 f2 =+ let (Fixed f1R) = resizeF f1 :: Fixed rep (1 + Max int1 int2) (Max frac1 frac2)+ (Fixed f2R) = resizeF f2 :: Fixed rep (1 + Max int1 int2) (Max frac1 frac2)+ in Fixed (f1R + f2R)+ minus f1 f2 =+ let (Fixed f1R) = resizeF f1 :: Fixed rep (1 + Max int1 int2) (Max frac1 frac2)+ (Fixed f2R) = resizeF f2 :: Fixed rep (1 + Max int1 int2) (Max frac1 frac2)+ in Fixed (f1R - f2R)+ type MResult (Fixed rep int1 frac1) (Fixed rep int2 frac2) =+ Fixed rep (int1 + int2) (frac1 + frac2)+ times (Fixed fRep1) (Fixed fRep2) = Fixed (times fRep1 fRep2) -- | Constraint for the 'Num' instance of 'Fixed'-type NumFixed (frac :: Nat) rep (size :: Nat)- = ( SatN2C rep size- , ResizeFC rep (frac + frac) frac (size + size) size- , Num (rep size)- , Num (rep (size + 2))- , Mult (rep size) (rep size)- , MResult (rep size) (rep size) ~ rep (size + size)+type NumFixedC rep int frac+ = ( SaturatingNum (rep (int + frac))+ , ExtendingNum (rep (int + frac)) (rep (int + frac))+ , ResizeFC rep (int + int) (frac + frac) int frac+ , MResult (rep (int + frac)) (rep (int + frac)) ~+ rep ((int + int) + (frac + frac)) ) -- | Constraint for the 'Num' instance of 'SFixed'-type NumSFixed int frac = ( 1 <= (int + frac), (((int + frac) + 1) + 1) ~ ((int + frac) + 2)- , KnownNat (frac + frac), KnownNat ((int + frac) + (int + frac))- , KnownNat ((int + frac) + 2), KnownNat (int + frac), KnownNat frac- )+type NumSFixedC int frac =+ ( KnownNat frac+ , KnownNat (frac + frac)+ , KnownNat (int + frac)+ , KnownNat (1 + (int + frac))+ , KnownNat ((int + frac) + (int + frac))+ , ((int + int) + (frac + frac)) ~ ((int + frac) + (int + frac))+ ) -- | Constraint for the 'Num' instance of 'UFixed'-type NumUFixed int frac = ( 1 <= (int + frac), (((int + frac) + 1) + 1) ~ ((int + frac) + 2)- , KnownNat (frac + frac), KnownNat ((int + frac) + (int + frac))- , KnownNat ((int + frac) + 2), KnownNat (int + frac), KnownNat frac- )+type NumUFixedC int frac =+ NumSFixedC int frac --- | The operators of this instance saturate on overflow, and use truncation as the rounding method.+-- | The operators of this instance saturate on overflow, and use truncation as+-- the rounding method. ----- When used in a polymorphic setting, use the following <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms>--- for less verbose type signatures:+-- When used in a polymorphic setting, use the following+-- <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms> for less+-- verbose type signatures: ----- * @'NumFixed' frac rep size@ for: @'Fixed' frac rep size@--- * @'NumSFixed' int frac@ for: @'SFixed' int frac@--- * @'NumUFixed' int frac@ for: @'UFixed' int frac@-instance (NumFixed frac rep size) => Num (Fixed frac rep size) where- (Fixed a) + (Fixed b) = Fixed (satN2 (resize a + resize b))- (Fixed a) * (Fixed b) = resizeF (Fixed (a `mult` b) :: Fixed (frac + frac) rep (size + size))- (Fixed a) - (Fixed b) = Fixed (satN2 (resize a - resize b))- negate (Fixed a) = Fixed (satN2 (negate (resize a)))- abs (Fixed a) = Fixed (satN2 (abs (resize a)))- signum (Fixed a) = Fixed (signum a)- fromInteger i = let fSH = fromInteger (natVal (Proxy :: Proxy frac))- res = Fixed (fromInteger i `shiftL` fSH)- in res--instance (BitVector (rep size)) => BitVector (Fixed frac rep size) where- type BitSize (Fixed frac rep size) = BitSize (rep size)- toBV (Fixed fRep) = toBV fRep- fromBV bv = Fixed (fromBV bv)--instance (Lift (rep size), KnownNat frac, KnownNat size, Typeable rep) =>- Lift (Fixed frac rep size) where- lift f@(Fixed fRep) = sigE [| Fixed fRep |] (decFixed (natVal (asFracProxy f)) (typeRep (asRepProxy f)) (natVal f))+-- * @'NumFixedC' frac rep size@ for: @'Fixed' frac rep size@+-- * @'NumSFixedC' int frac@ for: @'SFixed' int frac@+-- * @'NumUFixedC' int frac@ for: @'UFixed' int frac@+instance (NumFixedC rep int frac) => Num (Fixed rep int frac) where+ (+) = boundedPlus+ (*) = boundedMult+ (-) = boundedMin+ negate (Fixed a) = Fixed (negate a)+ abs (Fixed a) = Fixed (abs a)+ signum (Fixed a) = Fixed (signum a)+ fromInteger i = let fSH = fromInteger (natVal (Proxy :: Proxy frac))+ res = Fixed (fromInteger i `shiftL` fSH)+ in res -decFixed :: Integer -> TypeRep -> Integer -> TypeQ-decFixed f r s = do- foldl appT (conT ''Fixed) [litT (numTyLit f), conT (mkName (show r)), litT (numTyLit s)]+instance (BitPack (rep (int + frac))) => BitPack (Fixed rep int frac) where+ type BitSize (Fixed rep int frac) = BitSize (rep (int + frac))+ pack (Fixed fRep) = pack fRep+ unpack bv = Fixed (unpack bv) -instance Default (rep size) => Default (Fixed frac rep size) where- def = Fixed def+instance (Lift (rep (int + frac)), KnownNat frac, KnownNat int, Typeable rep) =>+ Lift (Fixed rep int frac) where+ lift f@(Fixed fRep) = sigE [| Fixed fRep |]+ (decFixed (typeRep (asRepProxy f))+ (natVal (asIntProxy f))+ (natVal f)) -instance Bounded (rep size) => Bounded (Fixed frac rep size) where- minBound = Fixed minBound- maxBound = Fixed maxBound+decFixed :: TypeRep -> Integer -> Integer -> TypeQ+decFixed r i f = do+ foldl appT (conT ''Fixed) [ conT (mkName (show r))+ , litT (numTyLit i)+ , litT (numTyLit f)+ ] -- | Constraint for the 'resizeF' function-type ResizeFC rep frac1 frac2 size1 size2- = ( Bounded (rep size2), Eq (rep size1), Ord (rep size1)- , Num (rep size1), Bits (rep size1), Resize rep- , KnownNat size2, KnownNat size1, Bits (rep size2)- , KnownNat frac2, KnownNat frac1, Bounded (rep size1)+type ResizeFC rep int1 frac1 int2 frac2+ = ( Resize rep+ , Ord (rep (int1 + frac1))+ , Num (rep (int1 + frac1))+ , Bits (rep (int1 + frac1))+ , Bits (rep (int2 + frac2))+ , KnownNat frac1+ , KnownNat frac2+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2) ) -- | Constraint for the 'resizeF' function, specialized for 'SFixed'-type ResizeSFC int1 frac1 int2 frac2 = (KnownNat (int2 + frac2), KnownNat (int1 + frac1), KnownNat frac1, KnownNat frac2)+type ResizeSFC int1 frac1 int2 frac2+ = ( KnownNat frac1+ , KnownNat frac2+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2)+ ) -- | Constraint for the 'resizeF' function, specialized for 'UFixed'-type ResizeUFC int1 frac1 int2 frac2 = (KnownNat (int2 + frac2), KnownNat (int1 + frac1), KnownNat frac1, KnownNat frac2)+type ResizeUFC int1 frac1 int2 frac2 =+ ResizeSFC int1 frac1 int2 frac2 +{-# INLINE resizeF #-} -- | Saturating resize operation, truncates for rounding ----- >>> $$(fLit 0.8125) :: SFixed 3 4+-- >>> 0.8125 :: SFixed 3 4 -- 0.8125--- >>> resizeF ($$(fLit 0.8125) :: SFixed 3 4) :: SFixed 2 3+-- >>> resizeF (0.8125 :: SFixed 3 4) :: SFixed 2 3 -- 0.75--- >>> $$(fLit 3.4) :: SFixed 3 4+-- >>> 3.4 :: SFixed 3 4 -- 3.375--- >>> resizeF ($$(fLit 3.4) :: SFixed 3 4) :: SFixed 2 3+-- >>> resizeF (3.4 :: SFixed 3 4) :: SFixed 2 3 -- 1.875 -- >>> maxBound :: SFixed 2 3 -- 1.875 ----- When used in a polymorphic setting, use the following <#constraintsynonyms Constraint synonyms>--- for less verbose type signatures:+-- When used in a polymorphic setting, use the following+-- <#constraintsynonyms Constraint synonyms> for less verbose type signatures: ----- * @'ResizeFC' rep frac1 frac2 size1 size2@ for: @'Fixed' frac1 rep size1 -> 'Fixed' frac2 rep size2@--- * @'ResizeSFC' int1 frac1 int2 frac2@ for: @'SFixed' int1 frac1 -> 'SFixed' int2 frac2@--- * @'ResizeUFC' int1 frac1 int2 frac2@ for: @'UFixed' int1 frac1 -> 'UFixed' int2 frac2@-resizeF :: forall frac1 frac2 rep size1 size2 .- ResizeFC rep frac1 frac2 size1 size2- => Fixed frac1 rep size1- -> Fixed frac2 rep size2-resizeF (Fixed fRep) = Fixed sat+-- * @'ResizeFC' rep int1 frac1 int2 frac2@ for:+-- @'Fixed' rep int1 frac1 -> 'Fixed' rep int2 frac2@+--+-- * @'ResizeSFC' int1 frac1 int2 frac2@ for:+-- @'SFixed' int1 frac1 -> 'SFixed' int2 frac2@+--+-- * @'ResizeUFC' rep int1 frac1 int2 frac2@ for:+-- @'UFixed' int1 frac1 -> 'UFixed' int2 frac2@+resizeF ::(ResizeFC rep int1 frac1 int2 frac2, Bounded (rep (int2 + frac2)))+ => Fixed rep int1 frac1+ -> Fixed rep int2 frac2+resizeF = resizeF' False minBound maxBound++resizeF' :: forall rep int1 frac1 int2 frac2 . ResizeFC rep int1 frac1 int2 frac2+ => Bool -- ^ Wrap+ -> rep (int2 + frac2) -- ^ minBound+ -> rep (int2 + frac2) -- ^ maxBound+ -> Fixed rep int1 frac1+ -> Fixed rep int2 frac2+resizeF' doWrap fMin fMax (Fixed fRep) = Fixed sat where- argSZ = natVal (Proxy :: Proxy size1)- resSZ = natVal (Proxy :: Proxy size2)+ argSZ = natVal (Proxy :: Proxy (int1 + frac1))+ resSZ = natVal (Proxy :: Proxy (int2 + frac2)) argFracSZ = fromInteger (natVal (Proxy :: Proxy frac1)) resFracSZ = fromInteger (natVal (Proxy :: Proxy frac2))@@ -397,24 +495,24 @@ then resize fRep `shiftL` (resFracSZ - argFracSZ) else resize fRep `shiftR` (argFracSZ - resFracSZ) -- if the argument is bigger than the result, shift before resize- else let fMax = maxBound- fMin = minBound- mask = complement (resize fMax) :: rep size1+ else let mask = complement (resize fMax) :: rep (int1 + frac1) in if argFracSZ <= resFracSZ- then let shiftedL = fRep `shiftL` (resFracSZ - argFracSZ)+ then let shiftedL = fRep `shiftL`+ (resFracSZ - argFracSZ) shiftedL_masked = shiftedL .&. mask shiftedL_resized = resize shiftedL- in if fRep >= 0+ in if doWrap then shiftedL_resized else if fRep >= 0 then if shiftedL_masked == 0 then shiftedL_resized else fMax else if shiftedL_masked == mask then shiftedL_resized else fMin- else let shiftedR = fRep `shiftR` (argFracSZ - resFracSZ)+ else let shiftedR = fRep `shiftR`+ (argFracSZ - resFracSZ) shiftedR_masked = shiftedR .&. mask shiftedR_resized = resize shiftedR- in if fRep >= 0+ in if doWrap then shiftedR_resized else if fRep >= 0 then if shiftedR_masked == 0 then shiftedR_resized else fMax@@ -422,93 +520,41 @@ then shiftedR_resized else fMin --- | Constraint for the 'satN2' function-type SatN2C rep n- = ( 1 <= n- , ((n + 1) + 1) ~ (n + 2)- , BitVector (rep n)- , BitVector (rep (n + 2))- , BitSize (rep n) ~ n- , BitSize (rep (n + 2)) ~ (n + 2)- , KnownNat n- , KnownNat (n + 2)- , Bounded (rep n)- , Bits (rep (n + 2))- )---- | Constraint for the 'satN2' function, specialized for 'Signed'-type SatN2SC n = (1 <= n, ((n + 1) + 1) ~ (n + 2), KnownNat n, KnownNat (n + 2))---- | Constraint for the 'satN2' function, specialized for 'Unsigned'-type SatN2UC n = (1 <= n, ((n + 1) + 1) ~ (n + 2), KnownNat n, KnownNat (n + 2))---- | Resize an (N+2)-bits number to an N-bits number, saturates to--- 'minBound' or 'maxBound' when the argument does not fit within--- the representations bounds of the result.------ Uses cheaper saturation than 'resizeF', which is made possible by knowing--- that we only reduce the size by 2 bits.------ >>> (2 :: Unsigned 2) + (3 :: Unsigned 2)--- 1--- >>> satN2 (resize (2 :: Unsigned 2) + resize (3 :: Unsigned 2)) :: Unsigned 2--- 3--- >>> satN2 (resize (1 :: Unsigned 2) + resize (1 :: Unsigned 2)) :: Unsigned 2--- 2--- >>> (2 :: Unsigned 2) - (3 :: Unsigned 2)--- 3--- >>> satN2 (resize (2 :: Unsigned 2) - resize (3 :: Unsigned 2)) :: Unsigned 2--- 0--- >>> (2 :: Signed 3) + (3 :: Signed 3)--- -3--- >>> satN2 (resize (2 :: Signed 3) + resize (3 :: Signed 3)) :: Signed 3--- 3------ When used in a polymorphic setting, use the following <#constraintsynonyms Constraint synonyms>--- for less verbose type signatures:------ * 'SatN2C' for: @rep (n+2) -> rep n@--- * 'SatN2SC' for: @'Signed' (n+2) -> 'Signed' n@--- * 'SatN2UC' for: @'Unsigned' (n+2) -> 'Unsigned' n@-satN2 :: SatN2C rep n- => rep (n + 2)- -> rep n-satN2 rep = if isSigned rep- then case (cS,sn) of- (L,H) -> maxBound- (H,L) -> minBound- _ -> fromBV s- else case (cS,cU) of- (H,H) -> minBound- (L,H) -> maxBound- _ -> fromBV s- where- repBV = toBV rep- cS = vhead repBV- cU = vhead (vtail repBV)- s = vtail (vtail repBV)- sn = vhead' s---- | Convert, at compile-time, a 'Double' literal to a 'Fixed'-point literal.--- The conversion saturates on overflow, and uses truncation as its rounding method.+-- | Convert, at compile-time, a 'Double' /constant/ to a 'Fixed'-point /literal/.+-- The conversion saturates on overflow, and uses truncation as its rounding+-- method. -- -- So when you type: ----- > n = $$(fLit 2.8672) :: SFixed 4 4+-- > n = $$(fLit pi) :: SFixed 4 4 -- -- The compiler sees: ----- > n = Fixed (fromInteger 45) :: SFixed 4 4+-- > n = Fixed (fromInteger 50) :: SFixed 4 4 -- -- Upon evaluation you see that the value is rounded / truncated in accordance -- to the fixed point representation: -- -- >>> n--- 2.8125-fLit :: forall frac rep size .- (KnownNat frac, Num (rep size), Bounded (rep size), Integral (rep size))+-- 3.125+--+-- Further examples:+--+-- >>> sin 0.5 :: Double+-- 0.479425538604203+-- >>> $$(fLit (sin 0.5)) :: SFixed 1 8+-- 0.4765625+-- >>> atan 0.2 :: Double+-- 0.19739555984988078+-- >>> $$(fLit (atan 0.2)) :: SFixed 1 8+-- 0.1953125+-- >>> $$(fLit (atan 0.2)) :: SFixed 1 20+-- 0.19739532470703125+fLit :: forall rep int frac size .+ ( size ~ (int + frac), KnownNat frac, Num (rep size), Bounded (rep size)+ , Integral (rep size)) => Double- -> Q (TExp (Fixed frac rep size))+ -> Q (TExp (Fixed rep int frac)) fLit a = [|| Fixed (fromInteger sat) ||] where rMax = toInteger (maxBound :: rep size)@@ -520,3 +566,115 @@ else truncated truncated = truncate shifted :: Integer shifted = a * (2 ^ (natVal (Proxy :: Proxy frac)))+++instance NumFixedC rep int frac => SaturatingNum (Fixed rep int frac) where+ satPlus w (Fixed a) (Fixed b) = Fixed (satPlus w a b)+ satMin w (Fixed a) (Fixed b) = Fixed (satMin w a b)+ satMult w (Fixed a) (Fixed b) = case w of+ SatWrap -> resizeF' True 0 0 res+ SatBound -> resizeF' False minBound maxBound res+ SatZero -> resizeF' False 0 0 res+ SatSymmetric -> resizeF' False fMinSym maxBound res+ where+ res = Fixed (a `times` b) :: Fixed rep (int + int) (frac + frac)+ fMinSym = if isSigned a+ then 0+ else minBound + 1++-- | Constraint for the 'divide' function+type DivideC rep int1 frac1 int2 frac2+ = ( Resize rep+ , Integral (rep (((int1 + frac2) + 1) + (int2 + frac1)))+ , Bits (rep (((int1 + frac2) + 1) + (int2 + frac1)))+ , KnownNat int2+ , KnownNat frac2+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2)+ , KnownNat ((int1 + frac2 + 1) + (int2 + frac1))+ )++-- | Constraint for the 'divide' function, specialized for 'SFixed'+type DivideSC int1 frac1 int2 frac2+ = ( KnownNat int2+ , KnownNat frac2+ , KnownNat (int1 + frac1)+ , KnownNat (int2 + frac2)+ , KnownNat ((int1 + frac2 + 1) + (int2 + frac1))+ )++-- | Constraint for the 'divide' function, specialized for 'UFixed'+type DivideUC int1 frac1 int2 frac2 =+ DivideSC int1 frac1 int2 frac2++-- | Fixed point division+--+-- When used in a polymorphic setting, use the following+-- <#constraintsynonyms Constraint synonyms> for less verbose type signatures:+--+-- * @'DivideC' rep int1 frac1 int2 frac2@ for:+-- @'Fixed' rep int1 frac1 -> 'Fixed' rep int2 frac2 -> 'Fixed' rep (int1 + frac2 + 1) (int2 + frac1)@+--+-- * @'DivideSC' rep int1 frac1 int2 frac2@ for:+-- @'SFixed' int1 frac1 -> 'SFixed' int2 frac2 -> 'SFixed' (int1 + frac2 + 1) (int2 + frac1)@+--+-- * @'DivideUC' rep int1 frac1 int2 frac2@ for:+-- @'UFixed' int1 frac1 -> 'UFixed' int2 frac2 -> 'UFixed' (int1 + frac2 + 1) (int2 + frac1)@+divide :: DivideC rep int1 frac1 int2 frac2+ => Fixed rep int1 frac1+ -> Fixed rep int2 frac2+ -> Fixed rep (int1 + frac2 + 1) (int2 + frac1)+divide (Fixed fr1) fx2@(Fixed fr2) = Fixed res+ where+ int2 = fromInteger (natVal (asIntProxy fx2))+ frac2 = fromInteger (natVal fx2)+ fr1' = resize fr1+ fr2' = resize fr2+ fr1SH = shiftL fr1' ((int2 + frac2))+ res = fr1SH `quot` fr2'++-- | Constraint for the 'Fractional' instance of 'Fixed'+type FracFixedC rep int frac+ = ( NumFixedC rep int frac+ , DivideC rep int frac int frac+ , Integral (rep (int + frac))+ )++-- | Constraint for the 'Fractional' instance of 'SFixed'+type FracSFixedC int frac+ = ( NumSFixedC int frac+ , KnownNat int+ , KnownNat ((int + frac + 1) + (int + frac))+ )++-- | Constraint for the 'Fractional' instance of 'UFixed'+type FracUFixedC int frac+ = FracSFixedC int frac++-- | The operators of this instance saturate on overflow, and use truncation as+-- the rounding method.+--+-- When used in a polymorphic setting, use the following+-- <CLaSH-Sized-Fixed.html#constraintsynonyms Constraint synonyms> for less+-- verbose type signatures:+--+-- * @'FracFixedC' frac rep size@ for: @'Fixed' frac rep size@+-- * @'FracSFixedC' int frac@ for: @'SFixed' int frac@+-- * @'FracUFixedC' int frac@ for: @'UFixed' int frac@+instance (FracFixedC rep int frac) => Fractional (Fixed rep int frac) where+ f1 / f2 = resizeF (divide f1 f2)+ recip fx = resizeF (divide (1 :: Fixed rep int frac) fx)+ fromRational r = res+ where+ res = Fixed (fromInteger sat)+ sat = if res' > rMax+ then rMax+ else if res' < rMin then rMin else res'++ rMax = toInteger (maxBound :: rep (int + frac))+ rMin = toInteger (minBound :: rep (int + frac))+ res' = n `div` d++ frac = fromInteger (natVal res)+ n = numerator r `shiftL` (2 * frac)+ d = denominator r `shiftL` frac
+ src/CLaSH/Sized/Index.hs view
@@ -0,0 +1,5 @@+module CLaSH.Sized.Index+ (Index)+where++import CLaSH.Sized.Internal.Index
+ src/CLaSH/Sized/Internal/BitVector.hs view
@@ -0,0 +1,538 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module CLaSH.Sized.Internal.BitVector+ ( -- * Datatypes+ BitVector (..)+ , Bit+ -- * Accessors+ -- ** Length information+ , size#+ , maxIndex#+ -- * Construction+ -- ** Initialisation+ , high+ , low+ , bLit+ -- ** Concatenation+ , (++#)+ -- * Reduction+ , reduceAnd#+ , reduceOr#+ , reduceXor#+ -- * Indexing+ , index#+ , replaceBit#+ , setSlice#+ , slice#+ , split#+ , msb#+ , lsb#+ -- * Type classes+ -- ** Eq+ , eq#+ , neq#+ -- ** Ord+ , lt#+ , ge#+ , gt#+ , le#+ -- ** Enum (not synthesisable)+ , enumFrom#+ , enumFromThen#+ , enumFromTo#+ , enumFromThenTo#+ -- ** Bounded+ , minBound#+ , maxBound#+ -- ** Num+ , (+#)+ , (-#)+ , (*#)+ , negate#+ , fromInteger#+ -- ** ExtendingNum+ , plus#+ , minus#+ , times#+ -- ** Integral+ , quot#+ , rem#+ , mod#+ , toInteger#+ -- ** Bits+ , and#+ , or#+ , xor#+ , complement#+ , shiftL#+ , shiftR#+ , rotateL#+ , rotateR#+ , popCount#+ -- ** Resize+ , resize#+ )+where++import Data.Bits (Bits (..), FiniteBits (..))+import Data.Char (digitToInt)+import Data.Default (Default (..))+import Data.Maybe (listToMaybe)+import Data.Typeable (Typeable)+import GHC.Integer (smallInteger)+import GHC.Prim (dataToTag#)+import GHC.TypeLits (KnownNat, Nat, type (+), type (-), natVal)+import Language.Haskell.TH (Q, TExp, TypeQ, appT, conT, litT, numTyLit, sigE)+import Language.Haskell.TH.Syntax (Lift(..))+import Numeric (readInt)++import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..),+ SaturationMode (..))+import CLaSH.Class.Resize (Resize (..))+import CLaSH.Promoted.Nat (SNat, snatToInteger)+import CLaSH.Promoted.Ord (Max)++-- * Type definitions++-- | A vector of bits.+--+-- * Bit indices are descending+-- * 'Num' instance performs /unsigned/ arithmetic.+newtype BitVector (n :: Nat) =+ -- | The constructor, 'BV', and the field, 'unsafeToInteger', are not+ -- synthesisable.+ BV { unsafeToInteger :: Integer}+ deriving Typeable++type Bit = BitVector 1++-- * Instances+instance KnownNat n => Show (BitVector n) where+ show bv@(BV i) = showBV (natVal bv) i []+ where+ showBV 0 _ s = s+ showBV n v s = let (a,b) = divMod v 2+ in case b of+ 1 -> showBV (n - 1) a ('1':s)+ _ -> showBV (n - 1) a ('0':s)++-- | Create a binary literal+--+-- >>> $$(bLit "1001") :: BitVector 4+-- 1001+-- >>> $$(bLit "1001") :: BitVector 3+-- 001+--+-- __NB__: Will be removed once GHC 7.10 is released which has support for+-- binary literals. Once GHC 7.10 is released you can just write:+--+-- >>> 0b1001 :: BitVector 4+-- 1001+bLit :: KnownNat n => String -> Q (TExp (BitVector n))+bLit s = [|| fromInteger# i' ||]+ where+ i :: Maybe Integer+ i = fmap fst . listToMaybe $ (readInt 2 (`elem` "01") digitToInt) s++ i' :: Integer+ i' = case i of+ Just j -> j+ _ -> error "Failed to parse: " s++instance Eq (BitVector n) where+ (==) = eq#+ (/=) = neq#++{-# NOINLINE eq# #-}+eq# :: BitVector n -> BitVector n -> Bool+eq# (BV v1) (BV v2) = v1 == v2++{-# NOINLINE neq# #-}+neq# :: BitVector n -> BitVector n -> Bool+neq# (BV v1) (BV v2) = v1 /= v2++instance Ord (BitVector n) where+ (<) = lt#+ (>=) = ge#+ (>) = gt#+ (<=) = le#++lt#,ge#,gt#,le# :: BitVector n -> BitVector n -> Bool+{-# NOINLINE lt# #-}+lt# (BV n) (BV m) = n < m+{-# NOINLINE ge# #-}+ge# (BV n) (BV m) = n >= m+{-# NOINLINE gt# #-}+gt# (BV n) (BV m) = n > m+{-# NOINLINE le# #-}+le# (BV n) (BV m) = n <= m++-- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and+-- 'enumFromThenTo', are not synthesisable.+instance KnownNat n => Enum (BitVector n) where+ succ = (+# fromInteger# 1)+ pred = (-# fromInteger# 1)+ toEnum = fromInteger# . toInteger+ fromEnum = fromEnum . toInteger#+ enumFrom = enumFrom#+ enumFromThen = enumFromThen#+ enumFromTo = enumFromTo#+ enumFromThenTo = enumFromThenTo#++{-# NOINLINE enumFrom# #-}+{-# NOINLINE enumFromThen# #-}+{-# NOINLINE enumFromTo# #-}+{-# NOINLINE enumFromThenTo# #-}+enumFrom# :: KnownNat n => BitVector n -> [BitVector n]+enumFromThen# :: KnownNat n => BitVector n -> BitVector n -> [BitVector n]+enumFromTo# :: KnownNat n => BitVector n -> BitVector n -> [BitVector n]+enumFromThenTo# :: KnownNat n => BitVector n -> BitVector n -> BitVector n+ -> [BitVector n]+enumFrom# x = map toEnum [fromEnum x ..]+enumFromThen# x y = map toEnum [fromEnum x, fromEnum y ..]+enumFromTo# x y = map toEnum [fromEnum x .. fromEnum y]+enumFromThenTo# x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]++instance KnownNat n => Bounded (BitVector n) where+ minBound = minBound#+ maxBound = maxBound#++{-# NOINLINE minBound# #-}+minBound# :: KnownNat n => BitVector n+minBound# = BV 0++{-# NOINLINE maxBound# #-}+maxBound# :: KnownNat n => BitVector n+maxBound# = let res = BV ((2 ^ natVal res) - 1) in res++instance KnownNat n => Num (BitVector n) where+ (+) = (+#)+ (-) = (-#)+ (*) = (*#)+ negate = negate#+ abs = id+ signum bv = resize# (reduceOr# bv)+ fromInteger = fromInteger#++(+#),(-#),(*#) :: KnownNat n => BitVector n -> BitVector n -> BitVector n+{-# NOINLINE (+#) #-}+(+#) (BV i) (BV j) = fromInteger_INLINE (i + j)++{-# NOINLINE (-#) #-}+(-#) (BV i) (BV j) = fromInteger_INLINE (i - j)++{-# NOINLINE (*#) #-}+(*#) (BV i) (BV j) = fromInteger_INLINE (i * j)++{-# NOINLINE negate# #-}+negate# :: KnownNat n => BitVector n -> BitVector n+negate# bv@(BV i) = BV (sz - i)+ where+ sz = 2 ^ natVal bv++{-# NOINLINE fromInteger# #-}+fromInteger# :: KnownNat n => Integer -> BitVector n+fromInteger# = fromInteger_INLINE++{-# INLINE fromInteger_INLINE #-}+fromInteger_INLINE :: KnownNat n => Integer -> BitVector n+fromInteger_INLINE i = let res = BV (i `mod` (2 ^ natVal res)) in res++instance (KnownNat (Max m n + 1), KnownNat (m + n)) =>+ ExtendingNum (BitVector m) (BitVector n) where+ type AResult (BitVector m) (BitVector n) = BitVector (Max m n + 1)+ plus = plus#+ minus = minus#+ type MResult (BitVector m) (BitVector n) = BitVector (m + n)+ times = times#++plus#, minus# :: KnownNat (Max m n + 1) => BitVector m -> BitVector n+ -> BitVector (Max m n + 1)+{-# NOINLINE plus# #-}+plus# (BV a) (BV b) = fromInteger_INLINE (a + b)++{-# NOINLINE minus# #-}+minus# (BV a) (BV b) = fromInteger_INLINE (a - b)++{-# NOINLINE times# #-}+times# :: KnownNat (m + n) => BitVector m -> BitVector n -> BitVector (m + n)+times# (BV a) (BV b) = fromInteger_INLINE (a * b)++instance KnownNat n => Real (BitVector n) where+ toRational = toRational . toInteger#++instance KnownNat n => Integral (BitVector n) where+ quot = quot#+ rem = rem#+ div = quot#+ mod = mod#+ quotRem n d = (n `quot#` d,n `rem#` d)+ divMod n d = (n `quot#` d,n `mod#` d)+ toInteger = toInteger#++quot#,rem#,mod# :: BitVector n -> BitVector n -> BitVector n+{-# NOINLINE quot# #-}+quot# (BV i) (BV j) = BV (i `quot` j)+{-# NOINLINE rem# #-}+rem# (BV i) (BV j) = BV (i `rem` j)+{-# NOINLINE mod# #-}+mod# (BV i) (BV j) = BV (i `mod` j)++{-# NOINLINE toInteger# #-}+toInteger# :: BitVector n -> Integer+toInteger# (BV i) = i++instance KnownNat n => Bits (BitVector n) where+ (.&.) = and#+ (.|.) = or#+ xor = xor#+ complement = complement#+ zeroBits = 0+ bit i = replaceBit# 0 i high+ setBit v i = replaceBit# v i high+ clearBit v i = replaceBit# v i low+ complementBit v i = replaceBit# v i (complement# (index# v i))+ testBit v i = eq# (index# v i) high+ bitSizeMaybe v = Just (size# v)+ bitSize = size#+ isSigned _ = False+ shiftL v i = shiftL# v i+ shiftR v i = shiftR# v i+ rotateL v i = rotateL# v i+ rotateR v i = rotateR# v i+ popCount = popCount#++instance KnownNat n => FiniteBits (BitVector n) where+ finiteBitSize = size#++{-# NOINLINE reduceAnd# #-}+reduceAnd# :: (KnownNat n) => BitVector n -> BitVector 1+reduceAnd# bv@(BV i) = BV (smallInteger (dataToTag# check))+ where+ check = i == maxI++ sz = natVal bv+ maxI = (2 ^ sz) - 1++{-# NOINLINE reduceOr# #-}+reduceOr# :: BitVector n -> BitVector 1+reduceOr# (BV i) = BV (smallInteger (dataToTag# check))+ where+ check = i /= 0++{-# NOINLINE reduceXor# #-}+reduceXor# :: BitVector n -> BitVector 1+reduceXor# (BV i) = BV (toInteger (popCount i `mod` 2))++instance KnownNat n => Default (BitVector n) where+ def = minBound#++-- * Accessors+-- ** Length information+{-# NOINLINE size# #-}+size# :: KnownNat n => BitVector n -> Int+size# bv = fromInteger (natVal bv)++{-# NOINLINE maxIndex# #-}+maxIndex# :: KnownNat n => BitVector n -> Int+maxIndex# bv = fromInteger (natVal bv) - 1++-- ** Indexing+{-# NOINLINE index# #-}+index# :: KnownNat n => BitVector n -> Int -> Bit+index# bv@(BV v) i+ | i >= 0 && i < sz = BV (smallInteger+ (dataToTag#+ (testBit v i)))+ | otherwise = err+ where+ sz = fromInteger (natVal bv)+ err = error $ concat [ "(!): "+ , show i+ , " is out of range ["+ , show (sz - 1)+ , "..0]"+ ]++{-# NOINLINE msb# #-}+-- | MSB+msb# :: KnownNat n => BitVector n -> Bit+msb# bv@(BV v) = BV (smallInteger (dataToTag# (testBit v i)))+ where+ i = fromInteger (natVal bv - 1)++{-# NOINLINE lsb# #-}+-- | LSB+lsb# :: BitVector n -> Bit+lsb# (BV v) = BV (smallInteger (dataToTag# (testBit v 0)))++{-# NOINLINE slice# #-}+slice# :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)+slice# (BV i) m n = BV (shiftR (i .&. mask) n')+ where+ m' = snatToInteger m+ n' = fromInteger (snatToInteger n)++ mask = 2 ^ (m' + 1) - 1++-- * Constructions+-- ** Initialisation+{-# NOINLINE high #-}+-- | logic '1'+high :: Bit+high = BV 1++{-# NOINLINE low #-}+-- | logic '0'+low :: Bit+low = BV 0++-- ** Concatenation+{-# NOINLINE (++#) #-}+-- | Concatenate two 'BitVector's+(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)+(BV v1) ++# bv2@(BV v2) = BV (v1' + v2)+ where+ v1' = shiftL v1 (fromInteger (natVal bv2))++-- * Modifying BitVectors+{-# NOINLINE replaceBit# #-}+replaceBit# :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n+replaceBit# bv@(BV v) i (BV b)+ | i >= 0 && i < sz = BV (if b == 1 then setBit v i else clearBit v i)+ | otherwise = err+ where+ sz = fromInteger (natVal bv)+ err = error $ concat [ "replaceBit: "+ , show i+ , " is out of range ["+ , show (sz - 1)+ , "..0]"+ ]++{-# NOINLINE setSlice# #-}+setSlice# :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)+ -> BitVector (m + 1 + i)+setSlice# (BV i) m n (BV j) = BV ((i .&. mask) .|. j')+ where+ m' = snatToInteger m+ n' = snatToInteger n++ j' = shiftL j (fromInteger n')+ mask = complement ((2 ^ (m' + 1) - 1) `xor` (2 ^ n' - 1))++{-# NOINLINE split# #-}+split# :: KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)+split# (BV i) = (l,r)+ where+ n = fromInteger (natVal r)+ mask = (2 ^ n) - 1+ r = BV (i .&. mask)+ l = BV (i `shiftR` n)++and#, or#, xor# :: BitVector n -> BitVector n -> BitVector n+{-# NOINLINE and# #-}+and# (BV v1) (BV v2) = BV (v1 .&. v2)++{-# NOINLINE or# #-}+or# (BV v1) (BV v2) = BV (v1 .|. v2)++{-# NOINLINE xor# #-}+xor# (BV v1) (BV v2) = BV (v1 `xor` v2)++{-# NOINLINE complement# #-}+complement# :: KnownNat n => BitVector n -> BitVector n+complement# (BV v1) = fromInteger_INLINE (complement v1)++shiftL#, shiftR#, rotateL#, rotateR# :: KnownNat n => BitVector n -> Int+ -> BitVector n+{-# NOINLINE shiftL# #-}+shiftL# (BV v) i+ | i < 0 = error+ $ "'shiftL undefined for negative number: " ++ show i+ | otherwise = fromInteger_INLINE (shiftL v i)++{-# NOINLINE shiftR# #-}+shiftR# (BV v) i+ | i < 0 = error+ $ "'shiftR undefined for negative number: " ++ show i+ | otherwise = fromInteger_INLINE (shiftR v i)++{-# NOINLINE rotateL# #-}+rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"+rotateL# bv@(BV n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftL n b'+ r = shiftR n b''++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal bv)++{-# NOINLINE rotateR# #-}+rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"+rotateR# bv@(BV n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftR n b'+ r = shiftL n b''++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal bv)++{-# NOINLINE popCount# #-}+popCount# :: BitVector n -> Int+popCount# (BV i) = popCount i++instance Resize BitVector where+ resize = resize#+ zeroExtend = resize#+ signExtend = resize#+ truncateB = resize#++{-# NOINLINE resize# #-}+resize# :: KnownNat m => BitVector n -> BitVector m+resize# (BV n) = fromInteger_INLINE n++instance KnownNat n => Lift (BitVector n) where+ lift bv@(BV i) = sigE [| fromInteger# i |] (decBitVector (natVal bv))++decBitVector :: Integer -> TypeQ+decBitVector n = appT (conT ''BitVector) (litT $ numTyLit n)++instance (KnownNat n, KnownNat (n + 1), KnownNat (n + n)) =>+ SaturatingNum (BitVector n) where+ satPlus SatWrap a b = a +# b+ satPlus w a b = case msb# r of+ 0 -> resize# r+ _ -> case w of+ SatZero -> minBound#+ _ -> maxBound#+ where+ r = plus# a b++ satMin SatWrap a b = a -# b+ satMin _ a b = case msb# r of+ 0 -> resize# r+ _ -> minBound#+ where+ r = minus# a b++ satMult SatWrap a b = a *# b+ satMult w a b = case rL of+ 0 -> rR+ _ -> case w of+ SatZero -> minBound#+ _ -> maxBound#+ where+ r = times# a b+ (rL,rR) = split# r
+ src/CLaSH/Sized/Internal/Index.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}++module CLaSH.Sized.Internal.Index+ ( -- * Datatypes+ Index (..)+ -- * Type classes+ -- ** Eq+ , eq#+ , neq#+ -- ** Ord+ , lt#+ , ge#+ , gt#+ , le#+ -- ** Enum (not synthesisable)+ , enumFrom#+ , enumFromThen#+ , enumFromTo#+ , enumFromThenTo#+ -- ** Bounded+ , maxBound#+ -- ** Num+ , (+#)+ , (-#)+ , (*#)+ , fromInteger#+ -- ** Integral+ , quot#+ , rem#+ , mod#+ , toInteger#+ )+where++import Data.Default (Default (..))+import Data.Typeable (Typeable)+import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE)+import Language.Haskell.TH.Syntax (Lift(..))+import GHC.TypeLits (KnownNat, Nat, natVal)++-- | Arbitrary-bounded unsigned integer represented by @ceil(log_2(n))@ bits.+--+-- Given an upper bound @n@, an 'Index' @n@ number has a range of: [0 .. @n@-1]+newtype Index (n :: Nat) =+ -- | The constructor, 'I', and the field, 'unsafeToInteger', are not+ -- synthesisable.+ I { unsafeToInteger :: Integer }+ deriving Typeable++instance Eq (Index n) where+ (==) = eq#+ (/=) = neq#++{-# NOINLINE eq# #-}+eq# :: (Index n) -> (Index n) -> Bool+(I n) `eq#` (I m) = n == m++{-# NOINLINE neq# #-}+neq# :: (Index n) -> (Index n) -> Bool+(I n) `neq#` (I m) = n /= m++instance Ord (Index n) where+ (<) = lt#+ (>=) = ge#+ (>) = gt#+ (<=) = le#++lt#,ge#,gt#,le# :: Index n -> Index n -> Bool+{-# NOINLINE lt# #-}+lt# (I n) (I m) = n < m+{-# NOINLINE ge# #-}+ge# (I n) (I m) = n >= m+{-# NOINLINE gt# #-}+gt# (I n) (I m) = n > m+{-# NOINLINE le# #-}+le# (I n) (I m) = n <= m++-- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and+-- 'enumFromThenTo', are not synthesisable.+instance KnownNat n => Enum (Index n) where+ succ = (+# fromInteger# 1)+ pred = (-# fromInteger# 1)+ toEnum = fromInteger# . toInteger+ fromEnum = fromEnum . toInteger#+ enumFrom = enumFrom#+ enumFromThen = enumFromThen#+ enumFromTo = enumFromTo#+ enumFromThenTo = enumFromThenTo#++{-# NOINLINE enumFrom# #-}+{-# NOINLINE enumFromThen# #-}+{-# NOINLINE enumFromTo# #-}+{-# NOINLINE enumFromThenTo# #-}+enumFrom# :: KnownNat n => Index n -> [Index n]+enumFromThen# :: KnownNat n => Index n -> Index n -> [Index n]+enumFromTo# :: KnownNat n => Index n -> Index n -> [Index n]+enumFromThenTo# :: KnownNat n => Index n -> Index n -> Index n -> [Index n]+enumFrom# x = map toEnum [fromEnum x ..]+enumFromThen# x y = map toEnum [fromEnum x, fromEnum y ..]+enumFromTo# x y = map toEnum [fromEnum x .. fromEnum y]+enumFromThenTo# x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]++instance KnownNat n => Bounded (Index n) where+ minBound = fromInteger# 0+ maxBound = maxBound#++{-# NOINLINE maxBound# #-}+maxBound# :: KnownNat n => Index n+maxBound# = let res = I (natVal res - 1) in res++-- | Operators report an error on overflow and underflow+instance KnownNat n => Num (Index n) where+ (+) = (+#)+ (-) = (-#)+ (*) = (*#)+ negate = (maxBound# -#)+ abs = id+ signum i = if i == 0 then 0 else 1+ fromInteger = fromInteger#++(+#),(-#),(*#) :: KnownNat n => Index n -> Index n -> Index n+{-# NOINLINE (+#) #-}+(+#) (I a) (I b) = fromInteger_INLINE $ a + b++{-# NOINLINE (-#) #-}+(-#) (I a) (I b) = fromInteger_INLINE $ a - b++{-# NOINLINE (*#) #-}+(*#) (I a) (I b) = fromInteger_INLINE $ a * b++fromInteger#,fromInteger_INLINE :: KnownNat n => Integer -> Index n+{-# NOINLINE fromInteger# #-}+fromInteger# = fromInteger_INLINE+{-# INLINE fromInteger_INLINE #-}+fromInteger_INLINE i =+ let bound = natVal res+ i' = i `mod` bound+ err = error (show i ++ " is out of bounds: [0.." ++ show (bound - 1) ++ "]")+ res = if i' /= i then err else I i+ in res++instance KnownNat n => Real (Index n) where+ toRational = toRational . toInteger#++instance KnownNat n => Integral (Index n) where+ quot = quot#+ rem = rem#+ div = quot#+ mod = mod#+ quotRem n d = (n `quot#` d,n `rem#` d)+ divMod n d = (n `quot#` d,n `mod#` d)+ toInteger = toInteger#++quot#,rem#,mod# :: KnownNat n => Index n -> Index n -> Index n+{-# NOINLINE quot# #-}+(I a) `quot#` (I b) = I (a `div` b)+{-# NOINLINE rem# #-}+(I a) `rem#` (I b) = I (a `rem` b)+{-# NOINLINE mod# #-}+(I a) `mod#` (I b) = I (a `mod` b)++{-# NOINLINE toInteger# #-}+toInteger# :: Index n -> Integer+toInteger# (I n) = n++instance KnownNat n => Lift (Index n) where+ lift u@(I i) = sigE [| fromInteger# i |] (decIndex (natVal u))++decIndex :: Integer -> TypeQ+decIndex n = appT (conT ''Index) (litT $ numTyLit n)++instance Show (Index n) where+ show (I n) = show n++instance KnownNat n => Default (Index n) where+ def = fromInteger# 0
+ src/CLaSH/Sized/Internal/Signed.hs view
@@ -0,0 +1,441 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module CLaSH.Sized.Internal.Signed+ ( -- * Datatypes+ Signed (..)+ -- * Accessors+ -- ** Length information+ , size#+ -- * Type classes+ -- ** BitConvert+ , pack#+ , unpack#+ -- Eq+ , eq#+ , neq#+ -- ** Ord+ , lt#+ , ge#+ , gt#+ , le#+ -- ** Enum (not synthesisable)+ , enumFrom#+ , enumFromThen#+ , enumFromTo#+ , enumFromThenTo#+ -- ** Bounded+ , minBound#+ , maxBound#+ -- ** Num+ , (+#)+ , (-#)+ , (*#)+ , negate#+ , abs#+ , fromInteger#+ -- ** ExtendingNum+ , plus#+ , minus#+ , times#+ -- ** Integral+ , quot#+ , rem#+ , div#+ , mod#+ , toInteger#+ -- ** Bits+ , and#+ , or#+ , xor#+ , complement#+ , shiftL#+ , shiftR#+ , rotateL#+ , rotateR#+ , popCount#+ -- ** Resize+ , resize#+ , truncateB#+ -- ** SaturatingNum+ , minBoundSym#+ )+where++import Data.Bits (Bits (..), FiniteBits (..))+import Data.Default (Default (..))+import Data.Typeable (Typeable)+import GHC.TypeLits (KnownNat, Nat, type (+), natVal)+import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE)+import Language.Haskell.TH.Syntax (Lift(..))++import CLaSH.Class.BitPack (BitPack (..))+import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..),+ SaturationMode (..))+import CLaSH.Class.Resize (Resize (..))+import CLaSH.Prelude.BitIndex ((!), msb, replaceBit, split)+import CLaSH.Prelude.BitReduction (reduceAnd, reduceOr)+import CLaSH.Promoted.Ord (Max)+import CLaSH.Sized.Internal.BitVector (BitVector (..), (++#), high, low)+import qualified CLaSH.Sized.Internal.BitVector as BV++-- | Arbitrary-width signed integer represented by @n@ bits, including the sign+-- bit.+--+-- Uses standard 2-complements representation. Meaning that, given @n@ bits,+-- a 'Signed' @n@ number has a range of: [-(2^(@n@-1)) .. 2^(@n@-1)-1]+--+-- __NB__: The 'Num' operators perform @wrap-around@ on overflow. If you want+-- saturation on overflow, check out the 'SaturatingNum' class.+newtype Signed (n :: Nat) =+ -- | The constructor, 'S', and the field, 'unsafeToInteger', are not+ -- synthesisable.+ S { unsafeToInteger :: Integer}+ deriving Typeable++{-# NOINLINE size# #-}+size# :: KnownNat n => Signed n -> Int+size# bv = fromInteger (natVal bv)++instance Show (Signed n) where+ show (S n) = show n++instance KnownNat n => BitPack (Signed n) where+ type BitSize (Signed n) = n+ pack = pack#+ unpack = unpack#++{-# NOINLINE pack# #-}+pack# :: KnownNat n => Signed n -> BitVector n+pack# s@(S i) = BV (i `mod` maxI)+ where+ maxI = 2 ^ natVal s++{-# NOINLINE unpack# #-}+unpack# :: KnownNat n => BitVector n -> Signed n+unpack# (BV i) = fromInteger_INLINE i++instance Eq (Signed n) where+ (==) = eq#+ (/=) = neq#++{-# NOINLINE eq# #-}+eq# :: Signed n -> Signed n -> Bool+eq# (S v1) (S v2) = v1 == v2++{-# NOINLINE neq# #-}+neq# :: Signed n -> Signed n -> Bool+neq# (S v1) (S v2) = v1 /= v2++instance Ord (Signed n) where+ (<) = lt#+ (>=) = ge#+ (>) = gt#+ (<=) = le#++lt#,ge#,gt#,le# :: Signed n -> Signed n -> Bool+{-# NOINLINE lt# #-}+lt# (S n) (S m) = n < m+{-# NOINLINE ge# #-}+ge# (S n) (S m) = n >= m+{-# NOINLINE gt# #-}+gt# (S n) (S m) = n > m+{-# NOINLINE le# #-}+le# (S n) (S m) = n <= m++-- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and+-- 'enumFromThenTo', are not synthesisable.+instance KnownNat n => Enum (Signed n) where+ succ = (+# fromInteger# 1)+ pred = (-# fromInteger# 1)+ toEnum = fromInteger# . toInteger+ fromEnum = fromEnum . toInteger#+ enumFrom = enumFrom#+ enumFromThen = enumFromThen#+ enumFromTo = enumFromTo#+ enumFromThenTo = enumFromThenTo#++{-# NOINLINE enumFrom# #-}+{-# NOINLINE enumFromThen# #-}+{-# NOINLINE enumFromTo# #-}+{-# NOINLINE enumFromThenTo# #-}+enumFrom# :: KnownNat n => Signed n -> [Signed n]+enumFromThen# :: KnownNat n => Signed n -> Signed n -> [Signed n]+enumFromTo# :: KnownNat n => Signed n -> Signed n -> [Signed n]+enumFromThenTo# :: KnownNat n => Signed n -> Signed n -> Signed n -> [Signed n]+enumFrom# x = map toEnum [fromEnum x ..]+enumFromThen# x y = map toEnum [fromEnum x, fromEnum y ..]+enumFromTo# x y = map toEnum [fromEnum x .. fromEnum y]+enumFromThenTo# x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]+++instance KnownNat n => Bounded (Signed n) where+ minBound = minBound#+ maxBound = maxBound#++minBound#,maxBound# :: KnownNat n => Signed n+{-# NOINLINE minBound# #-}+minBound# = let res = S $ negate $ 2 ^ (natVal res - 1) in res+{-# NOINLINE maxBound# #-}+maxBound# = let res = S $ 2 ^ (natVal res - 1) - 1 in res++-- | Operators do @wrap-around@ on overflow+instance KnownNat n => Num (Signed n) where+ (+) = (+#)+ (-) = (-#)+ (*) = (*#)+ negate = negate#+ abs = abs#+ signum s = if s < 0 then (-1) else+ if s > 0 then 1 else 0+ fromInteger = fromInteger#++(+#), (-#), (*#) :: KnownNat n => Signed n -> Signed n -> Signed n+{-# NOINLINE (+#) #-}+(S a) +# (S b) = fromInteger_INLINE (a + b)++{-# NOINLINE (-#) #-}+(S a) -# (S b) = fromInteger_INLINE (a - b)++{-# NOINLINE (*#) #-}+(S a) *# (S b) = fromInteger_INLINE (a * b)++negate#,abs# :: KnownNat n => Signed n -> Signed n+{-# NOINLINE negate# #-}+negate# (S n) = fromInteger_INLINE (negate n)++{-# NOINLINE abs# #-}+abs# (S n) = fromInteger_INLINE (abs n)++{-# NOINLINE fromInteger# #-}+fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)+fromInteger# = fromInteger_INLINE++{-# INLINE fromInteger_INLINE #-}+fromInteger_INLINE :: KnownNat n => Integer -> Signed n+fromInteger_INLINE i+ | n == 0 = S 0+ | otherwise = res+ where+ n = natVal res+ sz = 2 ^ (n - 1)+ res = case divMod i sz of+ (s,i') | even s -> S i'+ | otherwise -> S (i' - sz)++instance (KnownNat (1 + Max m n), KnownNat (m + n)) =>+ ExtendingNum (Signed m) (Signed n) where+ type AResult (Signed m) (Signed n) = Signed (1 + Max m n)+ plus = plus#+ minus = minus#+ type MResult (Signed m) (Signed n) = Signed (m + n)+ times = times#++plus#, minus# :: KnownNat (1 + Max m n) => Signed m -> Signed n+ -> Signed (1 + Max m n)+{-# NOINLINE plus# #-}+plus# (S a) (S b) = fromInteger_INLINE (a + b)++{-# NOINLINE minus# #-}+minus# (S a) (S b) = fromInteger_INLINE (a - b)++{-# NOINLINE times# #-}+times# :: KnownNat (m + n) => Signed m -> Signed n -> Signed (m + n)+times# (S a) (S b) = fromInteger_INLINE (a * b)++instance KnownNat n => Real (Signed n) where+ toRational = toRational . toInteger#++instance KnownNat n => Integral (Signed n) where+ quot = quot#+ rem = rem#+ div = div#+ mod = mod#+ quotRem n d = (n `quot#` d,n `rem#` d)+ divMod n d = (n `div#` d,n `mod#` d)+ toInteger = toInteger#++quot#,rem#,div#,mod# :: KnownNat n => Signed n -> Signed n -> Signed n+{-# NOINLINE quot# #-}+quot# (S a) (S b) = S (a `quot` b)+{-# NOINLINE rem# #-}+rem# (S a) (S b) = S (a `rem` b)+{-# NOINLINE div# #-}+div# (S a) (S b) = S (a `div` b)+{-# NOINLINE mod# #-}+mod# (S a) (S b) = S (a `mod` b)++{-# NOINLINE toInteger# #-}+toInteger# :: Signed n -> Integer+toInteger# (S n) = n++instance KnownNat n => Bits (Signed n) where+ (.&.) = and#+ (.|.) = or#+ xor = xor#+ complement = complement#+ zeroBits = 0+ bit i = replaceBit 0 i high+ setBit v i = replaceBit v i high+ clearBit v i = replaceBit v i low+ complementBit v i = replaceBit v i (BV.complement# (v ! i))+ testBit v i = v ! i == 1+ bitSizeMaybe v = Just (size# v)+ bitSize = size#+ isSigned _ = True+ shiftL v i = shiftL# v i+ shiftR v i = shiftR# v i+ rotateL v i = rotateL# v i+ rotateR v i = rotateR# v i+ popCount = popCount#++and#,or#,xor# :: KnownNat n => Signed n -> Signed n -> Signed n+{-# NOINLINE and# #-}+and# (S a) (S b) = fromInteger_INLINE (a .&. b)+{-# NOINLINE or# #-}+or# (S a) (S b) = fromInteger_INLINE (a .|. b)+{-# NOINLINE xor# #-}+xor# (S a) (S b) = fromInteger_INLINE (xor a b)++{-# NOINLINE complement# #-}+complement# :: KnownNat n => Signed n -> Signed n+complement# = unpack# . complement . pack#++shiftL#,shiftR#,rotateL#,rotateR# :: KnownNat n => Signed n -> Int -> Signed n+{-# NOINLINE shiftL# #-}+shiftL# _ b | b < 0 = error "'shiftL undefined for negative numbers"+shiftL# (S n) b = fromInteger_INLINE (shiftL n b)+{-# NOINLINE shiftR# #-}+shiftR# _ b | b < 0 = error "'shiftR undefined for negative numbers"+shiftR# (S n) b = fromInteger_INLINE (shiftR n b)+{-# NOINLINE rotateL# #-}+rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"+rotateL# s@(S n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftL n b'+ r = shiftR n b'' .&. mask+ mask = 2 ^ b' - 1++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal s)++{-# NOINLINE rotateR# #-}+rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"+rotateR# s@(S n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftR n b' .&. mask+ r = shiftL n b''+ mask = 2 ^ b'' - 1++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal s)++{-# NOINLINE popCount# #-}+popCount# :: KnownNat n => Signed n -> Int+popCount# s@(S i) = popCount i'+ where+ maxI = 2 ^ natVal s+ i' = i `mod` maxI++instance KnownNat n => FiniteBits (Signed n) where+ finiteBitSize = size#++instance Resize Signed where+ resize = resize#+ extend = resize#+ zeroExtend s = unpack# (0 ++# pack s)+ signExtend = resize#+ truncateB = truncateB#++{-# NOINLINE resize# #-}+resize# :: (KnownNat n, KnownNat m) => Signed n -> Signed m+resize# s@(S i) | n <= m = extended+ | otherwise = truncated+ where+ n = fromInteger (natVal s)+ m = fromInteger (natVal extended)++ extended = fromInteger_INLINE i++ mask = (2 ^ (m - 1)) - 1+ sign = 2 ^ (m - 1)+ i' = i .&. mask+ truncated = if testBit i (n - 1)+ then fromInteger_INLINE (i' .|. sign)+ else fromInteger_INLINE i'++{-# NOINLINE truncateB# #-}+truncateB# :: KnownNat m => Signed (n + m) -> Signed m+truncateB# (S n) = fromInteger_INLINE n++instance KnownNat n => Default (Signed n) where+ def = fromInteger# 0++instance KnownNat n => Lift (Signed n) where+ lift s@(S i) = sigE [| fromInteger# i |] (decSigned (natVal s))++decSigned :: Integer -> TypeQ+decSigned n = appT (conT ''Signed) (litT $ numTyLit n)++instance (KnownNat n, KnownNat (1 + n), KnownNat (n + n)) =>+ SaturatingNum (Signed n) where+ satPlus SatWrap a b = a +# b+ satPlus w a b = case msb r `xor` msb r' of+ 0 -> unpack# r'+ _ -> case msb a .&. msb b of+ 1 -> case w of+ SatBound -> minBound#+ SatSymmetric -> minBoundSym#+ _ -> fromInteger# 0+ _ -> case w of+ SatZero -> fromInteger# 0+ _ -> maxBound#+ where+ r = plus# a b+ (_,r') = split r++ satMin SatWrap a b = a -# b+ satMin w a b = case msb r `xor` msb r' of+ 0 -> unpack# r'+ _ -> case msb a ++# msb b of+ 2 -> case w of+ SatBound -> minBound#+ SatSymmetric -> minBoundSym#+ _ -> fromInteger# 0+ _ -> case w of+ SatZero -> fromInteger# 0+ _ -> maxBound#+ where+ r = minus# a b+ (_,r') = split r+++ satMult SatWrap a b = a *# b+ satMult w a b = case overflow of+ 1 -> unpack# rR+ _ -> case msb rL of+ 0 -> case w of+ SatZero -> fromInteger# 0+ _ -> maxBound#+ _ -> case w of+ SatBound -> minBound#+ SatSymmetric -> minBoundSym#+ _ -> fromInteger# 0+ where+ overflow = complement (reduceOr (msb rR ++# pack rL)) .|.+ reduceAnd (msb rR ++# pack rL)+ r = times# a b+ (rL,rR) = split r++minBoundSym# :: KnownNat n => Signed n+minBoundSym# = minBound# +# fromInteger# 1
+ src/CLaSH/Sized/Internal/Unsigned.hs view
@@ -0,0 +1,383 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module CLaSH.Sized.Internal.Unsigned+ ( -- * Datatypes+ Unsigned (..)+ -- * Accessors+ -- ** Length information+ , size#+ -- * Type classes+ -- ** BitConvert+ , pack#+ , unpack#+ -- ** Eq+ , eq#+ , neq#+ -- ** Ord+ , lt#+ , ge#+ , gt#+ , le#+ -- ** Enum (not synthesisable)+ , enumFrom#+ , enumFromThen#+ , enumFromTo#+ , enumFromThenTo#+ -- ** Bounded+ , minBound#+ , maxBound#+ -- ** Num+ , (+#)+ , (-#)+ , (*#)+ , negate#+ , fromInteger#+ -- ** ExtendingNum+ , plus#+ , minus#+ , times#+ -- ** Integral+ , quot#+ , rem#+ , mod#+ , toInteger#+ -- ** Bits+ , and#+ , or#+ , xor#+ , complement#+ , shiftL#+ , shiftR#+ , rotateL#+ , rotateR#+ , popCount#+ -- ** Resize+ , resize#+ )+where++import Data.Bits (Bits (..), FiniteBits (..))+import Data.Default (Default (..))+import Data.Typeable (Typeable)+import GHC.TypeLits (KnownNat, Nat, type (+), natVal)+import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE)+import Language.Haskell.TH.Syntax (Lift(..))++import CLaSH.Class.BitPack (BitPack (..))+import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..),+ SaturationMode (..))+import CLaSH.Class.Resize (Resize (..))+import CLaSH.Prelude.BitIndex ((!), msb, replaceBit, split)+import CLaSH.Prelude.BitReduction (reduceOr)+import CLaSH.Promoted.Ord (Max)+import CLaSH.Sized.Internal.BitVector (BitVector (..), high, low)+import qualified CLaSH.Sized.Internal.BitVector as BV++-- | Arbitrary-width unsigned integer represented by @n@ bits+--+-- Given @n@ bits, an 'Unsigned' @n@ number has a range of: [0 .. 2^@n@-1]+--+-- __NB__: The 'Num' operators perform @wrap-around@ on overflow. If you want+-- saturation on overflow, check out the 'SaturatingNum' class.+newtype Unsigned (n :: Nat) =+ -- | The constructor, 'U', and the field, 'unsafeToBitVector', are not+ -- synthesisable.+ U { unsafeToBitVector :: Integer }+ deriving Typeable++{-# NOINLINE size# #-}+size# :: KnownNat n => Unsigned n -> Int+size# u = fromInteger (natVal u)++instance Show (Unsigned n) where+ show (U i) = show i++instance BitPack (Unsigned n) where+ type BitSize (Unsigned n) = n+ pack = pack#+ unpack = unpack#++{-# NOINLINE pack# #-}+pack# :: Unsigned n -> BitVector n+pack# (U i) = BV i++{-# NOINLINE unpack# #-}+unpack# :: BitVector n -> Unsigned n+unpack# (BV i) = U i++instance Eq (Unsigned n) where+ (==) = eq#+ (/=) = neq#++{-# NOINLINE eq# #-}+eq# :: Unsigned n -> Unsigned n -> Bool+eq# (U v1) (U v2) = v1 == v2++{-# NOINLINE neq# #-}+neq# :: Unsigned n -> Unsigned n -> Bool+neq# (U v1) (U v2) = v1 /= v2++instance Ord (Unsigned n) where+ (<) = lt#+ (>=) = ge#+ (>) = gt#+ (<=) = le#++lt#,ge#,gt#,le# :: Unsigned n -> Unsigned n -> Bool+{-# NOINLINE lt# #-}+lt# (U n) (U m) = n < m+{-# NOINLINE ge# #-}+ge# (U n) (U m) = n >= m+{-# NOINLINE gt# #-}+gt# (U n) (U m) = n > m+{-# NOINLINE le# #-}+le# (U n) (U m) = n <= m++-- | The functions: 'enumFrom', 'enumFromThen', 'enumFromTo', and+-- 'enumFromThenTo', are not synthesisable.+instance KnownNat n => Enum (Unsigned n) where+ succ = (+# fromInteger# 1)+ pred = (-# fromInteger# 1)+ toEnum = fromInteger# . toInteger+ fromEnum = fromEnum . toInteger#+ enumFrom = enumFrom#+ enumFromThen = enumFromThen#+ enumFromTo = enumFromTo#+ enumFromThenTo = enumFromThenTo#++{-# NOINLINE enumFrom# #-}+{-# NOINLINE enumFromThen# #-}+{-# NOINLINE enumFromTo# #-}+{-# NOINLINE enumFromThenTo# #-}+enumFrom# :: KnownNat n => Unsigned n -> [Unsigned n]+enumFromThen# :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]+enumFromTo# :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]+enumFromThenTo# :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n+ -> [Unsigned n]+enumFrom# x = map toEnum [fromEnum x ..]+enumFromThen# x y = map toEnum [fromEnum x, fromEnum y ..]+enumFromTo# x y = map toEnum [fromEnum x .. fromEnum y]+enumFromThenTo# x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]++instance KnownNat n => Bounded (Unsigned n) where+ minBound = minBound#+ maxBound = maxBound#++{-# NOINLINE minBound# #-}+minBound# :: KnownNat n => Unsigned n+minBound# = U 0++{-# NOINLINE maxBound# #-}+maxBound# :: KnownNat n => Unsigned n+maxBound# = let res = U ((2 ^ natVal res) - 1) in res++instance KnownNat n => Num (Unsigned n) where+ (+) = (+#)+ (-) = (-#)+ (*) = (*#)+ negate = negate#+ abs = id+ signum bv = resize# (unpack# (reduceOr bv))+ fromInteger = fromInteger#++(+#),(-#),(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n+{-# NOINLINE (+#) #-}+(+#) (U i) (U j) = fromInteger_INLINE (i + j)++{-# NOINLINE (-#) #-}+(-#) (U i) (U j) = fromInteger_INLINE (i - j)++{-# NOINLINE (*#) #-}+(*#) (U i) (U j) = fromInteger_INLINE (i * j)++{-# NOINLINE negate# #-}+negate# :: KnownNat n => Unsigned n -> Unsigned n+negate# u@(U i) = U (sz - i)+ where+ sz = 2 ^ natVal u++{-# NOINLINE fromInteger# #-}+fromInteger# :: KnownNat n => Integer -> Unsigned n+fromInteger# = fromInteger_INLINE++{-# INLINE fromInteger_INLINE #-}+fromInteger_INLINE :: KnownNat n => Integer -> Unsigned n+fromInteger_INLINE i = let res = U (i `mod` (2 ^ natVal res)) in res++instance (KnownNat (1 + Max m n), KnownNat (m + n)) =>+ ExtendingNum (Unsigned m) (Unsigned n) where+ type AResult (Unsigned m) (Unsigned n) = Unsigned (1 + Max m n)+ plus = plus#+ minus = minus#+ type MResult (Unsigned m) (Unsigned n) = Unsigned (m + n)+ times = times#++plus#, minus# :: KnownNat (1 + Max m n) => Unsigned m -> Unsigned n+ -> Unsigned (1 + Max m n)+{-# NOINLINE plus# #-}+plus# (U a) (U b) = fromInteger_INLINE (a + b)++{-# NOINLINE minus# #-}+minus# (U a) (U b) = fromInteger_INLINE (a - b)++{-# NOINLINE times# #-}+times# :: KnownNat (m + n) => Unsigned m -> Unsigned n -> Unsigned (m + n)+times# (U a) (U b) = fromInteger_INLINE (a * b)++instance KnownNat n => Real (Unsigned n) where+ toRational = toRational . toInteger#++instance KnownNat n => Integral (Unsigned n) where+ quot = quot#+ rem = rem#+ div = quot#+ mod = mod#+ quotRem n d = (n `quot#` d,n `rem#` d)+ divMod n d = (n `quot#` d,n `mod#` d)+ toInteger = toInteger#++quot#,rem#,mod# :: Unsigned n -> Unsigned n -> Unsigned n+{-# NOINLINE quot# #-}+quot# (U i) (U j) = U (i `quot` j)+{-# NOINLINE rem# #-}+rem# (U i) (U j) = U (i `rem` j)+{-# NOINLINE mod# #-}+mod# (U i) (U j) = U (i `mod` j)++{-# NOINLINE toInteger# #-}+toInteger# :: Unsigned n -> Integer+toInteger# (U i) = i++instance KnownNat n => Bits (Unsigned n) where+ (.&.) = and#+ (.|.) = or#+ xor = xor#+ complement = complement#+ zeroBits = 0+ bit i = replaceBit 0 i high+ setBit v i = replaceBit v i high+ clearBit v i = replaceBit v i low+ complementBit v i = replaceBit v i (BV.complement# (v ! i))+ testBit v i = v ! i == high+ bitSizeMaybe v = Just (size# v)+ bitSize = size#+ isSigned _ = False+ shiftL v i = shiftL# v i+ shiftR v i = shiftR# v i+ rotateL v i = rotateL# v i+ rotateR v i = rotateR# v i+ popCount = popCount#++{-# NOINLINE and# #-}+and# :: Unsigned n -> Unsigned n -> Unsigned n+and# (U v1) (U v2) = U (v1 .&. v2)++{-# NOINLINE or# #-}+or# :: Unsigned n -> Unsigned n -> Unsigned n+or# (U v1) (U v2) = U (v1 .|. v2)++{-# NOINLINE xor# #-}+xor# :: Unsigned n -> Unsigned n -> Unsigned n+xor# (U v1) (U v2) = U (v1 `xor` v2)++{-# NOINLINE complement# #-}+complement# :: KnownNat n => Unsigned n -> Unsigned n+complement# (U i) = fromInteger_INLINE (complement i)++shiftL#, shiftR#, rotateL#, rotateR# :: KnownNat n => Unsigned n -> Int+ -> Unsigned n+{-# NOINLINE shiftL# #-}+shiftL# (U v) i+ | i < 0 = error+ $ "'shiftL undefined for negative number: " ++ show i+ | otherwise = fromInteger_INLINE (shiftL v i)++{-# NOINLINE shiftR# #-}+shiftR# (U v) i+ | i < 0 = error+ $ "'shiftR undefined for negative number: " ++ show i+ | otherwise = fromInteger_INLINE (shiftR v i)++{-# NOINLINE rotateL# #-}+rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"+rotateL# bv@(U n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftL n b'+ r = shiftR n b''++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal bv)++{-# NOINLINE rotateR# #-}+rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"+rotateR# bv@(U n) b = fromInteger_INLINE (l .|. r)+ where+ l = shiftR n b'+ r = shiftL n b''++ b' = b `mod` sz+ b'' = sz - b'+ sz = fromInteger (natVal bv)++{-# NOINLINE popCount# #-}+popCount# :: Unsigned n -> Int+popCount# (U i) = popCount i++instance KnownNat n => FiniteBits (Unsigned n) where+ finiteBitSize = size#++instance Resize Unsigned where+ resize = resize#+ zeroExtend = resize#+ signExtend = resize#+ truncateB = resize#++{-# NOINLINE resize# #-}+resize# :: KnownNat m => Unsigned n -> Unsigned m+resize# (U i) = fromInteger_INLINE i++instance KnownNat n => Default (Unsigned n) where+ def = minBound#++instance KnownNat n => Lift (Unsigned n) where+ lift u@(U i) = sigE [| fromInteger# i |] (decUnsigned (natVal u))++decUnsigned :: Integer -> TypeQ+decUnsigned n = appT (conT ''Unsigned) (litT $ numTyLit n)++instance (KnownNat n, KnownNat (1 + n), KnownNat (n + n)) =>+ SaturatingNum (Unsigned n) where+ satPlus SatWrap a b = a +# b+ satPlus w a b = case msb r of+ 0 -> resize# r+ _ -> case w of+ SatZero -> minBound#+ _ -> maxBound#+ where+ r = plus# a b++ satMin SatWrap a b = a -# b+ satMin _ a b = case msb r of+ 0 -> resize# r+ _ -> minBound#+ where+ r = minus# a b++ satMult SatWrap a b = a *# b+ satMult w a b = case rL of+ 0 -> unpack# rR+ _ -> case w of+ SatZero -> minBound#+ _ -> maxBound#+ where+ r = times# a b+ (rL,rR) = split r
src/CLaSH/Sized/Signed.hs view
@@ -1,338 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -fno-warn-missing-methods #-}- module CLaSH.Sized.Signed ( Signed- , resizeS_wrap ) where -import Data.Bits-import Data.Default-import Data.Typeable-import Language.Haskell.TH-import Language.Haskell.TH.Syntax(Lift(..))-import GHC.TypeLits--import CLaSH.Bit-import CLaSH.Class.BitVector-import CLaSH.Class.Num-import CLaSH.Promoted.Ord-import CLaSH.Sized.Vector---- | Arbitrary-width signed integer represented by @n@ bits, including the sign bit.------ Uses standard 2-complements representation. Meaning that, given @n@ bits,--- a 'Signed' @n@ number has a range of: [-(2^(@n@-1)) .. 2^(@n@-1)-1]------ NB: The 'Num' operators perform @wrap-around@ on overflow. If you want saturation--- on overflow, check out the 'CLaSH.Sized.Fixed.satN2' function in "CLaSH.Sized.Fixed".-newtype Signed (n :: Nat) = S Integer- deriving Typeable--instance Eq (Signed n) where- (==) = eqS--{-# NOINLINE eqS #-}-eqS :: (Signed n) -> (Signed n) -> Bool-(S n) `eqS` (S m) = n == m--instance Ord (Signed n) where- (<) = ltS- (>=) = geS- (>) = gtS- (<=) = leS--ltS,geS,gtS,leS :: Signed n -> Signed n -> Bool-{-# NOINLINE ltS #-}-ltS (S n) (S m) = n < m-{-# NOINLINE geS #-}-geS (S n) (S m) = n >= m-{-# NOINLINE gtS #-}-gtS (S n) (S m) = n > m-{-# NOINLINE leS #-}-leS (S n) (S m) = n <= m--instance KnownNat n => Enum (Signed n) where- succ = plusS (fromIntegerS 1)- pred = minS (fromIntegerS 1)- toEnum = fromIntegerS . toInteger- fromEnum = fromEnum . toIntegerS- enumFrom = enumFromS- enumFromThen = enumFromThenS- enumFromTo = enumFromToS- enumFromThenTo = enumFromThenToS--{-# NOINLINE enumFromS #-}-{-# NOINLINE enumFromThenS #-}-{-# NOINLINE enumFromToS #-}-{-# NOINLINE enumFromThenToS #-}-enumFromS :: KnownNat n => Signed n -> [Signed n]-enumFromThenS :: KnownNat n => Signed n -> Signed n -> [Signed n]-enumFromToS :: KnownNat n => Signed n -> Signed n -> [Signed n]-enumFromThenToS :: KnownNat n => Signed n -> Signed n -> Signed n -> [Signed n]-enumFromS x = map toEnum [fromEnum x ..]-enumFromThenS x y = map toEnum [fromEnum x, fromEnum y ..]-enumFromToS x y = map toEnum [fromEnum x .. fromEnum y]-enumFromThenToS x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]---instance KnownNat n => Bounded (Signed n) where- minBound = minBoundS- maxBound = maxBoundS--minBoundS,maxBoundS :: KnownNat n => Signed n-{-# NOINLINE minBoundS #-}-minBoundS = let res = S $ negate $ 2 ^ (natVal res - 1) in res-{-# NOINLINE maxBoundS #-}-maxBoundS = let res = S $ 2 ^ (natVal res - 1) - 1 in res---- | Operators do @wrap-around@ on overflow-instance KnownNat n => Num (Signed n) where- (+) = plusS- (-) = minS- (*) = timesS- negate = negateS- abs = absS- signum = signumS- fromInteger = fromIntegerS--plusS,minS,timesS :: KnownNat n => Signed n -> Signed n -> Signed n-{-# NOINLINE plusS #-}-plusS (S a) (S b) = fromIntegerS_inlineable (a + b)--{-# NOINLINE minS #-}-minS (S a) (S b) = fromIntegerS_inlineable (a - b)--{-# NOINLINE timesS #-}-timesS (S a) (S b) = fromIntegerS_inlineable (a * b)--negateS,absS,signumS :: KnownNat n => Signed n -> Signed n-{-# NOINLINE negateS #-}-negateS (S n) = fromIntegerS_inlineable (0 - n)--{-# NOINLINE absS #-}-absS (S n) = fromIntegerS_inlineable (abs n)--{-# NOINLINE signumS #-}-signumS (S n) = fromIntegerS_inlineable (signum n)--fromIntegerS,fromIntegerS_inlineable :: KnownNat n => Integer -> Signed (n :: Nat)-{-# NOINLINE fromIntegerS #-}-fromIntegerS = fromIntegerS_inlineable-{-# INLINABLE fromIntegerS_inlineable #-}-fromIntegerS_inlineable i- | nS == 0 = S 0- | otherwise = res- where- nS = natVal res- sz = 2 ^ (nS - 1)- res = case divMod i sz of- (s,i') | even s -> S i'- | otherwise -> S (i' - sz)--instance KnownNat (Max m n) => Add (Signed m) (Signed n) where- type AResult (Signed m) (Signed n) = Signed (Max m n)- plus = plusS2- minus = minusS2--plusS2, minusS2 :: KnownNat (Max m n) => Signed m -> Signed n -> Signed (Max m n)-{-# NOINLINE plusS2 #-}-plusS2 (S a) (S b) = fromIntegerS_inlineable (a + b)--{-# NOINLINE minusS2 #-}-minusS2 (S a) (S b) = fromIntegerS_inlineable (a - b)--instance KnownNat (m + n) => Mult (Signed m) (Signed n) where- type MResult (Signed m) (Signed n) = Signed (m + n)- mult = multS2--{-# NOINLINE multS2 #-}-multS2 :: KnownNat (m + n) => Signed m -> Signed n -> Signed (m + n)-multS2 (S a) (S b) = fromIntegerS_inlineable (a * b)--instance KnownNat n => Real (Signed n) where- toRational = toRational . toIntegerS--instance KnownNat n => Integral (Signed n) where- quot = quotS- rem = remS- div = divS- mod = modS- quotRem = quotRemS- divMod = divModS- toInteger = toIntegerS--quotS,remS,divS,modS :: KnownNat n => Signed n -> Signed n -> Signed n-{-# NOINLINE quotS #-}-quotS = (fst.) . quotRemS_inlineable-{-# NOINLINE remS #-}-remS = (snd.) . quotRemS_inlineable-{-# NOINLINE divS #-}-divS = (fst.) . divModS_inlineable-{-# NOINLINE modS #-}-modS = (snd.) . divModS_inlineable--quotRemS,divModS :: KnownNat n => Signed n -> Signed n -> (Signed n, Signed n)-quotRemS n d = (n `quotS` d,n `remS` d)-divModS n d = (n `divS` d,n `modS` d)--quotRemS_inlineable,divModS_inlineable :: KnownNat n => Signed n -> Signed n -> (Signed n, Signed n)-{-# INLINEABLE quotRemS_inlineable #-}-(S a) `quotRemS_inlineable` (S b) = let (a',b') = a `quotRem` b- in (fromIntegerS_inlineable a', fromIntegerS_inlineable b')-{-# INLINEABLE divModS_inlineable #-}-(S a) `divModS_inlineable` (S b) = let (a',b') = a `divMod` b- in (fromIntegerS_inlineable a', fromIntegerS_inlineable b')--{-# NOINLINE toIntegerS #-}-toIntegerS :: Signed n -> Integer-toIntegerS (S n) = n--instance KnownNat n => Bits (Signed n) where- (.&.) = andS- (.|.) = orS- xor = xorS- complement = complementS- bit = bitS- testBit = testBitS- bitSizeMaybe = Just . finiteBitSizeS- isSigned = const True- shiftL = shiftLS- shiftR = shiftRS- rotateL = rotateLS- rotateR = rotateRS- popCount = popCountS--andS,orS,xorS :: KnownNat n => Signed n -> Signed n -> Signed n-{-# NOINLINE andS #-}-(S a) `andS` (S b) = fromIntegerS_inlineable (a .&. b)-{-# NOINLINE orS #-}-(S a) `orS` (S b) = fromIntegerS_inlineable (a .|. b)-{-# NOINLINE xorS #-}-(S a) `xorS` (S b) = fromIntegerS_inlineable (xor a b)--{-# NOINLINE complementS #-}-complementS :: KnownNat n => Signed n -> Signed n-complementS = fromBitVector . vmap complement . toBitVector--{-# NOINLINE bitS #-}-bitS :: KnownNat n => Int -> Signed n-bitS i = res- where- sz = finiteBitSizeS res- res | sz > i = fromIntegerS_inlineable (bit i)- | otherwise = error $ concat [ "bit: "- , "Setting out-of-range bit position, size: "- , show sz- , ", position: "- , show i- ]--{-# NOINLINE testBitS #-}-testBitS :: KnownNat n => Signed n -> Int -> Bool-testBitS s@(S n) i- | sz > i = testBit n i- | otherwise = error $ concat [ "testBit: "- , "Setting out-of-range bit position, size: "- , show sz- , ", position: "- , show i- ]- where- sz = finiteBitSizeS s--shiftLS,shiftRS,rotateLS,rotateRS :: KnownNat n => Signed n -> Int -> Signed n-{-# NOINLINE shiftLS #-}-shiftLS _ b | b < 0 = error "'shiftL'{Signed} undefined for negative numbers"-shiftLS (S n) b = fromIntegerS_inlineable (shiftL n b)-{-# NOINLINE shiftRS #-}-shiftRS _ b | b < 0 = error "'shiftR'{Signed} undefined for negative numbers"-shiftRS (S n) b = fromIntegerS_inlineable (shiftR n b)-{-# NOINLINE rotateLS #-}-rotateLS _ b | b < 0 = error "'shiftL'{Signed} undefined for negative numbers"-rotateLS n b = let b' = b `mod` finiteBitSizeS n- in shiftL n b' .|. shiftR n (finiteBitSizeS n - b')-{-# NOINLINE rotateRS #-}-rotateRS _ b | b < 0 = error "'shiftR'{Signed} undefined for negative numbers"-rotateRS n b = let b' = b `mod` finiteBitSizeS n- in shiftR n b' .|. shiftL n (finiteBitSizeS n - b')--{-# NOINLINE popCountS #-}-popCountS :: Signed n -> Int-popCountS (S n) = popCount n--instance KnownNat n => FiniteBits (Signed n) where- finiteBitSize = finiteBitSizeS--{-# NOINLINE finiteBitSizeS #-}-finiteBitSizeS :: KnownNat n => Signed n -> Int-finiteBitSizeS = fromInteger . natVal--instance Show (Signed n) where- show (S n) = show n--instance KnownNat n => Default (Signed n) where- def = fromIntegerS 0--instance KnownNat n => Lift (Signed n) where- lift s@(S i) = sigE [| fromIntegerS i |] (decSigned (natVal s))--decSigned :: Integer -> TypeQ-decSigned n = appT (conT ''Signed) (litT $ numTyLit n)--instance BitVector (Signed n) where- type BitSize (Signed n) = n- toBV = toBitVector- fromBV = fromBitVector--{-# NOINLINE toBitVector #-}-toBitVector :: KnownNat n => Signed n -> Vec n Bit-toBitVector (S m) = vreverse $ vmap (\x -> if odd x then H else L) $ viterateI (`div` 2) m--{-# NOINLINE fromBitVector #-}-fromBitVector :: KnownNat n => Vec n Bit -> Signed n-fromBitVector = fromBitList . reverse . toList--{-# INLINABLE fromBitList #-}-fromBitList :: KnownNat n => [Bit] -> Signed n-fromBitList l = fromIntegerS_inlineable- $ sum [ n- | (n,b) <- zip (iterate (*2) 1) l- , b == H- ]--{-# NOINLINE resizeS #-}-resizeS :: (KnownNat n, KnownNat m) => Signed n -> Signed m-resizeS s@(S n) | n' <= m' = extend- | otherwise = trunc- where- n' = fromInteger (natVal s)- m' = fromInteger (natVal extend)- extend = fromIntegerS_inlineable n- trunc = case toList (toBitVector s) of- (x:xs) -> fromBitList $ reverse $ x : (drop (n' - m') xs)- _ -> error "resizeS impossible case: empty list"--{-# NOINLINE resizeS_wrap #-}--- | A resize operation that is sign-preserving on extension, but wraps on truncation.------ Increasing the size of the number replicates the sign bit to the left.--- Truncating a number of length N to a length L just removes the leftmost N-L bits.-resizeS_wrap :: KnownNat m => Signed n -> Signed m-resizeS_wrap (S n) = fromIntegerS_inlineable n---- | A sign-preserving resize operation------ 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.-instance Resize Signed where- resize = resizeS+import CLaSH.Sized.Internal.Signed
src/CLaSH/Sized/Unsigned.hs view
@@ -1,300 +1,5 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -fno-warn-missing-methods #-}- module CLaSH.Sized.Unsigned- ( Unsigned- )+ (Unsigned) where -import Data.Bits-import Data.Default-import Data.Typeable-import Language.Haskell.TH-import Language.Haskell.TH.Syntax(Lift(..))-import GHC.TypeLits--import CLaSH.Bit-import CLaSH.Class.BitVector-import CLaSH.Class.Num-import CLaSH.Promoted.Ord-import CLaSH.Sized.Vector---- | Arbitrary-width unsigned integer represented by @n@ bits------ Given @n@ bits, an 'Unsigned' @n@ number has a range of: [0 .. 2^@n@-1]------ NB: The 'Num' operators perform @wrap-around@ on overflow. If you want saturation--- on overflow, check out the 'CLaSH.Sized.Fixed.satN2' function in "CLaSH.Sized.Fixed".-newtype Unsigned (n :: Nat) = U Integer- deriving Typeable--instance Eq (Unsigned n) where- (==) = eqU--{-# NOINLINE eqU #-}-eqU :: (Unsigned n) -> (Unsigned n) -> Bool-(U n) `eqU` (U m) = n == m--instance Ord (Unsigned n) where- (<) = ltU- (>=) = geU- (>) = gtU- (<=) = leU--ltU,geU,gtU,leU :: Unsigned n -> Unsigned n -> Bool-{-# NOINLINE ltU #-}-ltU (U n) (U m) = n < m-{-# NOINLINE geU #-}-geU (U n) (U m) = n >= m-{-# NOINLINE gtU #-}-gtU (U n) (U m) = n > m-{-# NOINLINE leU #-}-leU (U n) (U m) = n <= m--instance KnownNat n => Enum (Unsigned n) where- succ = plusU (fromIntegerU 1)- pred = minU (fromIntegerU 1)- toEnum = fromIntegerU . toInteger- fromEnum = fromEnum . toIntegerU- enumFrom = enumFromU- enumFromThen = enumFromThenU- enumFromTo = enumFromToU- enumFromThenTo = enumFromThenToU--{-# NOINLINE enumFromU #-}-{-# NOINLINE enumFromThenU #-}-{-# NOINLINE enumFromToU #-}-{-# NOINLINE enumFromThenToU #-}-enumFromU :: KnownNat n => Unsigned n -> [Unsigned n]-enumFromThenU :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]-enumFromToU :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]-enumFromThenToU :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n -> [Unsigned n]-enumFromU x = map toEnum [fromEnum x ..]-enumFromThenU x y = map toEnum [fromEnum x, fromEnum y ..]-enumFromToU x y = map toEnum [fromEnum x .. fromEnum y]-enumFromThenToU x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]--instance KnownNat n => Bounded (Unsigned n) where- minBound = fromIntegerU 0- maxBound = maxBoundU--{-# NOINLINE maxBoundU #-}-maxBoundU :: KnownNat n => Unsigned n-maxBoundU = let res = U ((2 ^ natVal res) - 1) in res---- | Operators do @wrap-around@ on overflow-instance KnownNat n => Num (Unsigned n) where- (+) = plusU- (-) = minU- (*) = timesU- negate = id- abs = id- signum = signumU- fromInteger = fromIntegerU--plusU,minU,timesU :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n-{-# NOINLINE plusU #-}-plusU (U a) (U b) = fromIntegerU_inlineable $ a + b--{-# NOINLINE minU #-}-minU (U a) (U b) = fromIntegerU_inlineable $ a - b--{-# NOINLINE timesU #-}-timesU (U a) (U b) = fromIntegerU_inlineable $ a * b--{-# NOINLINE signumU #-}-signumU :: Unsigned n -> Unsigned n-signumU (U 0) = (U 0)-signumU (U _) = (U 1)--fromIntegerU,fromIntegerU_inlineable :: KnownNat n => Integer -> Unsigned n-{-# NOINLINE fromIntegerU #-}-fromIntegerU = fromIntegerU_inlineable-{-# INLINABLE fromIntegerU_inlineable #-}-fromIntegerU_inlineable i = let res = U (i `mod` (2 ^ natVal res)) in res--instance KnownNat (Max m n) => Add (Unsigned m) (Unsigned n) where- type AResult (Unsigned m) (Unsigned n) = Unsigned (Max m n)- plus = plusU2- minus = minusU2--plusU2, minusU2 :: KnownNat (Max m n) => Unsigned m -> Unsigned n -> Unsigned (Max m n)-{-# NOINLINE plusU2 #-}-plusU2 (U a) (U b) = fromIntegerU_inlineable (a + b)--{-# NOINLINE minusU2 #-}-minusU2 (U a) (U b) = fromIntegerU_inlineable (a - b)--instance KnownNat (m + n) => Mult (Unsigned m) (Unsigned n) where- type MResult (Unsigned m) (Unsigned n) = Unsigned (m + n)- mult = multU2--{-# NOINLINE multU2 #-}-multU2 :: KnownNat (m + n) => Unsigned m -> Unsigned n -> Unsigned (m + n)-multU2 (U a) (U b) = fromIntegerU_inlineable (a * b)--instance KnownNat n => Real (Unsigned n) where- toRational = toRational . toIntegerU--instance KnownNat n => Integral (Unsigned n) where- quot = quotU- rem = remU- div = quotU- mod = modU- quotRem = quotRemU- divMod = divModU- toInteger = toIntegerU--quotU,remU,modU :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n-{-# NOINLINE quotU #-}-quotU = (fst.) . quotRemU_inlineable-{-# NOINLINE remU #-}-remU = (snd.) . quotRemU_inlineable-{-# NOINLINE modU #-}-(U a) `modU` (U b) = fromIntegerU_inlineable (a `mod` b)--quotRemU,divModU :: KnownNat n => Unsigned n -> Unsigned n -> (Unsigned n, Unsigned n)-quotRemU n d = (n `quotU` d,n `remU` d)-divModU n d = (n `quotU` d,n `modU` d)--{-# INLINEABLE quotRemU_inlineable #-}-quotRemU_inlineable :: KnownNat n => Unsigned n -> Unsigned n -> (Unsigned n, Unsigned n)-(U a) `quotRemU_inlineable` (U b) = let (a',b') = a `quotRem` b- in (fromIntegerU_inlineable a', fromIntegerU_inlineable b')--{-# NOINLINE toIntegerU #-}-toIntegerU :: Unsigned n -> Integer-toIntegerU (U n) = n--instance KnownNat n => Bits (Unsigned n) where- (.&.) = andU- (.|.) = orU- xor = xorU- complement = complementU- bit = bitU- testBit = testBitU- bitSizeMaybe = Just . finiteBitSizeU- isSigned = const False- shiftL = shiftLU- shiftR = shiftRU- rotateL = rotateLU- rotateR = rotateRU- popCount = popCountU--andU,orU,xorU :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n-{-# NOINLINE andU #-}-(U a) `andU` (U b) = fromIntegerU_inlineable (a .&. b)-{-# NOINLINE orU #-}-(U a) `orU` (U b) = fromIntegerU_inlineable (a .|. b)-{-# NOINLINE xorU #-}-(U a) `xorU` (U b) = fromIntegerU_inlineable (xor a b)--{-# NOINLINE complementU #-}-complementU :: KnownNat n => Unsigned n -> Unsigned n-complementU = fromBitVector . vmap complement . toBitVector--{-# NOINLINE bitU #-}-bitU :: KnownNat n => Int -> Unsigned n-bitU i = res- where- sz = finiteBitSizeU res- res | sz > i = fromIntegerU_inlineable (bit i)- | otherwise = error $ concat [ "bit: "- , "Setting out-of-range bit position, size: "- , show sz- , ", position: "- , show i- ]--{-# NOINLINE testBitU #-}-testBitU :: KnownNat n => Unsigned n -> Int -> Bool-testBitU s@(U n) i- | sz > i = testBit n i- | otherwise = error $ concat [ "testBit: "- , "Setting out-of-range bit position, size: "- , show sz- , ", position: "- , show i- ]- where- sz = finiteBitSizeU s--shiftLU,shiftRU,rotateLU,rotateRU :: KnownNat n => Unsigned n -> Int -> Unsigned n-{-# NOINLINE shiftLU #-}-shiftLU _ b | b < 0 = error "'shiftL'{Unsigned} undefined for negative numbers"-shiftLU (U n) b = fromIntegerU_inlineable (shiftL n b)-{-# NOINLINE shiftRU #-}-shiftRU _ b | b < 0 = error "'shiftR'{Unsigned} undefined for negative numbers"-shiftRU (U n) b = fromIntegerU_inlineable (shiftR n b)-{-# NOINLINE rotateLU #-}-rotateLU _ b | b < 0 = error "'shiftL'{Unsigned} undefined for negative numbers"-rotateLU n b = let b' = b `mod` finiteBitSizeU n- in shiftL n b' .|. shiftR n (finiteBitSizeU n - b')-{-# NOINLINE rotateRU #-}-rotateRU _ b | b < 0 = error "'shiftR'{Unsigned} undefined for negative numbers"-rotateRU n b = let b' = b `mod` finiteBitSizeU n- in shiftR n b' .|. shiftL n (finiteBitSizeU n - b')--{-# NOINLINE popCountU #-}-popCountU :: Unsigned n -> Int-popCountU (U n) = popCount n--instance KnownNat n => FiniteBits (Unsigned n) where- finiteBitSize = finiteBitSizeU--{-# NOINLINE finiteBitSizeU #-}-finiteBitSizeU :: KnownNat n => Unsigned n -> Int-finiteBitSizeU u = fromInteger (natVal u)--instance KnownNat n => Lift (Unsigned n) where- lift u@(U i) = sigE [| fromIntegerU i |] (decUnsigned (natVal u))--decUnsigned :: Integer -> TypeQ-decUnsigned n = appT (conT ''Unsigned) (litT $ numTyLit n)--instance Show (Unsigned n) where- show (U n) = show n--instance KnownNat n => Default (Unsigned n) where- def = fromIntegerU 0--instance BitVector (Unsigned n) where- type BitSize (Unsigned n) = n- toBV = toBitVector- fromBV = fromBitVector--{-# NOINLINE toBitVector #-}-toBitVector :: KnownNat n => Unsigned n -> Vec n Bit-toBitVector (U m) = vreverse $ vmap (\x -> if odd x then H else L) $ viterateI (`div` 2) m--{-# NOINLINE fromBitVector #-}-fromBitVector :: KnownNat n => Vec n Bit -> Unsigned n-fromBitVector = fromBitList . reverse . toList--{-# INLINABLE fromBitList #-}-fromBitList :: KnownNat n => [Bit] -> Unsigned n-fromBitList l = fromIntegerU_inlineable- $ sum [ n- | (n,b) <- zip (iterate (*2) 1) l- , b == H- ]--{-# NOINLINE resizeU #-}-resizeU :: KnownNat m => Unsigned n -> Unsigned m-resizeU (U n) = fromIntegerU_inlineable n---- | A resize operation that zero-extends on extension, and wraps on truncation.------ 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.-instance Resize Unsigned where- resize = resizeU+import CLaSH.Sized.Internal.Unsigned
src/CLaSH/Sized/Vector.hs view
@@ -2,727 +2,964 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}--module CLaSH.Sized.Vector- ( -- * 'Vec'tor constructors- Vec(..), (<:)- -- * Standard 'Vec'tor functions- -- ** Extracting sub-'Vec'tors- , vhead, vtail, vlast, vinit- , vtake, vtakeI, vdrop, vdropI, vexact, vselect, vselectI- -- ** Combining 'Vec'tors- , (+>>), (<<+), (<++>), vconcat, vzip, vunzip- -- ** Splitting 'Vec'tors- , vsplit, vsplitI, vunconcat, vunconcatI, vmerge- -- ** Applying functions to 'Vec'tor elements- , vmap, vzipWith- , vfoldr, vfoldl, vfoldr1, vfoldl1- , vscanl, vscanr, vscanl1, vscanr1- , vmapAccumL, vmapAccumR- -- ** Indexing 'Vec'tors- , (!), vreplace, maxIndex, vlength- -- ** Generating 'Vec'tors- , vcopy, vcopyI, viterate, viterateI, vgenerate, vgenerateI- -- ** Misc- , vreverse, toList, v, lazyV, asNatProxy- -- * Alternative 'Vec'tor functions- , vhead'- )-where--import Control.Applicative--- import Data.Traversable-import Data.Default-import Data.Foldable hiding (toList)-import Data.Proxy-import GHC.TypeLits-import Language.Haskell.TH (ExpQ)-import Language.Haskell.TH.Syntax (Lift(..))-import Unsafe.Coerce (unsafeCoerce)--import CLaSH.Promoted.Nat---- | Fixed size vectors------ * Lists with their length encoded in their type--- * 'Vec'tor elements have a DESCENDING subscript starting from 'maxIndex'--- ('vlength' - 1) and ending at 0------ >>> (3:>4:>5:>Nil)--- <3,4,5>--- >>> :t (3:>4:>5:>Nil)--- (3:>4:>5:>Nil) :: Num a => Vec 3 a-data Vec :: Nat -> * -> * where- Nil :: Vec 0 a- (:>) :: a -> Vec n a -> Vec (n + 1) a--infixr 5 :>--instance Show a => Show (Vec n a) where- show vs = "<" ++ punc vs ++ ">"- where- punc :: Show a => Vec m a -> String- punc Nil = ""- punc (x :> Nil) = show x- punc (x :> xs) = show x ++ "," ++ punc xs--instance Eq a => Eq (Vec n a) where- v1 == v2 = vfoldr (&&) True (vzipWith (==) v1 v2)--instance KnownNat n => Applicative (Vec n) where- pure = vcopyI- (<*>) = vzipWith ($)---- instance Traversable (Vec n) where--- traverse _ Nil = pure Nil--- traverse f (x :> xs) = (:>) <$> f x <*> traverse f xs--instance Foldable (Vec n) where- foldr = vfoldr--instance Functor (Vec n) where- fmap = vmap--instance (Default a, KnownNat n) => Default (Vec n a) where- def = vcopyI def--{-# NOINLINE vhead #-}--- | Extract the first element of a vector------ >>> vhead (1:>2:>3:>Nil)--- 1--- >>> vhead Nil--- <interactive>--- Couldn't match type ‘1’ with ‘0’--- Expected type: Vec (0 + 1) a--- Actual type: Vec 0 a--- In the first argument of ‘vhead’, namely ‘Nil’--- In the expression: vhead Nil-vhead :: Vec (n + 1) a -> a-vhead (x :> _) = x--{-# NOINLINE vtail #-}--- | Extract the elements after the head of a vector------ >>> vtail (1:>2:>3:>Nil)--- <2,3>--- >>> vtail Nil--- <interactive>--- Couldn't match type ‘1’ with ‘0’--- Expected type: Vec (0 + 1) a--- Actual type: Vec 0 a--- In the first argument of ‘vtail’, namely ‘Nil’--- In the expression: vtail Nil-vtail :: Vec (n + 1) a -> Vec n a-vtail (_ :> xs) = unsafeCoerce xs--{-# NOINLINE vlast #-}--- | Extract the last element of a vector------ >>> vlast (1:>2:>3:>Nil)--- 3--- >>> vlast Nil--- <interactive>--- Couldn't match type ‘1’ with ‘0’--- Expected type: Vec (0 + 1) a--- Actual type: Vec 0 a--- In the first argument of ‘vlast’, namely ‘Nil’--- In the expression: vlast Nil-vlast :: Vec (n + 1) a -> a-vlast (x :> Nil) = x-vlast (_ :> y :> ys) = vlast (y :> ys)--{-# NOINLINE vinit #-}--- | Extract all the elements of a vector except the last element------ >>> vinit (1:>2:>3:>Nil)--- <1,2>--- >>> vinit Nil--- <interactive>--- Couldn't match type ‘1’ with ‘0’--- Expected type: Vec (0 + 1) a--- Actual type: Vec 0 a--- In the first argument of ‘vinit’, namely ‘Nil’--- In the expression: vinit Nil-vinit :: Vec (n + 1) a -> Vec n a-vinit (_ :> Nil) = unsafeCoerce Nil-vinit (x :> y :> ys) = unsafeCoerce (x :> vinit (y :> ys))--{-# NOINLINE shiftIntoL #-}--- | Add an element to the head of the vector, and extract all elements of the--- resulting vector except the last element-shiftIntoL :: a -> Vec n a -> Vec n a-shiftIntoL _ Nil = Nil-shiftIntoL s (x :> xs) = s :> (vinit (x:>xs))--infixr 4 +>>-{-# INLINEABLE (+>>) #-}--- | Add an element to the head of the vector, and extract all elements of the--- resulting vector except the last element------ >>> 1 +>> (3:>4:>5:>Nil)--- <1,3,4>--- >>> 1 +>> Nil--- <>-(+>>) :: a -> Vec n a -> Vec n a-s +>> xs = shiftIntoL s xs--{-# NOINLINE snoc #-}--- | Add an element to the tail of the vector-snoc :: a -> Vec n a -> Vec (n + 1) a-snoc s Nil = s :> Nil-snoc s (x :> xs) = x :> (snoc s xs)--infixl 5 <:-{-# INLINEABLE (<:) #-}--- | Add an element to the tail of the vector------ >>> (3:>4:>5:>Nil) <: 1--- <3,4,5,1>--- >>> :t (3:>4:>5:>Nil) <: 1--- (3:>4:>5:>Nil) <: 1 :: Num a => Vec 4 a-(<:) :: Vec n a -> a -> Vec (n + 1) a-xs <: s = snoc s xs--{-# NOINLINE shiftIntoR #-}--- | Add an element to the tail of the vector, and extract all elements of the--- resulting vector except the first element-shiftIntoR :: a -> Vec n a -> Vec n a-shiftIntoR _ Nil = Nil-shiftIntoR s (x:>xs) = snoc s (vtail (x:>xs))--infixl 4 <<+-{-# INLINE (<<+) #-}--- | Add an element to the tail of the vector, and extract all elements of the--- resulting vector except the first element------ >>> (3:>4:>5:>Nil) <<+ 1--- <4,5,1>--- >>> Nil <<+ 1--- <>-(<<+) :: Vec n a -> a -> Vec n a-xs <<+ s = shiftIntoR s xs--{-# NOINLINE vappend #-}--- | Append two vectors-vappend :: Vec n a -> Vec m a -> Vec (n + m) a-vappend Nil ys = ys-vappend (x :> xs) ys = unsafeCoerce (x :> (vappend xs ys))--infixr 5 <++>-{-# INLINE (<++>) #-}--- | Append two vectors------ >>> (1:>2:>3:>Nil) <++> (7:>8:>Nil)--- <1,2,3,7,8>-(<++>) :: Vec n a -> Vec m a -> Vec (n + m) a-xs <++> ys = vappend xs ys--{-# NOINLINE vsplit #-}--- | Split a vector into two vectors at the given point------ >>> vsplit (snat :: SNat 3) (1:>2:>3:>7:>8:>Nil)--- (<1,2,3>, <7,8>)--- >>> vsplit d3 (1:>2:>3:>7:>8:>Nil)--- (<1,2,3>, <7,8>)-vsplit :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)-vsplit n xs = vsplitU (toUNat n) xs--vsplitU :: UNat m -> Vec (m + n) a -> (Vec m a, Vec n a)-vsplitU UZero ys = (Nil,ys)-vsplitU (USucc s) (y :> ys) = let (as,bs) = vsplitU s (unsafeCoerce ys)- in (y :> as, bs)--{-# INLINEABLE vsplitI #-}--- | Split a vector into two vectors where the length of the two is determined--- by the context------ >>> vsplitI (1:>2:>3:>7:>8:>Nil) :: (Vec 2 Int, Vec 3 Int)--- (<1,2>,<3,7,8>)-vsplitI :: KnownNat m => Vec (m + n) a -> (Vec m a, Vec n a)-vsplitI = withSNat vsplit--{-# NOINLINE vconcat #-}--- | Concatenate a vector of vectors------ >>> vconcat ((1:>2:>3:>Nil) :> (4:>5:>6:>Nil) :> (7:>8:>9:>Nil) :> (10:>11:>12:>Nil) :> Nil)--- <1,2,3,4,5,6,7,8,9,10,11,12>-vconcat :: Vec n (Vec m a) -> Vec (n * m) a-vconcat Nil = Nil-vconcat (x :> xs) = unsafeCoerce (vappend x (vconcat xs))--{-# NOINLINE vunconcat #-}--- | Split a vector of (n * m) elements into a vector of vectors with length m,--- where m is given------ >>> vunconcat d4 (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil)--- <<1,2,3,4>,<5,6,7,8>,<9,10,11,12>>-vunconcat :: KnownNat n => SNat m -> Vec (n * m) a -> Vec n (Vec m a)-vunconcat n xs = vunconcatU (withSNat toUNat) (toUNat n) xs--vunconcatU :: UNat n -> UNat m -> Vec (n * m) a -> Vec n (Vec m a)-vunconcatU UZero _ _ = Nil-vunconcatU (USucc n') m ys = let (as,bs) = vsplitU m (unsafeCoerce ys)- in as :> vunconcatU n' m bs--{-# INLINEABLE vunconcatI #-}--- | Split a vector of (n * m) elements into a vector of vectors with length m,--- where m is determined by the context------ >>> vunconcatI (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil) :: Vec 2 (Vec 6 Int)--- <<1,2,3,4,5,6>,<7,8,9,10,11,12>>-vunconcatI :: (KnownNat n, KnownNat m) => Vec (n * m) a -> Vec n (Vec m a)-vunconcatI = withSNat vunconcat--{-# NOINLINE vmerge #-}--- | Merge two vectors, alternating their elements, i.e.,------ >>> vmerge (1 :> 2 :> 3 :> 4 :> Nil) (5 :> 6 :> 7 :> 8 :> Nil)--- <1,5,2,6,3,7,4,8>-vmerge :: Vec n a -> Vec n a -> Vec (n + n) a-vmerge Nil Nil = Nil-vmerge (x :> xs) (y :> ys) = unsafeCoerce (x :> y :> (vmerge xs (unsafeCoerce ys)))--{-# NOINLINE vreverse #-}--- | Returns the elements in a vector in reverse order------ >>> vreverse (1:>2:>3:>4:>Nil)--- <4,3,2,1>-vreverse :: Vec n a -> Vec n a-vreverse Nil = Nil-vreverse (x :> xs) = vreverse xs <: x--{-# NOINLINE vmap #-}--- | 'vmap' @f xs@ is the vector obtained by applying @f@ to each element--- of @xs@, i.e.,------ > vmap f (xn :> ... :> x2 :> x1 :> Nil) == (f xn :> ... :> f x2 :> f x1 :> Nil)-vmap :: (a -> b) -> Vec n a -> Vec n b-vmap _ Nil = Nil-vmap f (x :> xs) = f x :> vmap f xs--{-# NOINLINE vzipWith #-}--- | 'vzipWith' generalises 'vzip' by zipping with the function given--- as the first argument, instead of a tupling function.--- For example, @'vzipWith' (+)@ is applied to two vectors to produce the--- vector of corresponding sums.------ > vzipWith f (xn :> ... :> x2 :> x1 :> Nil) (yn :> ... :> y2 :> y1 :> Nil) == (f xn yn :> ... :> f x2 y2 :> f x1 y1 :> Nil)-vzipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c-vzipWith _ Nil Nil = Nil-vzipWith f (x :> xs) (y :> ys) = f x y :> (vzipWith f xs (unsafeCoerce ys))--{-# NOINLINE vfoldr #-}--- | 'vfoldr', applied to a binary operator, a starting value (typically--- the right-identity of the operator), and a vector, reduces the vector--- using the binary operator, from right to left:------ > vfoldr f z (xn :> ... :> x2 :> x1 :> Nil) == xn `f` (... (x2 `f` (x1 `f` z))...)--- > vfoldr r z Nil == z-vfoldr :: (a -> b -> b) -> b -> Vec n a -> b-vfoldr _ z Nil = z-vfoldr f z (x :> xs) = f x (vfoldr f z xs)--{-# NOINLINE vfoldl #-}--- | 'vfoldl', applied to a binary operator, a starting value (typically--- the left-identity of the operator), and a vector, reduces the vector--- using the binary operator, from left to right:------ > vfoldl f z (xn :> ... :> x2 :> x1 :> Nil) == (...((z `f` xn)... `f` x2) `f` x1--- > vfoldl f z Nil == z-vfoldl :: (b -> a -> b) -> b -> Vec n a -> b-vfoldl _ z Nil = z-vfoldl f z (x :> xs) = vfoldl f (f z x) xs--{-# NOINLINE vfoldr1 #-}--- | 'vfoldr1' is a variant of 'vfoldr' that has no starting value argument,--- and thus must be applied to non-empty vectors.------ > vfoldr1 f (xn :> ... :> x3 :> x2 :> x1 :> Nil) == xn `f` (... (x3 `f` (x2 `f` x1))...)--- > vfoldr1 f (x1 :> Nil) == x1--- > vfoldr1 f Nil == TYPE ERROR-vfoldr1 :: (a -> a -> a) -> Vec (n + 1) a -> a-vfoldr1 _ (x :> Nil) = x-vfoldr1 f (x :> (y :> ys)) = f x (vfoldr1 f (y :> ys))--{-# INLINEABLE vfoldl1 #-}--- | 'vfoldl1' is a variant of 'vfoldl' that has no starting value argument,--- and thus must be applied to non-empty vectors.------ > vfoldl f (xn :> xn1 :> ... :> x2 :> x1 :> Nil) == (...((xn `f` xn1)... `f` x2) `f` x1--- > vfoldl f (x1 :> Nil) == x1--- > vfoldl f Nil == TYPE ERROR-vfoldl1 :: (a -> a -> a) -> Vec (n + 1) a -> a-vfoldl1 f xs = vfoldl f (vhead xs) (vtail xs)--{-# INLINEABLE vscanl #-}-vscanl :: KnownNat n => (b -> a -> b) -> b -> Vec n a -> Vec (n + 1) b-vscanl f z xs = ws- where- ws = z :> vzipWith f (lazyV (vinit ws)) xs--{-# INLINEABLE vscanl1 #-}-vscanl1 :: KnownNat n => (a -> a -> a) -> Vec n a -> Vec n a-vscanl1 f xs = vinit (vscanl f (vhead xs') (vtail xs'))- where- xs' = xs <: undefined--{-# INLINEABLE vscanr #-}-vscanr :: KnownNat n => (a -> b -> b) -> b -> Vec n a -> Vec (n + 1) b-vscanr f z xs = ws- where- ws = vzipWith f xs (lazyV (vtail ws)) <: z--{-# INLINEABLE vscanr1 #-}-vscanr1 :: KnownNat n => (a -> a -> a) -> Vec n a -> Vec n a-vscanr1 f xs = vtail (vscanr f (vlast xs') (vinit xs'))- where- xs' = undefined :> xs--{-# INLINEABLE vmapAccumL #-}-vmapAccumL :: KnownNat n => (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc,Vec n y)-vmapAccumL f acc xs = (acc',ys)- where- ws = vscanl (\l r -> f (fst l) r) (acc,undefined) xs- acc' = fst (vlast ws)- ys = vmap snd (vtail ws)--{-# INLINEABLE vmapAccumR #-}-vmapAccumR :: KnownNat n => (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc, Vec n y)-vmapAccumR f acc xs = (acc',ys)- where- ws = vscanr (\l r -> f (fst r) l) (acc,undefined) xs- acc' = fst (vhead ws)- ys = vmap snd (vinit ws)--{-# INLINEABLE vzip #-}--- | 'vzip' takes two vectors and returns a vector of corresponding pairs.------ >>> vzip (1:>2:>3:>4:>Nil) (4:>3:>2:>1:>Nil)--- <(1,4),(2,3),(3,2),(4,1)>-vzip :: Vec n a -> Vec n b -> Vec n (a,b)-vzip = vzipWith (,)--{-# INLINEABLE vunzip #-}--- | 'vunzip' transforms a vector of pairs into a vector of first components--- and a vector of second components.------ >>> vunzip ((1,4):>(2,3):>(3,2):>(4,1):>Nil)--- (<1,2,3,4>,<4,3,2,1>)-vunzip :: Vec n (a,b) -> (Vec n a, Vec n b)-vunzip xs = (vmap fst xs, vmap snd xs)--{-# NOINLINE vindexM_integer #-}-vindexM_integer :: Vec n a -> Integer -> Maybe a-vindexM_integer Nil _ = Nothing-vindexM_integer (x :> _) 0 = Just x-vindexM_integer (_ :> xs) n = vindexM_integer xs (n-1)--{-# NOINLINE vindex_integer #-}-vindex_integer :: KnownNat n => Vec n a -> Integer -> a-vindex_integer xs i = case vindexM_integer xs (maxIndex xs - i) of- Just a -> a- Nothing -> error ("(!): Index " ++ show i ++ " is out of bounds 0 and " ++ show (maxIndex xs))--{-# INLINEABLE (!) #-}--- | Vector index (subscript) operator, DESCENDING from 'maxIndex', where the--- last element has subscript 0.------ >>> (1:>2:>3:>4:>5:>Nil) ! 4--- 1--- >>> (1:>2:>3:>4:>5:>Nil) ! maxIndex--- 1--- >>> (1:>2:>3:>4:>5:>Nil) ! 1--- 4--- >>> (1:>2:>3:>4:>5:>Nil) ! 14--- *** Exception: index out of bounds-(!) :: (KnownNat n, Integral i) => Vec n a -> i -> a-xs ! i = vindex_integer xs (toInteger i)--{-# NOINLINE maxIndex #-}--- | Index (subscript) of the head of the 'Vec'tor------ >>> maxIndex (6 :> 7 :> 8 :> Nil)--- 2-maxIndex :: KnownNat n => Vec n a -> Integer-maxIndex = subtract 1 . vlength--{-# NOINLINE vlength #-}--- | Length of a 'Vec'tor as an Integer------ >>> vlength (6 :> 7 :> 8 :> Nil)--- 3-vlength :: KnownNat n => Vec n a -> Integer-vlength = natVal . asNatProxy--{-# NOINLINE vreplaceM_integer #-}-vreplaceM_integer :: Vec n a -> Integer -> a -> Maybe (Vec n a)-vreplaceM_integer Nil _ _ = Nothing-vreplaceM_integer (_ :> xs) 0 y = Just (y :> xs)-vreplaceM_integer (x :> xs) n y = case vreplaceM_integer xs (n-1) y of- Just xs' -> Just (x :> xs')- Nothing -> Nothing--{-# NOINLINE vreplace_integer #-}-vreplace_integer :: KnownNat n => Vec n a -> Integer -> a -> Vec n a-vreplace_integer xs i a = case vreplaceM_integer xs (maxIndex xs - i) a of- Just ys -> ys- Nothing -> error ("vreplace: Index " ++ show i ++ " is out of bounds 0 and " ++ show (maxIndex xs))--{-# INLINEABLE vreplace #-}--- | Replace an element of a vector at the given index (subscript).------ NB: vector elements have a descending subscript starting from 'maxIndex' and--- ending at 0------ >>> vreplace (1:>2:>3:>4:>5:>Nil) 3 7--- <1,7,3,4,5>--- >>> vreplace (1:>2:>3:>4:>5:>Nil) 0 7--- <1,2,3,4,7>--- >>> vreplace (1:>2:>3:>4:>5:>Nil) 9 7--- <*** Exception: index out of bounds-vreplace :: (KnownNat n, Integral i) => Vec n a -> i -> a -> Vec n a-vreplace xs i y = vreplace_integer xs (toInteger i) y--{-# NOINLINE vtake #-}--- | 'vtake' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@------ >>> vtake (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil)--- <1,2,3>--- >>> vtake d3 (1:>2:>3:>4:>5:>Nil)--- <1,2,3>--- >>> vtake d0 (1:>2:>Nil)--- <>--- >>> vtake d4 (1:>2:>Nil)--- <interactive>--- Couldn't match type ‘4 + n0’ with ‘2’--- The type variable ‘n0’ is ambiguous--- Expected type: Vec (4 + n0) a--- Actual type: Vec (1 + 1) a--- In the second argument of ‘vtake’, namely ‘(1 :> 2 :> Nil)’--- In the expression: vtake d4 (1 :> 2 :> Nil)--- In an equation for ‘it’: it = vtake d4 (1 :> 2 :> Nil)-vtake :: SNat m -> Vec (m + n) a -> Vec m a-vtake n = fst . vsplit n--{-# INLINEABLE vtakeI #-}--- | 'vtakeI' @xs@, returns the prefix of @xs@ as demanded by the context------ >>> vtakeI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int--- <1,2>-vtakeI :: KnownNat m => Vec (m + n) a -> Vec m a-vtakeI = withSNat vtake--{-# NOINLINE vdrop #-}--- | 'vdrop' @n xs@ returns the suffix of @xs@ after the first @n@ elements------ >>> vdrop (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil)--- <4,5>--- >>> vdrop d3 (1:>2:>3:>4:>5:>Nil)--- <4,5>--- >>> vdrop d0 (1:>2:>Nil)--- <1,2>--- >>> vdrop d4 (1:>2:>Nil)--- <interactive>--- Couldn't match expected type ‘2’ with actual type ‘4 + n0’--- The type variable ‘n0’ is ambiguous--- In the first argument of ‘print’, namely ‘it’--- In a stmt of an interactive GHCi command: print it-vdrop :: SNat m -> Vec (m + n) a -> Vec n a-vdrop n = snd . vsplit n--{-# INLINEABLE vdropI #-}--- | 'vdropI' @xs@, returns the suffix of @xs@ as demanded by the context------ >>> vdropI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int--- <4,5>-vdropI :: KnownNat m => Vec (m + n) a -> Vec n a-vdropI = withSNat vdrop--{-# NOINLINE vexact #-}--- | 'vexact' @n xs@ returns @n@'th element of @xs@------ NB: vector elements have a descending subscript starting from 'maxIndex' and--- ending at 0------ >>> vexact (snat :: SNat 1) (1:>2:>3:>4:>5:>Nil)--- 4--- >>> vexact d1 (1:>2:>3:>4:>5:>Nil)--- 4-vexact :: SNat m -> Vec (m + (n + 1)) a -> a-vexact n xs = vhead $ snd $ vsplit n (vreverse xs)--{-# NOINLINE vselect #-}--- | 'vselect' @f s n xs@ selects @n@ elements with stepsize @s@ and--- offset @f@ from @xs@------ >>> vselect (snat :: SNat 1) (snat :: SNat 2) (snat :: SNat 3) (1:>2:>3:>4:>5:>6:>7:>8:>Nil)--- <2,4,6>--- >>> vselect d1 d2 d3 (1:>2:>3:>4:>5:>6:>7:>8:>Nil)--- <2,4,6>-vselect :: ((f + (s * n) + 1) <= i)- => SNat f- -> SNat s- -> SNat (n + 1)- -> Vec i a- -> Vec (n + 1) a-vselect f s n xs = vselect' (toUNat n) $ vdrop f (unsafeCoerce xs)- where- vselect' :: UNat n -> Vec m a -> Vec n a- vselect' UZero _ = Nil- vselect' (USucc n') vs@(x :> _) = x :> vselect' n' (vdrop s (unsafeCoerce vs))--{-# INLINEABLE vselectI #-}--- | 'vselectI' @f s xs@ selects as many elements as demanded by the context--- with stepsize @s@ and offset @f@ from @xs@------ >>> vselectI d1 d2 (1:>2:>3:>4:>5:>6:>7:>8:>Nil) :: Vec 2 Int--- <2,4>-vselectI :: ((f + (s * n) + 1) <= i, KnownNat (n + 1))- => SNat f- -> SNat s- -> Vec i a- -> Vec (n + 1) a-vselectI f s xs = withSNat (\n -> vselect f s n xs)--{-# NOINLINE vcopy #-}--- | 'vcopy' @n a@ returns a vector that has @n@ copies of @a@------ >>> vcopy (snat :: SNat 3) 6--- <6,6,6>--- >>> vcopy d3 6--- <6,6,6>-vcopy :: SNat n -> a -> Vec n a-vcopy n a = vreplicateU (toUNat n) a--vreplicateU :: UNat n -> a -> Vec n a-vreplicateU UZero _ = Nil-vreplicateU (USucc s) x = x :> vreplicateU s x--{-# INLINEABLE vcopyI #-}--- | 'vcopyI' @a@ creates a vector with as many copies of @a@ as demanded by the--- context------ >>> vcopy 6 :: Vec 5 Int--- <6,6,6,6,6>-vcopyI :: KnownNat n => a -> Vec n a-vcopyI = withSNat vcopy--{-# NOINLINE viterate #-}--- | 'viterate' @n f x@ returns a vector starting with @x@ followed by @n@--- repeated applications of @f@ to @x@------ > viterate (snat :: SNat 4) f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil)--- > viterate d4 f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil)-viterate :: SNat n -> (a -> a) -> a -> Vec n a-viterate n f a = viterateU (toUNat n) f a--viterateU :: UNat n -> (a -> a) -> a -> Vec n a-viterateU UZero _ _ = Nil-viterateU (USucc s) g x = x :> viterateU s g (g x)--{-# INLINEABLE viterateI #-}--- | 'viterate' @f x@ returns a vector starting with @x@ followed by @n@--- repeated applications of @f@ to @x@, where @n@ is determined by the context------ > viterateI f x :: Vec 3 a == (x :> f x :> f (f x) :> Nil)-viterateI :: KnownNat n => (a -> a) -> a -> Vec n a-viterateI = withSNat viterate--{-# INLINEABLE vgenerate #-}--- | 'vgenerate' @n f x@ returns a vector with @n@ repeated applications of @f@--- to @x@------ > vgenerate (snat :: SNat 4) f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil)--- > vgenerate d4 f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil)-vgenerate :: SNat n -> (a -> a) -> a -> Vec n a-vgenerate n f a = viterate n f (f a)--{-# INLINEABLE vgenerateI #-}--- | 'vgenerate' @f x@ returns a vector with @n@ repeated applications of @f@--- to @x@, where @n@ is determined by the context------ > vgenerateI f x :: Vec 3 a == (f x :> f (f x) :> f (f (f x)) :> Nil)-vgenerateI :: KnownNat n => (a -> a) -> a -> Vec n a-vgenerateI = withSNat vgenerate--{-# INLINEABLE toList #-}--- | Convert a vector to a list------ >>> toList (1:>2:>3:>Nil)--- [1,2,3]-toList :: Vec n a -> [a]-toList = vfoldr (:) []---- | Create a vector literal from a list literal------ > $(v [1::Signed 8,2,3,4,5]) == (8:>2:>3:>4:>5:>Nil) :: Vec 5 (Signed 8)------ >>> [1 :: Signed 8,2,3,4,5]--- [1,2,3,4,5]--- >>> $(v [1::Signed 8,2,3,4,5])--- <1,2,3,4,5>-v :: Lift a => [a] -> ExpQ-v [] = [| Nil |]-v (x:xs) = [| x :> $(v xs) |]---- | 'Vec'tor as a 'Proxy' for 'Nat'-asNatProxy :: Vec n a -> Proxy n-asNatProxy _ = Proxy--{-# NOINLINE lazyV #-}--- | For when your vector functions are too strict in their arguments------ For example:------ > -- Bubble sort for 1 iteration--- > sortV xs = vmap fst sorted <: (snd (vlast sorted))--- > where--- > lefts = vhead xs :> vmap snd (vinit sorted)--- > rights = vtail xs--- > sorted = vzipWith compareSwapL lefts rights--- >--- > -- Compare and swap--- > compareSwapL a b = if a < b then (a,b)--- > else (b,a)------ Will not terminate because 'vzipWith' is too strict in its second argument:------ >>> sortV (4 :> 1 :> 2 :> 3 :> Nil)--- <*** Exception: <<loop>>------ In this case, adding 'lazyV' on 'vzipWith's second argument:------ > sortVL xs = vmap fst sorted <: (snd (vlast sorted))--- > where--- > lefts = vhead xs :> vmap snd (vinit sorted)--- > rights = vtail xs--- > sorted = vzipWith compareSwapL (lazyV lefts) rights------ Results in a successful computation:------ >>> sortVL (4 :> 1 :> 2 :> 3 :> Nil)--- <1,2,3,4>-lazyV :: KnownNat n- => Vec n a- -> Vec n a-lazyV = lazyV' (vcopyI undefined)- where- lazyV' :: Vec n a -> Vec n a -> Vec n a- lazyV' Nil _ = Nil- lazyV' (_ :> xs) ys = vhead ys :> lazyV' xs (vtail ys)--{-# NOINLINE vhead' #-}--- | Same as 'vhead', but with a "@(1 <= n)@" constraint and "@Vec n a@" argument,--- instead of a "@Vec (n + 1) a@" argument-vhead' :: (1 <= n)- => Vec n a- -> a-vhead' (x :> _) = x+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module CLaSH.Sized.Vector+ ( -- * 'Vec'tor constructors+ Vec(..), (<:), singleton+ -- * Standard 'Vec'tor functions+ -- ** Extracting sub-'Vec'tors+ , head, tail, last, init+ , take, takeI, drop, dropI, exact, select, selectI+ -- ** Combining 'Vec'tors+ , (++), (+>>), (<<+), concat, zip, unzip, shiftInAt0, shiftInAtN+ , shiftOutFrom0, shiftOutFromN+ -- ** Splitting 'Vec'tors+ , splitAt, splitAtI, unconcat, unconcatI, merge+ -- ** Applying functions to 'Vec'tor elements+ , map, zipWith+ , foldr, foldl, foldr1, foldl1, fold+ , scanl, scanr, sscanl, sscanr+ , mapAccumL, mapAccumR+ -- ** Indexing 'Vec'tors+ , (!!), replace, maxIndex, length+ -- ** Generating 'Vec'tors+ , replicate, repeat, iterate, iterateI, generate, generateI+ -- ** Misc+ , reverse, toList, v, lazyV, asNatProxy+ -- ** Functions for the 'CLaSH.Class.BitPack.BitPack' instance+ , concatBitVector#+ , unconcatBitVector#+ )+where++import Control.Applicative (Applicative (..), (<$>))+import Data.Default (Default (..))+import qualified Data.Foldable as F+import Data.Proxy (Proxy (..))+import Data.Traversable (Traversable (..))+import GHC.TypeLits (CmpNat, KnownNat, Nat, type (+), type (*),+ natVal)+import Language.Haskell.TH (ExpQ)+import Language.Haskell.TH.Syntax (Lift(..))+import Prelude hiding ((++), (!!), concat, drop, foldl,+ foldl1, foldr, foldr1, head, init,+ iterate, last, length, map, repeat,+ replicate, reverse, scanl, scanr,+ splitAt, tail, take, unzip, zip,+ zipWith)+import qualified Prelude as P+import Unsafe.Coerce (unsafeCoerce)++import CLaSH.Promoted.Nat (SNat (..), UNat (..), withSNat, toUNat)+import CLaSH.Sized.Internal.BitVector (BitVector, (++#), split#)++-- | Fixed size vectors+--+-- * Lists with their length encoded in their type+-- * 'Vec'tor elements have an __ASCENDING__ subscript starting from 0 and+-- ending at 'maxIndex' (== 'length' - 1).+--+-- >>> (3:>4:>5:>Nil)+-- <3,4,5>+-- >>> :t (3:>4:>5:>Nil)+-- (3:>4:>5:>Nil) :: Num a => Vec 3 a+data Vec :: Nat -> * -> * where+ Nil :: Vec 0 a+ (:>) :: a -> Vec n a -> Vec (n + 1) a++infixr 5 :>++instance Show a => Show (Vec n a) where+ show vs = "<" P.++ punc vs P.++ ">"+ where+ punc :: Show a => Vec m a -> String+ punc Nil = ""+ punc (x :> Nil) = show x+ punc (x :> xs) = show x P.++ "," P.++ punc xs++instance Eq a => Eq (Vec n a) where+ (==) = eq#+ (/=) = neq#++{-# NOINLINE eq# #-}+eq# :: Eq a => Vec n a -> Vec n a -> Bool+eq# v1 v2 = foldr (&&) True (zipWith (==) v1 v2)++{-# NOINLINE neq# #-}+neq# :: Eq a => Vec n a -> Vec n a -> Bool+neq# v1 v2 = not (eq# v1 v2)++-- | __NB__: Not synthesisable+instance KnownNat n => Applicative (Vec n) where+ pure = repeat+ fs <*> xs = zipWith ($) fs xs++instance F.Foldable (Vec n) where+ foldr = foldr++instance Functor (Vec n) where+ fmap = map++-- | __NB__: Not synthesisable+instance Traversable (Vec n) where+ traverse = traverse#++{-# NOINLINE traverse# #-}+traverse# :: Applicative f => (a -> f b) -> Vec n a -> f (Vec n b)+traverse# _ Nil = pure Nil+traverse# f (x :> xs) = (:>) <$> f x <*> traverse# f xs++instance (Default a, KnownNat n) => Default (Vec n a) where+ def = repeat def++{-# INLINE singleton #-}+-- | Create a vector of one element+--+-- >>> singleton 5+-- <5>+singleton :: a -> Vec 1 a+singleton = (:> Nil)++{-# NOINLINE head #-}+-- | Extract the first element of a vector+--+-- >>> head (1:>2:>3:>Nil)+-- 1+-- >>> head Nil+-- <interactive>+-- Couldn't match type ‘1’ with ‘0’+-- Expected type: Vec (0 + 1) a+-- Actual type: Vec 0 a+-- In the first argument of ‘vhead’, namely ‘Nil’+-- In the expression: vhead Nil+head :: Vec (n + 1) a -> a+head (x :> _) = x++{-# NOINLINE tail #-}+-- | Extract the elements after the head of a vector+--+-- >>> tail (1:>2:>3:>Nil)+-- <2,3>+-- >>> tail Nil+-- <interactive>+-- Couldn't match type ‘1’ with ‘0’+-- Expected type: Vec (0 + 1) a+-- Actual type: Vec 0 a+-- In the first argument of ‘vtail’, namely ‘Nil’+-- In the expression: vtail Nil+tail :: Vec (n + 1) a -> Vec n a+tail (_ :> xs) = unsafeCoerce xs++{-# NOINLINE last #-}+-- | Extract the last element of a vector+--+-- >>> last (1:>2:>3:>Nil)+-- 3+-- >>> last Nil+-- <interactive>+-- Couldn't match type ‘1’ with ‘0’+-- Expected type: Vec (0 + 1) a+-- Actual type: Vec 0 a+-- In the first argument of ‘vlast’, namely ‘Nil’+-- In the expression: vlast Nil+last :: Vec (n + 1) a -> a+last (x :> Nil) = x+last (_ :> y :> ys) = last (y :> ys)++{-# NOINLINE init #-}+-- | Extract all the elements of a vector except the last element+--+-- >>> init (1:>2:>3:>Nil)+-- <1,2>+-- >>> init Nil+-- <interactive>+-- Couldn't match type ‘1’ with ‘0’+-- Expected type: Vec (0 + 1) a+-- Actual type: Vec 0 a+-- In the first argument of ‘vinit’, namely ‘Nil’+-- In the expression: vinit Nil+init :: Vec (n + 1) a -> Vec n a+init (_ :> Nil) = unsafeCoerce Nil+init (x :> y :> ys) = unsafeCoerce (x :> init (y :> ys))++{-# INLINE shiftInAt0 #-}+-- | Shift in elements to the head of a vector, bumping out elements at the+-- tail. The result is a tuple containing:+--+-- * The new vector+-- * The shifted out elements+--+-- >>> shiftInAt0 (1 :> 2 :> 3 :> 4 :> Nil) ((-1) :> 0 :> Nil)+-- (<-1,0,1,2,>,<3,4>)+-- >>> shiftInAt0 (1 :> Nil) ((-1) :> 0 :> Nil)+-- (<-1>,<0,1>)+shiftInAt0 :: KnownNat n+ => Vec n a -- ^ The old vector+ -> Vec m a -- ^ The elements to shift in at the head+ -> (Vec n a, Vec m a) -- ^ (The new vector, shifted out elements)+shiftInAt0 xs ys = splitAtI (unsafeCoerce zs)+ where+ zs = ys ++ xs++{-# INLINE shiftInAtN #-}+-- | Shift in element to the tail of a vector, bumping out elements at the head.+-- The result is a tuple containing:+--+-- * The new vector+-- * The shifted out elements+--+-- >>> shiftInAtN (1 :> 2 :> 3 :> 4 :> Nil) (5 :> 6 :> Nil)+-- (<3,4,5,6>,<1,2>)+-- >>> shiftInAtN (1 :> Nil) (2 :> 3 :> Nil)+-- (<3>,<1,2>)+shiftInAtN :: KnownNat m+ => Vec n a -- ^ The old vector+ -> Vec m a -- ^ The elements to shift in at the tail+ -> (Vec n a,Vec m a) -- ^ (The new vector, shifted out elements)+shiftInAtN xs ys = (zsR, zsL)+ where+ zs = xs ++ ys+ (zsL,zsR) = splitAtI (unsafeCoerce zs)++infixl 5 <:+{-# INLINE (<:) #-}+-- | Add an element to the tail of a vector.+--+-- >>> (3:>4:>5:>Nil) <: 1+-- <3,4,5,1>+-- >>> :t (3:>4:>5:>Nil) <: 1+-- (3:>4:>5:>Nil) <: 1 :: Num a => Vec 4 a+(<:) :: Vec n a -> a -> Vec (n + 1) a+xs <: x = xs ++ singleton x++infixr 4 +>>+{-# INLINE (+>>) #-}+-- | Add an element to the head of a vector, and extract all but the last+-- element.+--+-- >>> 1 +>> (3:>4:>5:>Nil)+-- <1,3,4>+-- >>> 1 +>> Nil+-- <>+(+>>) :: KnownNat n => a -> Vec n a -> Vec n a+s +>> xs = fst (shiftInAt0 xs (singleton s))++infixl 4 <<++{-# INLINE (<<+) #-}+-- | Add an element to the tail of a vector, and extract all but the first+-- element.+--+-- >>> (3:>4:>5:>Nil) <<+ 1+-- <4,5,1>+-- >>> Nil <<+ 1+-- <>+(<<+) :: KnownNat n => Vec n a -> a -> Vec n a+xs <<+ s = fst (shiftInAtN xs (singleton s))++{-# INLINE shiftOutFrom0 #-}+-- | Shift @m@ elements out from the head of a vector, filling up the tail with+-- 'Default' values. The result is a tuple containing:+--+-- * The new vector+-- * The shifted out values+--+-- >>> shiftOutFrom0 d2 ((1 :> 2 :> 3 :> 4 :> 5 :> Nil) :: Vec 5 Integer)+-- (<3,4,5,0,0>,<1,2>)+shiftOutFrom0 :: (Default a, KnownNat m)+ => SNat m -- ^ @m@, the number of elements to shift out+ -> Vec (m + n) a -- ^ The old vector+ -> (Vec (m + n) a, Vec m a)+ -- ^ (The new vector, shifted out elements)+shiftOutFrom0 m xs = shiftInAtN xs (replicate m def)++{-# INLINE shiftOutFromN #-}+-- | Shift @m@ elements out from the tail of a vector, filling up the head with+-- 'Default' values. The result is a tuple containing:+--+-- * The new vector+-- * The shifted out values+--+-- >>> shiftOutFromN d2 ((1 :> 2 :> 3 :> 4 :> 5 :> Nil) :: Vec 5 Integer)+-- (<0,0,1,2,3>,<4,5>)+shiftOutFromN :: (Default a, KnownNat (m + n))+ => SNat m -- ^ @m@, the number of elements to shift out+ -> Vec (m + n) a -- ^ The old vector+ -> (Vec (m + n) a, Vec m a)+ -- ^ (The new vector, shifted out elements)+shiftOutFromN m xs = shiftInAt0 xs (replicate m def)++infixr 5 +++{-# NOINLINE (++) #-}+-- | Append two vectors+--+-- >>> (1:>2:>3:>Nil) ++ (7:>8:>Nil)+-- <1,2,3,7,8>+(++) :: Vec n a -> Vec m a -> Vec (n + m) a+Nil ++ ys = ys+(x :> xs) ++ ys = unsafeCoerce (x :> (xs ++ ys))++{-# NOINLINE splitAt #-}+-- | Split a vector into two vectors at the given point+--+-- >>> splitAt (snat :: SNat 3) (1:>2:>3:>7:>8:>Nil)+-- (<1,2,3>, <7,8>)+-- >>> splitAt d3 (1:>2:>3:>7:>8:>Nil)+-- (<1,2,3>, <7,8>)+splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)+splitAt n xs = splitAtU (toUNat n) xs++splitAtU :: UNat m -> Vec (m + n) a -> (Vec m a, Vec n a)+splitAtU UZero ys = (Nil,ys)+splitAtU (USucc s) (y :> ys) = let (as,bs) = splitAtU s (unsafeCoerce ys)+ in (y :> as, bs)++{-# INLINE splitAtI #-}+-- | Split a vector into two vectors where the length of the two is determined+-- by the context+--+-- >>> splitAtI (1:>2:>3:>7:>8:>Nil) :: (Vec 2 Int, Vec 3 Int)+-- (<1,2>,<3,7,8>)+splitAtI :: KnownNat m => Vec (m + n) a -> (Vec m a, Vec n a)+splitAtI = withSNat splitAt++{-# NOINLINE concat #-}+-- | Concatenate a vector of vectors+--+-- >>> vconcat ((1:>2:>3:>Nil) :> (4:>5:>6:>Nil) :> (7:>8:>9:>Nil) :> (10:>11:>12:>Nil) :> Nil)+-- <1,2,3,4,5,6,7,8,9,10,11,12>+concat :: Vec n (Vec m a) -> Vec (n * m) a+concat Nil = Nil+concat (x :> xs) = unsafeCoerce (x ++ (concat xs))++{-# NOINLINE unconcat #-}+-- | Split a vector of (n * m) elements into a vector of vectors with length m,+-- where m is given+--+-- >>> vunconcat d4 (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil)+-- <<1,2,3,4>,<5,6,7,8>,<9,10,11,12>>+unconcat :: KnownNat n => SNat m -> Vec (n * m) a -> Vec n (Vec m a)+unconcat n xs = unconcatU (withSNat toUNat) (toUNat n) xs++unconcatU :: UNat n -> UNat m -> Vec (n * m) a -> Vec n (Vec m a)+unconcatU UZero _ _ = Nil+unconcatU (USucc n') m ys = let (as,bs) = splitAtU m (unsafeCoerce ys)+ in as :> unconcatU n' m bs++{-# INLINE unconcatI #-}+-- | Split a vector of (n * m) elements into a vector of vectors with length m,+-- where m is determined by the context+--+-- >>> vunconcatI (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil) :: Vec 2 (Vec 6 Int)+-- <<1,2,3,4,5,6>,<7,8,9,10,11,12>>+unconcatI :: (KnownNat n, KnownNat m) => Vec (n * m) a -> Vec n (Vec m a)+unconcatI = withSNat unconcat++{-# NOINLINE merge #-}+-- | Merge two vectors, alternating their elements, i.e.,+--+-- >>> merge (1 :> 2 :> 3 :> 4 :> Nil) (5 :> 6 :> 7 :> 8 :> Nil)+-- <1,5,2,6,3,7,4,8>+merge :: Vec n a -> Vec n a -> Vec (n + n) a+merge Nil Nil = Nil+merge (x :> xs) (y :> ys) = unsafeCoerce+ (x :> y :> (merge xs (unsafeCoerce ys)))++{-# NOINLINE reverse #-}+-- | Returns the elements in a vector in reverse order+--+-- >>> reverse (1:>2:>3:>4:>Nil)+-- <4,3,2,1>+reverse :: Vec n a -> Vec n a+reverse Nil = Nil+reverse (x :> xs) = reverse xs <: x++{-# NOINLINE map #-}+-- | 'map' @f xs@ is the vector obtained by applying @f@ to each element+-- of @xs@, i.e.,+--+-- > map f (x1 :> x2 :> ... :> xn :> Nil) == (f x1 :> f x2 :> ... :> f xn :> Nil)+map :: (a -> b) -> Vec n a -> Vec n b+map _ Nil = Nil+map f (x :> xs) = f x :> map f xs++{-# NOINLINE zipWith #-}+-- | 'zipWith' generalises 'zip' by zipping with the function given+-- as the first argument, instead of a tupling function.+-- For example, @'zipWith' (+)@ is applied to two vectors to produce the+-- vector of corresponding sums.+--+-- > zipWith f (x1 :> x2 :> ... xn :> Nil) (y1 :> y2 :> ... :> yn :> Nil) == (f x1 y1 :> f x2 y2 :> ... :> f xn yn :> Nil)+--+-- __NB:__ 'zipWith' is /strict/ in its second argument, and /lazy/ in its+-- third. This matters when 'zipWith' is used in a recursive setting. See+-- 'lazyV' for more information.+zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c+zipWith _ Nil _ = Nil+zipWith f (x :> xs) ys = f x (head ys) :> zipWith f xs (tail ys)++{-# INLINABLE foldr #-}+-- | 'vfoldr', applied to a binary operator, a starting value (typically+-- the right-identity of the operator), and a vector, reduces the vector+-- using the binary operator, from right to left:+--+-- > foldr f z (x1 :> ... :> xn1 :> xn :> Nil) == x1 `f` (... (xn1 `f` (xn `f` z))...)+-- > foldr r z Nil == z+--+-- >>> foldr (/) 1 (5 :> 4 :> 3 :> 2 :> Nil)+-- 1.875+--+-- __NB__: @"'foldr' f z xs"@ produces a linear structure, which has a depth, or+-- delay, of O(@'length' xs@). Use 'fold' if your binary operator @f@ is+-- associative, as @"'fold' f xs"@ produces a structure with a depth of+-- O(log_2(@'length' xs@)).+foldr :: (a -> b -> b) -> b -> Vec n a -> b+foldr f z xs = head (scanr f z xs)++{-# INLINABLE foldl #-}+-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a vector, reduces the vector+-- using the binary operator, from left to right:+--+-- > foldl f z (x1 :> x2 :> ... :> xn :> Nil) == (...((z `f` x1) `f` x2) `f`...) `f` xn+-- > foldl f z Nil == z+--+-- >>> foldl (/) 1 (5 :> 4 :> 3 :> 2 :> Nil)+-- 8.333333333333333e-3+--+-- __NB__: @"'foldl' f z xs"@ produces a linear structure, which has a depth, or+-- delay, of O(@'length' xs@). Use 'fold' if your binary operator @f@ is+-- associative, as @"'fold' f xs"@ produces a structure with a depth of+-- O(log_2(@'length' xs@)).+foldl :: (b -> a -> b) -> b -> Vec n a -> b+foldl f z xs = last (scanl f z xs)++{-# INLINABLE foldr1 #-}+-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty vectors.+--+-- > foldr1 f (x1 :> ... :> xn2 :> xn1 :> xn :> Nil) == x1 `f` (... (xn2 `f` (xn1 `f` xn))...)+-- > foldr1 f (x1 :> Nil) == x1+-- > foldr1 f Nil == TYPE ERROR+--+-- >>> foldr1 (/) (5 :> 4 :> 3 :> 2 :> 1 :> Nil)+-- 1.875+--+-- __NB__: @"'foldr1' f z xs"@ produces a linear structure, which has a depth,+-- or delay, of O(@'length' xs@). Use 'fold' if your binary operator @f@ is+-- associative, as @"'fold' f xs"@ produces a structure with a depth of+-- O(log_2(@'length' xs@)).+foldr1 :: (a -> a -> a) -> Vec (n + 1) a -> a+foldr1 f xs = foldr f (last xs) (init xs)++{-# INLINE foldl1 #-}+-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,+-- and thus must be applied to non-empty vectors.+--+-- > foldl1 f (x1 :> x2 :> x3 :> ... :> xn :> Nil) == (...((x1 `f` x2) `f` x3) `f`...) `f` xn+-- > foldl1 f (x1 :> Nil) == x1+-- > foldl1 f Nil == TYPE ERROR+--+-- >>> foldl1 (/) (1 :> 5 :> 4 :> 3 :> 2 :> Nil)+-- 8.333333333333333e-3+--+-- __NB__: @"'foldl1' f z xs"@ produces a linear structure, which has a depth,+-- or delay, of O(@'length' xs@). Use 'fold' if your binary operator @f@ is+-- associative, as @"'fold' f xs"@ produces a structure with a depth of+-- O(log_2(@'length' xs@)).+foldl1 :: (a -> a -> a) -> Vec (n + 1) a -> a+foldl1 f xs = foldl f (head xs) (tail xs)++{-# NOINLINE fold #-}+-- | 'fold' is a variant of 'foldr1' and 'foldl1', but instead of reducing from+-- right to left, or left to right, it reduces a vector using a tree-like+-- structure. The depth, or delay, of the structure produced by+-- \"@'fold' f xs@\", is hence @O(log_2('length' xs))@, and not+-- @O('length' xs)@.+--+-- __NB__: The binary operator \"@f@ in @'fold' f xs@\" must be associative.+--+-- > fold f (x1 :> x2 :> ... :> xn1 :> xn :> Nil) == ((x1 `f` x2) `f` ...) `f` (... `f` (xn1 `f` xn))+-- > fold f (x1 :> Nil) == x1+-- > fold f Nil == TYPE ERROR+--+-- >>> fold (+) (5 :> 4 :> 3 :> 2 :> 1 :> Nil)+-- 15+fold :: (a -> a -> a) -> Vec (n + 1) a -> a+fold f vs = fold' (toList vs)+ where+ fold' [x] = x+ fold' xs = fold' ys `f` fold' zs+ where+ (ys,zs) = P.splitAt (P.length xs `div` 2) xs++{-# INLINE scanl #-}+-- | 'scanl' is similar to 'foldl', but returns a vector of successive reduced+-- values from the left:+--+-- > scanl f z (x1 :> x2 :> ... :> Nil) == z :> (z `f` x1) :> ((z `f` x1) `f` x2) :> ... :> Nil+--+-- >>> scanl (+) 0 (5 :> 4 :> 3 :> 2 :> Nil)+-- <0,5,9,12,14>+--+-- __NB__:+--+-- > last (scanl f z xs) == foldl f z xs+scanl :: (b -> a -> b) -> b -> Vec n a -> Vec (n + 1) b+scanl f z xs = ws+ where+ ws = z :> zipWith (flip f) xs (init ws)++{-# INLINE sscanl #-}+-- | 'sscanl' is a variant of 'scanl' where the first result is dropped:+--+-- > sscanl f z (x1 :> x2 :> ... :> Nil) == (z `f` x1) :> ((z `f` x1) `f` x2) :> ... :> Nil+--+-- >>> sscanl (+) 0 (5 :> 4 :> 3 :> 2 :> Nil)+-- <5,9,12,14>+sscanl :: (b -> a -> b) -> b -> Vec n a -> Vec n b+sscanl f z xs = tail (scanl f z xs)++{-# INLINE scanr #-}+-- | 'scanr' is similar to 'foldr', but returns a vector of successive reduced+-- values from the right:+--+-- > scanr f z (... :> xn1 :> xn :> Nil) == ... :> (xn1 `f` (xn `f` z)) :> (xn `f` z) :> z :> Nil+--+-- >>> scanr (+) 0 (5 :> 4 :> 3 :> 2 :> Nil)+-- <14,9,5,2,0>+--+-- __NB__:+--+-- > head (scanr f z xs) == foldr f z xs+scanr :: (a -> b -> b) -> b -> Vec n a -> Vec (n + 1) b+scanr f z xs = ws+ where+ ws = zipWith f xs ((tail ws)) <: z++{-# INLINE sscanr #-}+-- | 'sscanr' is a variant of 'scanr' that where the last result is dropped:+--+-- > sscanr f z (... :> xn1 :> xn :> Nil) == ... :> (xn1 `f` (xn `f` z)) :> (xn `f` z) :> Nil+--+-- >>> sscanr (+) 0 (5 :> 4 :> 3 :> 2 :> Nil)+-- <14,9,5,2>+sscanr :: (a -> b -> b) -> b -> Vec n a -> Vec n b+sscanr f z xs = init (scanr f z xs)++{-# INLINE mapAccumL #-}+-- | The 'mapAccumL' function behaves like a combination of 'map' and 'foldl';+-- it applies a function to each element of a vector, passing an accumulating+-- parameter from left to right, and returning a final value of this accumulator+-- together with the new vector.+--+-- >>> mapAccumL (\acc x -> (acc + x,acc + 1)) 0 (1 :> 2 :> 3 :> 4 :> Nil)+-- (10,<1,2,4,7>)+mapAccumL :: (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc,Vec n y)+mapAccumL f acc xs = (acc',ys)+ where+ accs = acc :> accs'+ ws = zipWith (flip f) xs (init accs)+ accs' = map fst ws+ ys = map snd ws+ acc' = last accs++{-# INLINE mapAccumR #-}+-- | The 'mapAccumR' function behaves like a combination of 'map' and 'foldr';+-- it applies a function to each element of a vector, passing an accumulating+-- parameter from right to left, and returning a final value of this accumulator+-- together with the new vector.+--+-- >>> mapAccumR (\acc x -> (acc + x,acc + 1)) 0 (1 :> 2 :> 3 :> 4 :> Nil)+-- (10,<10,8,5,1>)+mapAccumR :: (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc, Vec n y)+mapAccumR f acc xs = (acc',ys)+ where+ accs = accs' <: acc+ ws = zipWith (flip f) xs (tail accs)+ accs' = map fst ws+ ys = map snd ws+ acc' = head accs++{-# INLINE zip #-}+-- | 'zip' takes two vectors and returns a vector of corresponding pairs.+--+-- >>> zip (1:>2:>3:>4:>Nil) (4:>3:>2:>1:>Nil)+-- <(1,4),(2,3),(3,2),(4,1)>+zip :: Vec n a -> Vec n b -> Vec n (a,b)+zip = zipWith (,)++{-# INLINE unzip #-}+-- | 'unzip' transforms a vector of pairs into a vector of first components+-- and a vector of second components.+--+-- >>> unzip ((1,4):>(2,3):>(3,2):>(4,1):>Nil)+-- (<1,2,3,4>,<4,3,2,1>)+unzip :: Vec n (a,b) -> (Vec n a, Vec n b)+unzip xs = (map fst xs, map snd xs)++indexM_integer :: Vec n a -> Integer -> Maybe a+indexM_integer Nil _ = Nothing+indexM_integer (x :> _) 0 = Just x+indexM_integer (_ :> xs) n = indexM_integer xs (n-1)++{-# NOINLINE index_integer #-}+index_integer :: KnownNat n => Vec n a -> Integer -> a+index_integer xs i = case indexM_integer xs i of+ Just a -> a+ Nothing -> error (P.concat [ "(!!): Index "+ , show i+ , " is out of bounds [0.."+ , show (maxIndex xs)+ , "]"+ ])++{-# INLINE (!!) #-}+-- | Vector index (subscript) operator.+--+-- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and+-- ending at 'maxIndex'.+--+-- >>> (1:>2:>3:>4:>5:>Nil) !! 4+-- 5+-- >>> (1:>2:>3:>4:>5:>Nil) !! maxIndex+-- 5+-- >>> (1:>2:>3:>4:>5:>Nil) !! 1+-- 2+-- >>> (1:>2:>3:>4:>5:>Nil) !! 14+-- *** Exception: (!!): Index 14 is out of bounds [0..4]+(!!) :: (KnownNat n, Integral i) => Vec n a -> i -> a+xs !! i = index_integer xs (toInteger i)++{-# NOINLINE maxIndex #-}+-- | Index (subscript) of the last element in a 'Vec'tor+--+-- >>> maxIndex (6 :> 7 :> 8 :> Nil)+-- 2+maxIndex :: KnownNat n => Vec n a -> Integer+maxIndex = subtract 1 . length++{-# NOINLINE length #-}+-- | Length of a 'Vec'tor as an Integer+--+-- >>> length (6 :> 7 :> 8 :> Nil)+-- 3+length :: KnownNat n => Vec n a -> Integer+length = natVal . asNatProxy++replaceM_integer :: Vec n a -> Integer -> a -> Maybe (Vec n a)+replaceM_integer Nil _ _ = Nothing+replaceM_integer (_ :> xs) 0 y = Just (y :> xs)+replaceM_integer (x :> xs) n y = case replaceM_integer xs (n-1) y of+ Just xs' -> Just (x :> xs')+ Nothing -> Nothing++{-# NOINLINE replace_integer #-}+replace_integer :: KnownNat n => Vec n a -> Integer -> a -> Vec n a+replace_integer xs i a = case replaceM_integer xs i a of+ Just ys -> ys+ Nothing -> error (P.concat [ "replace: Index "+ , show i+ , " is out of bounds [0.."+ , show (maxIndex xs)+ , "]"+ ])++{-# INLINE replace #-}+-- | Replace an element of a vector at the given index (subscript).+--+-- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and+-- ending at 'maxIndex'.+--+-- >>> replace (1:>2:>3:>4:>5:>Nil) 3 7+-- <1,2,3,7,5>+-- >>> replace (1:>2:>3:>4:>5:>Nil) 0 7+-- <7,2,3,4,5>+-- >>> replace (1:>2:>3:>4:>5:>Nil) 9 7+-- <*** Exception: replace: Index 9 is out of bounds [0..4]+replace :: (KnownNat n, Integral i) => Vec n a -> i -> a -> Vec n a+replace xs i y = replace_integer xs (toInteger i) y++{-# INLINABLE take #-}+-- | 'take' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@+--+-- >>> take (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil)+-- <1,2,3>+-- >>> take d3 (1:>2:>3:>4:>5:>Nil)+-- <1,2,3>+-- >>> take d0 (1:>2:>Nil)+-- <>+-- >>> take d4 (1:>2:>Nil)+-- <interactive>+-- Couldn't match type ‘4 + n0’ with ‘2’+-- The type variable ‘n0’ is ambiguous+-- Expected type: Vec (4 + n0) a+-- Actual type: Vec (1 + 1) a+-- In the second argument of ‘vtake’, namely ‘(1 :> 2 :> Nil)’+-- In the expression: vtake d4 (1 :> 2 :> Nil)+-- In an equation for ‘it’: it = vtake d4 (1 :> 2 :> Nil)+take :: SNat m -> Vec (m + n) a -> Vec m a+take n = fst . splitAt n++{-# INLINE takeI #-}+-- | 'takeI' @xs@, returns the prefix of @xs@ as demanded by the context+--+-- >>> takeI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int+-- <1,2>+takeI :: KnownNat m => Vec (m + n) a -> Vec m a+takeI = withSNat take++{-# INLINE drop #-}+-- | 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ elements+--+-- >>> drop (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil)+-- <4,5>+-- >>> drop d3 (1:>2:>3:>4:>5:>Nil)+-- <4,5>+-- >>> drop d0 (1:>2:>Nil)+-- <1,2>+-- >>> drop d4 (1:>2:>Nil)+-- <interactive>+-- Couldn't match expected type ‘2’ with actual type ‘4 + n0’+-- The type variable ‘n0’ is ambiguous+-- In the first argument of ‘print’, namely ‘it’+-- In a stmt of an interactive GHCi command: print it+drop :: SNat m -> Vec (m + n) a -> Vec n a+drop n = snd . splitAt n++{-# INLINE dropI #-}+-- | 'dropI' @xs@, returns the suffix of @xs@ as demanded by the context+--+-- >>> dropI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int+-- <4,5>+dropI :: KnownNat m => Vec (m + n) a -> Vec n a+dropI = withSNat drop++{-# INLINE exact #-}+-- | 'exact' @n xs@ returns @n@'th element of @xs@+--+-- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and+-- ending at 'maxIndex'.+--+-- >>> exact (snat :: SNat 1) (1:>2:>3:>4:>5:>Nil)+-- 4+-- >>> exact d1 (1:>2:>3:>4:>5:>Nil)+-- 4+exact :: SNat m -> Vec (m + (n + 1)) a -> a+exact n xs = head $ snd $ splitAt n xs++{-# NOINLINE select #-}+-- | 'select' @f s n xs@ selects @n@ elements with stepsize @s@ and+-- offset @f@ from @xs@+--+-- >>> select (snat :: SNat 1) (snat :: SNat 2) (snat :: SNat 3) (1:>2:>3:>4:>5:>6:>7:>8:>Nil)+-- <2,4,6>+-- >>> select d1 d2 d3 (1:>2:>3:>4:>5:>6:>7:>8:>Nil)+-- <2,4,6>+select :: (CmpNat (i + s) (s * n) ~ GT)+ => SNat f+ -> SNat s+ -> SNat n+ -> Vec (f + i) a+ -> Vec n a+select f s n xs = select' (toUNat n) $ drop f xs+ where+ select' :: UNat n -> Vec i a -> Vec n a+ select' UZero _ = Nil+ select' (USucc n') vs@(x :> _) = x :> select' n' (drop s (unsafeCoerce vs))++{-# INLINE selectI #-}+-- | 'selectI' @f s xs@ selects as many elements as demanded by the context+-- with stepsize @s@ and offset @f@ from @xs@+--+-- >>> selectI d1 d2 (1:>2:>3:>4:>5:>6:>7:>8:>Nil) :: Vec 2 Int+-- <2,4>+selectI :: (CmpNat (i + s) (s * n) ~ GT, KnownNat n)+ => SNat f+ -> SNat s+ -> Vec (f + i) a+ -> Vec n a+selectI f s xs = withSNat (\n -> select f s n xs)++{-# NOINLINE replicate #-}+-- | 'replicate' @n a@ returns a vector that has @n@ copies of @a@+--+-- >>> replicate (snat :: SNat 3) 6+-- <6,6,6>+-- >>> replicate d3 6+-- <6,6,6>+replicate :: SNat n -> a -> Vec n a+replicate n a = replicateU (toUNat n) a++replicateU :: UNat n -> a -> Vec n a+replicateU UZero _ = Nil+replicateU (USucc s) x = x :> replicateU s x++{-# INLINE repeat #-}+-- | 'repeat' @a@ creates a vector with as many copies of @a@ as demanded by the+-- context+--+-- >>> repeat 6 :: Vec 5 Int+-- <6,6,6,6,6>+repeat :: KnownNat n => a -> Vec n a+repeat = withSNat replicate++{-# INLINE iterate #-}+-- | 'iterate' @n f x@ returns a vector starting with @x@ followed by @n@+-- repeated applications of @f@ to @x@+--+-- > iterate (snat :: SNat 4) f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil)+-- > iterate d4 f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil)+--+-- >>> iterate d4 (+1) 1+-- <1,2,3,4>+iterate :: SNat n -> (a -> a) -> a -> Vec n a+iterate (SNat _) = iterateI++{-# INLINE iterateI #-}+-- | 'iterate' @f x@ returns a vector starting with @x@ followed by @n@+-- repeated applications of @f@ to @x@, where @n@ is determined by the context+--+-- > iterateI f x :: Vec 3 a == (x :> f x :> f (f x) :> Nil)+--+-- >>> iterateI (+1) 1 :: Vec 3 Int+-- <1,2,3>+iterateI :: KnownNat n => (a -> a) -> a -> Vec n a+iterateI f a = xs+ where+ xs = init (a :> ws)+ ws = map f (lazyV xs)++{-# INLINE generate #-}+-- | 'generate' @n f x@ returns a vector with @n@ repeated applications of @f@+-- to @x@+--+-- > generate (snat :: SNat 4) f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil)+-- > generate d4 f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil)+--+-- >>> generate d4 (+1) 1+-- <2,3,4,5>+generate :: SNat n -> (a -> a) -> a -> Vec n a+generate (SNat _) f a = iterateI f (f a)++{-# INLINE generateI #-}+-- | 'generate' @f x@ returns a vector with @n@ repeated applications of @f@+-- to @x@, where @n@ is determined by the context+--+-- > generateI f x :: Vec 3 a == (f x :> f (f x) :> f (f (f x)) :> Nil)+--+-- >>> generateI (+1) 1 :: Vec 3 Int+-- <2,3,4>+generateI :: KnownNat n => (a -> a) -> a -> Vec n a+generateI f a = iterateI f (f a)++{-# INLINE toList #-}+-- | Convert a vector to a list+--+-- >>> toList (1:>2:>3:>Nil)+-- [1,2,3]+--+-- __NB__: Not synthesisable+toList :: Vec n a -> [a]+toList = foldr (:) []++-- | Create a vector literal from a list literal+--+-- > $(v [1::Signed 8,2,3,4,5]) == (8:>2:>3:>4:>5:>Nil) :: Vec 5 (Signed 8)+--+-- >>> [1 :: Signed 8,2,3,4,5]+-- [1,2,3,4,5]+-- >>> $(v [1::Signed 8,2,3,4,5])+-- <1,2,3,4,5>+v :: Lift a => [a] -> ExpQ+v [] = [| Nil |]+v (x:xs) = [| x :> $(v xs) |]++-- | 'Vec'tor as a 'Proxy' for 'Nat'+asNatProxy :: Vec n a -> Proxy n+asNatProxy _ = Proxy++{-# NOINLINE lazyV #-}+-- | For when your vector functions are too strict in their arguments+--+-- For example:+--+-- > -- Bubble sort for 1 iteration+-- > sortV xs = map fst sorted <: (snd (last sorted))+-- > where+-- > lefts = head xs :> map snd (init sorted)+-- > rights = tail xs+-- > sorted = zipWith compareSwapL lefts rights+-- >+-- > -- Compare and swap+-- > compareSwapL a b = if a < b then (a,b)+-- > else (b,a)+--+-- Will not terminate because 'zipWith' is too strict in its second argument:+--+-- >>> sortV (4 :> 1 :> 2 :> 3 :> Nil)+-- <*** Exception: <<loop>>+--+-- In this case, adding 'lazyV' on 'zipWith's second argument:+--+-- @+-- sortVL xs = map fst sorted <: (snd (last sorted))+-- where+-- lefts = head xs :> map snd (init sorted)+-- rights = tail xs+-- sorted = zipWith compareSwapL ('lazyV' lefts) rights+-- @+--+-- Results in a successful computation:+--+-- >>> sortVL (4 :> 1 :> 2 :> 3 :> Nil)+-- <1,2,3,4>+--+-- __NB__: There is also a solution using 'flip', but it slightly obfuscates the+-- meaning of the code:+--+-- @+-- sortV_flip xs = map fst sorted <: (snd (last sorted))+-- where+-- lefts = head xs :> map snd (init sorted)+-- rights = tail xs+-- sorted = zipWith ('flip' compareSwapL) rights lefts+-- @+--+-- >>> sortV_flip (4 :> 1 :> 2 :> 3 :> Nil)+-- <1,2,3,4>+lazyV :: KnownNat n+ => Vec n a+ -> Vec n a+lazyV = lazyV' (repeat undefined)+ where+ lazyV' :: Vec n a -> Vec n a -> Vec n a+ lazyV' Nil _ = Nil+ lazyV' (_ :> xs) ys = head ys :> lazyV' xs (tail ys)++{-# NOINLINE concatBitVector# #-}+concatBitVector# :: KnownNat m+ => Vec n (BitVector m)+ -> BitVector (n * m)+concatBitVector# Nil = 0+concatBitVector# (x :> xs) = unsafeCoerce (concatBitVector# xs ++# x)++{-# NOINLINE unconcatBitVector# #-}+unconcatBitVector# :: (KnownNat n, KnownNat m)+ => BitVector (n * m)+ -> Vec n (BitVector m)+unconcatBitVector# bv = withSNat (\s -> ucBV (toUNat s) bv)++{-# INLINE ucBV #-}+ucBV :: forall n m . KnownNat m+ => UNat n -> BitVector (n * m) -> Vec n (BitVector m)+ucBV UZero _ = Nil+ucBV (USucc n) bv = let (bv',x :: BitVector m) = split# (unsafeCoerce bv)+ in x :> ucBV n bv'
src/CLaSH/Tutorial.hs view
@@ -130,7 +130,7 @@ * Run @cabal update@ - (3) Install __CλaSH__+ (2) Install __CλaSH__ * Run @cabal install clash-ghc@ @@ -310,10 +310,10 @@ shape of 'macT': @-(\<^\>) :: (Pack i, Pack o)+(\<^\>) :: (Bundle i, Bundle o) => (s -> i -> (s,o)) -> s- -> (SignalP i -> SignalP o)+ -> (Unbudled' i -> Unbundled' o) f \<^\> initS = ... @ @@ -326,7 +326,7 @@ Where the LHS of '<^>' is our 'macT' function, and the RHS is the initial state, in this case 0. We can see it is functioning correctly in our interpreter: ->>> take 4 $ simulateP mac [(1::Int,1),(2,2),(3,3),(4,4)] :: [Int]+>>> Data.List.take 4 $ simulateB mac [(1::Int,1),(2,2),(3,3),(4,4)] :: [Int] [0,1,5,14] Where we simulate our sequential circuit over a list of input samples and take@@ -338,22 +338,22 @@ the type of our 'mac' circuit: >>> :t mac-mac :: (Pack o, Num o) => (Signal o, Signal o) -> SignalP o+mac :: (Bundle o, Num o) => Unbundled' (o, o) -> Unbundled o We see that our 'mac' function work on a two-tuple of 'Signal's and not on a 'Signal' of a two-tuple. Indeed, the CλaSH prelude library defines that: @-type instance SignalP (a,b) = (Signal a, Signal b)+type instance Unbundled (a,b) = (Signal a, Signal b) @ -'SignalP' is an <http://www.haskell.org/ghc/docs/latest/html/users_guide/type-families.html#assoc-decl associated type family>-belonging to the 'Pack' <http://en.wikipedia.org/wiki/Type_class type class>,-which, together with 'pack' and 'unpack' defines the isomorphism between a+'Unbundled' is an <http://www.haskell.org/ghc/docs/latest/html/users_guide/type-families.html#assoc-decl associated type family>+belonging to the 'Bundle' <http://en.wikipedia.org/wiki/Type_class type class>,+which, together with 'bundle' and 'unbundle' defines the isomorphism between a product type of 'Signal's and a 'Signal' of a product type. That is, while @(Signal a, Signal b)@ and @Signal (a,b)@ are not equal, they are /isomorphic/-and can be converted from on to the other using 'pack' and 'unpack'. Instances-of this 'Pack' type-class are defined as /isomorphisms/ for:+and can be converted from on to the other using 'bundle' and 'unbundle'. Instances+of this 'Bundle' type-class are defined as /isomorphisms/ for: * All tuples until and including 8-tuples * The 'Vec'tor type@@ -365,18 +365,18 @@ That is: @-instance Pack Bool where- type SignalP Bool = Signal Bool- pack :: SignalP Bool -> Signal Bool- pack = 'id'- unpack :: Signal Bool -> SignalP Bool+instance Bundle Bool where+ type Unbundled Bool = Signal Bool+ bundle :: Unbundled Bool -> Signal Bool+ bundle = 'id'+ unpack :: Signal Bool -> Unbundled Bool unpack = 'id' @ -We will see later why this 'Pack' type class is so convenient, for now, you just+We will see later why this 'Bundle' type class is so convenient, for now, you just have to remember that it exists. And more importantly, that you understand that a product type of 'Signal's is not equal to a 'Signal' of a product type, but-that the functions of the 'Pack' type class allow easy conversion between the+that the functions of the 'Bunlde' type class allow easy conversion between the two. -} @@ -573,10 +573,10 @@ position of the arguments and result: @- asStateM :: (Pack o, Pack i)+ asStateM :: (Bundle o, Bundle i) => (i -> State s o) -> s- -> (SignalP i -> SignalP o)+ -> (Unbundled i -> Unbundled o) asStateM f i = g \<^\> i where g s x = let (o,s') = runState (f x) s@@ -596,7 +596,7 @@ of coefficients. @-dotp as bs = vfoldl (+) 0 (vzipWith (*) as bs)+dotp as bs = foldl (+) 0 (zipWith (*) as bs) fir coeffs x_t = y_t where@@ -662,19 +662,19 @@ => Vec n a -- Current state -> (i, Maybe a) -- Input -> (Vec n a, a) -- (New state, Output)-datamem mem (addr,Nothing) = (mem ,mem ! addr)-datamem mem (addr,Just val) = (vreplace mem addr val,mem ! addr)+datamem mem (addr,Nothing) = (mem ,mem !! addr)+datamem mem (addr,Just val) = (replace mem addr val,mem !! addr) topEntity :: Signal (OPC Word) -> Signal (Maybe Word) topEntity i = val where (addr,val) = (pu alu \<^\> (0,0,0 :: Unsigned 3)) (mem,i) mem = (datamem \<^\> initMem) (addr,val)- initMem = vcopy d8 0+ initMem = replicate d8 0 @ Here we can finally see the advantage of having the '<^>' return a function-of type: @('SignalP' i -> 'SignalP' o)@ (instead of:+of type: @('Unbundled' i -> 'Unbundled' o)@ (instead of: @('Signal' i -> 'Signal' o)@): * We can use normal pattern matching to get parts of the result, and,@@ -706,19 +706,19 @@ and /declaration/ primitives, corresponding to whether the primitive is a VHDL /expression/ or a VHDL /declaration/. We will first explore /expression/ primitives, using 'Signed' multiplication ('*') as an example. The-"CLaSH.Sized.Signed" module specifies multiplication as follows:+"CLaSH.Sized.Internal.Signed" module specifies multiplication as follows: @-{\-# NOINLINE timesS #-\}-timesS :: KnownNat n => Signed n -> Signed n -> Signed n-timesS (S a) (S b) = fromIntegerS_inlineable (a * b)+{\-\# NOINLINE (*#) \#-\}+(*#) :: KnownNat n => Signed n -> Signed n -> Signed n+(S a) *# (S b) = fromInteger_INLINE (a * b) @ For which the /expression/ primitive is: @ { \"BlackBox\" :- { "name" : "CLaSH.Sized.Signed.timesS"+ { "name" : "CLaSH.Sized.Internal.Signed.*#" , "templateE" : "resize(~ARG[1] * ~ARG[2], ~LIT[0])" } }@@ -748,65 +748,73 @@ is actually just like a @newtype@ wrapper for 'Integer'. The second kind of primitive that we will explore is the /declaration/ primitive.-We will use 'blockRam' as an example, for which the Haskell/CλaSH code is:+We will use 'cblockRam' as an example, for which the Haskell/CλaSH code is: @-{\-# NOINLINE blockRam #-\}--- | Create a blockRAM with space for \@n\@ elements+{\-\# NOINLINE cblockRam \#-\}+-- | Create a blockRAM with space for @n@ elements ----- NB: Read value is delayed by 1 cycle+-- * \_\_NB\_\_: Read value is delayed by 1 cycle+-- * \_\_NB\_\_: Initial output value is \'undefined\' ----- > bram40 :: Signal (Unsigned 6) -> Signal (Unsigned 6) -> Signal Bool -> Signal a -> Signal a--- > bram40 = blockRam d40-blockRam :: forall n m a . (KnownNat n, KnownNat m, Pack a, Default a)- => SNat n -- ^ Size \@n\@ of the blockram- -> Signal (Unsigned m) -- ^ Write address \@w\@- -> Signal (Unsigned m) -- ^ Read address \@r\@- -> Signal Bool -- ^ Write enable- -> Signal a -- ^ Value to write (at address \@w\@)- -> Signal a -- ^ Value of the 'blockRAM' at address \@r\@ from the previous clock cycle-blockRam n wr rd en din = pack $ (bram' \<^\> binit) (wr,rd,en,din)+-- > type ClkA = Clk \"A\" 100+-- >+-- > clkA100 :: SClock ClkA+-- > clkA100 = sclock+-- >+-- > bram40 :: CSignal ClkA (Unsigned 6) -> CSignal ClkA (Unsigned 6)+-- > -> CSignal ClkA Bool -> CSignal ClkA Bit -> ClkA CSignal Bit+-- > bram40 = cblockRam clkA100 (replicate d40 H)+cblockRam :: (KnownNat n, KnownNat m)+ => SClock clk -- ^ \'Clock\' to synchronize to+ -> Vec n a -- ^ Initial content of the BRAM, also+ -- determines the size, \@n\@, of the BRAM.+ --+ -- \_\_NB\_\_: \_\_MUST\_\_ be a constant.+ -> CSignal clk (Unsigned m) -- ^ Write address \@w\@+ -> CSignal clk (Unsigned m) -- ^ Read address \@r\@+ -> CSignal clk Bool -- ^ Write enable+ -> CSignal clk a -- ^ Value to write (at address \@w\@)+ -> CSignal clk a+ -- ^ Value of the \'blockRAM\' at address \@r\@ from the previous clock+ -- cycle+cblockRam clk binit wr rd en din =+ cmealy clk bram' (binit,undefined) (bundle clk (wr,rd,en,din)) where- binit :: (Vec n a,a)- binit = (vcopy n def,def)-- bram' :: (Vec n a,a) -> (Unsigned m, Unsigned m, Bool, a)- -> (((Vec n a),a),a) bram' (ram,o) (w,r,e,d) = ((ram',o'),o) where- ram' | e = vreplace ram w d+ ram' | e = replace ram w d | otherwise = ram- o' = ram ! r+ o' = ram !! r @ And for which the /definition/ primitive is: @ { \"BlackBox\" :- { "name" : "CLaSH.Prelude.blockRam"- , "templateD" :-"~SYM[0]_block : block- type ram_array is array (natural range <>) of ~TYP[8];- signal ~SYM[1] : ram_array((~ARG[0]-1) downto 0) := (others => ~ARG[3]); -- ram- signal ~SYM[2] : ~TYP[8]; -- inp- signal ~SYM[3] : ~TYP[8] := ~ARG[3]; -- outp+ { "name" : "CLaSH.Prelude.BlockRam.cblockRam"+ , "templateD" :+"blockram_~SYM[0] : block+ signal ~SYM[1] : ~TYP[3] := ~LIT[3]; -- ram+ signal ~SYM[2] : ~TYP[7]; -- inp+ signal ~SYM[3] : ~TYP[7]; -- outp begin- ~SYM[2] <= ~ARG[8];+ ~SYM[2] <= ~ARG[7]; - process(~CLKO)+ process(~CLK[2]) begin- if rising_edge(~CLKO) then- if ~ARG[7] then- ~SYM[1](to_integer(~ARG[5])) <= ~SYM[2];+ if rising_edge(~CLK[2]) then+ if ~ARG[6] then+ ~SYM[1](to_integer(~ARG[4])) <= ~SYM[2]; end if;- ~SYM[3] <= ~SYM[1](to_integer(~ARG[6]));+ ~SYM[3] <= ~SYM[1](to_integer(~ARG[5])); end if; end process; ~RESULT <= ~SYM[3]; end block;"+ } }-} @ Again, the @name@ of the primitive is the fully qualified name of the function@@ -873,18 +881,18 @@ ... = f a b (c,d) @ - add the 'pack' function like so:+ add the 'bundle'' function like so: @- ... = f a b (pack (c,d))+ ... = f a b (bundle' (c,d)) @ - Product types supported by 'pack' are:+ Product types supported by 'bundle'' are: * All tuples until and including 8-tuples * The 'Vec'tor type - NB: Use 'cpack' when you are using explicitly clocked 'CSignal's+ NB: Use 'bundle' when you are using explicitly clocked 'CSignal's * __Type error: Couldn't match expected type ‘(Signal a, Signal b)’ with__ __ actual type ‘Signal (a,b)’__:@@ -898,18 +906,18 @@ (c,d) = f a b @ - add the 'unpack' function like so:+ add the 'unbundle'' function like so: @- (c,d) = unpack (f a b)+ (c,d) = unbundle' (f a b) @ - Product types supported by 'unpack' are:+ Product types supported by 'unbundle'' are: * All tuples until and including 8-tuples * The 'Vec'tor type - NB: Use 'cunpack' when you are using explicitly clocked 'CSignal's+ NB: Use 'unbundle' when you are using explicitly clocked 'CSignal's * __CLaSH.Netlist(..): Not in normal form: \<REASON\>: \<EXPR\>__: @@ -982,30 +990,30 @@ @ -- Bubble sort for 1 iteration- sortV xs = vmap fst sorted <: (snd (vlast sorted))+ sortV xs = map fst sorted <: (snd (last sorted)) where- lefts = vhead xs :> vmap snd (vinit sorted)- rights = vtail xs- sorted = vzipWith compareSwapL lefts rights+ lefts = head xs :> map snd (init sorted)+ rights = tail xs+ sorted = zipWith compareSwapL lefts rights -- Compare and swap compareSwapL a b = if a < b then (a,b) else (b,a) @ - Will not terminate because 'vzipWith' is too strict in its second argument:+ Will not terminate because 'zipWith' is too strict in its second argument: >>> sortV (4 :> 1 :> 2 :> 3 :> Nil) <*** Exception: <<loop>> - In this case, adding 'lazyV' on 'vzipWith's second argument:+ In this case, adding 'lazyV' on 'zipWith's second argument: @- sortVL xs = vmap fst sorted <: (snd (vlast sorted))+ sortVL xs = map fst sorted <: (snd (last sorted)) where- lefts = vhead xs :> vmap snd (vinit sorted)- rights = vtail xs- sorted = vzipWith compareSwapL (lazyV lefts) rights+ lefts = head xs :> map snd (init sorted)+ rights = tail xs+ sorted = zipWith compareSwapL ('lazyV' lefts) rights @ Results in a successful computation:@@ -1033,11 +1041,11 @@ is the following function that performs one iteration of bubble sort: @- sortVL xs = vmap fst sorted <: (snd (vlast sorted))+ sortV xs = map fst sorted <: (snd (last sorted)) where- lefts = vhead xs :> vmap snd (vinit sorted)- rights = vtail xs- sorted = vzipWith compareSwapL (lazyV lefts) rights+ lefts = head xs :> map snd (init sorted)+ rights = tail xs+ sorted = zipWith compareSwapL lefts rights @ Where we can clearly see that 'lefts' and 'sorted' are defined in terms of