clash-prelude 0.6.0.1 → 0.7
raw patch · 36 files changed
+1878/−1262 lines, 36 filesdep +singletons
Dependencies added: singletons
Files
- CHANGELOG.md +13/−0
- LICENSE +16/−24
- README.md +1/−1
- clash-prelude.cabal +4/−3
- src/CLaSH/Class/BitPack.hs +8/−8
- src/CLaSH/Class/Num.hs +8/−0
- src/CLaSH/Class/Resize.hs +8/−0
- src/CLaSH/Prelude.hs +18/−11
- src/CLaSH/Prelude/BitIndex.hs +7/−0
- src/CLaSH/Prelude/BitReduction.hs +7/−0
- src/CLaSH/Prelude/BlockRam.hs +55/−47
- src/CLaSH/Prelude/DataFlow.hs +125/−93
- src/CLaSH/Prelude/Explicit.hs +89/−65
- src/CLaSH/Prelude/Mealy.hs +94/−70
- src/CLaSH/Prelude/Testbench.hs +63/−93
- src/CLaSH/Promoted/Nat.hs +8/−0
- src/CLaSH/Promoted/Nat/Literals.hs +24/−12
- src/CLaSH/Promoted/Nat/TH.hs +8/−0
- src/CLaSH/Promoted/Ord.hs +8/−0
- src/CLaSH/Promoted/Symbol.hs +8/−0
- src/CLaSH/Signal.hs +50/−88
- src/CLaSH/Signal/Bundle.hs +128/−91
- src/CLaSH/Signal/Delayed.hs +65/−55
- src/CLaSH/Signal/Explicit.hs +113/−151
- src/CLaSH/Signal/Internal.hs +334/−95
- src/CLaSH/Sized/BitVector.hs +7/−0
- src/CLaSH/Sized/Fixed.hs +67/−55
- src/CLaSH/Sized/Index.hs +5/−0
- src/CLaSH/Sized/Internal/BitVector.hs +7/−0
- src/CLaSH/Sized/Internal/Index.hs +7/−0
- src/CLaSH/Sized/Internal/Signed.hs +7/−0
- src/CLaSH/Sized/Internal/Unsigned.hs +7/−0
- src/CLaSH/Sized/Signed.hs +5/−0
- src/CLaSH/Sized/Unsigned.hs +5/−0
- src/CLaSH/Sized/Vector.hs +211/−78
- src/CLaSH/Tutorial.hs +288/−222
CHANGELOG.md view
@@ -1,5 +1,18 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.7 *March 13th 2015*+* New features:+ * Switch types of 'bundle' and 'bundle'', and 'unbundle' and 'unbundle''.+ * Rename all explicitly clocked versions of Signal functions, to the primed+ name of the implicitly clocked Signal functions. E.g. 'cregister' is now+ called 'register'' (where the implicitly clocked function is callled 'register')+ * Add new instances for 'DSignal'+ * Add experimental 'antiDelay' function for 'DSignal'+ * Generalize lifted functions over Signals (e.g. (.==.))++* Fixes bugs:+ * Faster versions of Vector.(!!) and Vector.replace+ ## 0.6.0.1 *November 17th 2014* * Fixes bugs: * Add missing 'CLaSH.Sized.BitVector' module to .cabal file.
LICENSE view
@@ -1,30 +1,22 @@-Copyright (c)2013-2014, University of Twente-+Copyright (c) 2013-2015, University of Twente All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of University of Twente nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.+1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,2 +1,2 @@ = WARNING =-Only works with GHC-7.8.* (http://www.haskell.org/ghc/download_ghc_7_8_2)!+Only works with GHC-7.8.* (http://www.haskell.org/ghc/download_ghc_7_8_3)!
clash-prelude.cabal view
@@ -1,5 +1,5 @@ Name: clash-prelude-Version: 0.6.0.1+Version: 0.7 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -24,7 +24,7 @@ general overview of the library you should however check out "CLaSH.Prelude". Homepage: http://christiaanb.github.io/clash2/ bug-reports: http://github.com/christiaanb/clash-prelude/issues-License: BSD3+License: BSD2 License-file: LICENSE Author: Christiaan Baaij Maintainer: Christiaan Baaij <christiaan.baaij@gmail.com>@@ -41,7 +41,7 @@ source-repository head type: git- location: https://github.com/christiaanb/clash-prelude.git+ location: https://github.com/clash-lang/clash-prelude.git Library HS-Source-Dirs: src@@ -109,5 +109,6 @@ data-default >= 0.5.3, integer-gmp >= 0.5.1.0, ghc-prim >= 0.3.1.0,+ singletons >= 1.0, template-haskell >= 2.9.0.0, th-lift >= 0.5.6
src/CLaSH/Class/BitPack.hs view
@@ -5,19 +5,24 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Class.BitPack ( BitPack (..) , bitCoerce ) where -import GHC.TypeLits (KnownNat, Nat, type (+), type (*))+import GHC.TypeLits (KnownNat, Nat, 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@@ -71,8 +76,3 @@ 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/Num.hs view
@@ -1,6 +1,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Class.Num ( -- * Arithmetic functions for arguments and results of different precision ExtendingNum (..)
src/CLaSH/Class/Resize.hs view
@@ -2,6 +2,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeOperators #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Class.Resize where import GHC.TypeLits (KnownNat, Nat, type (+))
src/CLaSH/Prelude.hs view
@@ -2,7 +2,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} -{- |+{-# OPTIONS_HADDOCK show-extensions #-}++{-|+ Copyright : (C) 2013-2015, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+ CλaSH (pronounced ‘clash’) is a functional hardware description language that borrows both its syntax and semantics from the functional programming language Haskell. The merits of using a functional language to describe hardware comes@@ -38,7 +44,7 @@ , isRising , isFalling -- * Testbench functions- , sassert+ , assert , stimuliGenerator , outputVerifier -- * Exported modules@@ -78,6 +84,7 @@ , module Control.Applicative , module Data.Bits , module Data.Default+ -- ** Haskell Prelude , module Prelude ) where@@ -100,11 +107,11 @@ 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.Explicit (registerB', window', windowD', isRising',+ isFalling') import CLaSH.Prelude.Mealy (mealy, mealyB, (<^>)) import CLaSH.Prelude.DataFlow-import CLaSH.Prelude.Testbench (sassert, stimuliGenerator, outputVerifier)+import CLaSH.Prelude.Testbench (assert, stimuliGenerator, outputVerifier) import CLaSH.Promoted.Nat import CLaSH.Promoted.Nat.TH import CLaSH.Promoted.Nat.Literals@@ -130,7 +137,7 @@ 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+window = window' systemClock {-# INLINE windowD #-} -- | Give a delayed window over a 'Signal'@@ -143,7 +150,7 @@ 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 = cwindowD systemClock+windowD = windowD' systemClock {-# INLINE registerB #-} -- | Create a 'register' function for product-type like signals (e.g. '(Signal a, Signal b)')@@ -153,8 +160,8 @@ -- -- >>> simulateB rP [(1,1),(2,2),(3,3),... -- [(8,8),(1,1),(2,2),(3,3),...-registerB :: Bundle a => a -> Unbundled' a -> Unbundled' a-registerB = cregisterB systemClock+registerB :: Bundle a => a -> Unbundled a -> Unbundled a+registerB = registerB' systemClock {-# INLINE isRising #-} -- | Give a pulse when the 'Signal' goes from 'minBound' to 'maxBound'@@ -162,7 +169,7 @@ => a -- ^ Starting value -> Signal a -> Signal Bool-isRising = cisRising systemClock+isRising = isRising' systemClock {-# INLINE isFalling #-} -- | Give a pulse when the 'Signal' goes from 'maxBound' to 'minBound'@@ -170,4 +177,4 @@ => a -- ^ Starting value -> Signal a -> Signal Bool-isFalling = cisFalling systemClock+isFalling = isFalling' systemClock
src/CLaSH/Prelude/BitIndex.hs view
@@ -4,6 +4,13 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Prelude.BitIndex where import GHC.TypeLits (KnownNat, type (+), type (-))
src/CLaSH/Prelude/BitReduction.hs view
@@ -1,6 +1,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Prelude.BitReduction where import GHC.TypeLits (KnownNat)
src/CLaSH/Prelude/BlockRam.hs view
@@ -6,10 +6,10 @@ import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding ((!!)) -import CLaSH.Prelude.Mealy (cmealy)+import CLaSH.Prelude.Mealy (mealy') import CLaSH.Signal (Signal)-import CLaSH.Signal.Explicit (CSignal, SClock, systemClock)-import CLaSH.Signal.Bundle (bundle)+import CLaSH.Signal.Explicit (Signal', SClock, systemClock)+import CLaSH.Signal.Bundle (bundle') import CLaSH.Sized.Unsigned (Unsigned) import CLaSH.Sized.Vector (Vec, (!!), replace) @@ -19,9 +19,11 @@ -- * __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)+-- @+-- bram40 :: 'Signal' ('Unsigned' 6) -> Signal ('Unsigned' 6) -> 'Signal' Bool+-- -> 'Signal' 'CLaSH.Sized.BitVector.Bit' -> Signal 'CLaSH.Sized.BitVector.Bit'+-- bram40 = 'blockRam' ('CLaSH.Sized.Vector.replicate' d40 1)+-- @ blockRam :: (KnownNat n, KnownNat m) => Vec n a -- ^ Initial content of the BRAM, also -- determines the size, @n@, of the BRAM.@@ -32,9 +34,9 @@ -> 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+ -- ^ Value of the @blockRAM@ at address @r@ from the previous clock -- cycle-blockRam = cblockRam systemClock+blockRam = blockRam' systemClock {-# INLINE blockRamPow2 #-} -- | Create a blockRAM with space for 2^@n@ elements@@ -42,9 +44,11 @@ -- * __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)+-- @+-- bram32 :: 'Signal' ('Unsigned' 5) -> Signal ('Unsigned' 5) -> 'Signal' Bool+-- -> 'Signal' 'CLaSH.Sized.BitVector.Bit' -> 'Signal' 'CLaSH.Sized.BitVector.Bit'+-- bram32 = 'blockRamPow2' ('CLaSH.Sized.Vector.replicate' d32 1)+-- @ blockRamPow2 :: (KnownNat (2^n), KnownNat n) => Vec (2^n) a -- ^ Initial content of the BRAM, also -- determines the size, @2^n@, of the BRAM.@@ -55,39 +59,41 @@ -> 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+ -- ^ Value of the @blockRAM@ at address @r@ from the previous clock -- cycle blockRamPow2 = blockRam -{-# NOINLINE cblockRam #-}+{-# NOINLINE blockRam' #-} -- | 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)+-- @+-- type ClkA = Clk \"A\" 100+--+-- clkA100 :: SClock ClkA+-- clkA100 = 'CLaSH.Signal.Explicit.sclock'+--+-- bram40 :: 'Signal'' ClkA ('Unsigned' 6) -> 'Signal'' ClkA ('Unsigned' 6)+-- -> 'Signal'' ClkA Bool -> 'Signal'' ClkA 'CLaSH.Sized.BitVector.Bit' -> ClkA 'Signal'' 'CLaSH.Sized.BitVector.Bit'+-- bram40 = 'blockRam'' clkA100 ('CLaSH.Sized.Vector.replicate' d40 1)+-- @+blockRam' :: (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+ -> Signal' clk (Unsigned m) -- ^ Write address @w@+ -> Signal' clk (Unsigned m) -- ^ Read address @r@+ -> Signal' clk Bool -- ^ Write enable+ -> Signal' clk a -- ^ Value to write (at address @w@)+ -> Signal' 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))+blockRam' clk binit wr rd en din =+ mealy' clk bram' (binit,undefined) (bundle' clk (wr,rd,en,din)) where bram' (ram,o) (w,r,e,d) = ((ram',o'),o) where@@ -95,32 +101,34 @@ | otherwise = ram o' = ram !! r -{-# INLINE cblockRamPow2 #-}+{-# 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' ----- > 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))+-- @+-- type ClkA = Clk \"A\" 100+--+-- clkA100 :: SClock ClkA+-- clkA100 = 'CLaSH.Signal.Explicit.sclock'+--+-- bram32 :: 'Signal'' ClkA ('Unsigned' 5) -> Signal' ClkA ('Unsigned' 5)+-- -> 'Signal'' ClkA Bool -> 'Signal'' ClkA 'CLaSH.Sized.BitVector.Bit' -> Signal' ClkA 'CLaSH.Sized.BitVector.Bit'+-- bram32 = 'blockRamPow2'' clkA100 ('CLaSH.Sized.Vector.replicate' d32 1)+-- @+blockRamPow2' :: (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+ -> Signal' clk (Unsigned n) -- ^ Write address @w@+ -> Signal' clk (Unsigned n) -- ^ Read address @r@+ -> Signal' clk Bool -- ^ Write enable+ -> Signal' clk a -- ^ Value to write (at address @w@)+ -> Signal' clk a+ -- ^ Value of the @blockRAM@ at address @r@ from the previous -- clock cycle-cblockRamPow2 = cblockRam+blockRamPow2' = blockRam'
src/CLaSH/Prelude/DataFlow.hs view
@@ -3,7 +3,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Self-synchronising circuits based on data-flow principles.+{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++Self-synchronising circuits based on data-flow principles.+-} module CLaSH.Prelude.DataFlow ( -- * Data types DataFlow@@ -30,9 +38,9 @@ import Control.Applicative (Applicative (..)) import GHC.TypeLits (KnownNat, KnownSymbol) -import CLaSH.Signal ((.&&.), regEn, unbundle')+import CLaSH.Signal ((.&&.), regEn, unbundle) import CLaSH.Signal.Bundle (Bundle (..))-import CLaSH.Signal.Explicit (Clock (..), CSignal, SystemClock, sclock)+import CLaSH.Signal.Explicit (Clock (..), Signal', SystemClock, sclock) {- | Dataflow circuit with bidirectional synchronisation channels. @@ -43,17 +51,17 @@ * Not consume data when validity is deasserted. * Only update its output when readiness is asserted. -The 'DataFlow' type is defined as:+The 'DataFlow'' type is defined as: @-newtype DataFlow clk iEn oEn i o+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.+ { df :: 'Signal'' clk i -- Incoming data+ -> 'Signal'' clk iEn -- Flagged with /valid/ bits @iEn@.+ -> 'Signal'' clk oEn -- Incoming back-pressure, /ready/ edge.+ -> ( 'Signal'' clk o -- Outgoing data.+ , 'Signal'' clk oEn -- Flagged with /valid/ bits @oEn@.+ , 'Signal'' clk iEn -- Outgoing back-pressure, /ready/ edge. ) } @@@ -76,63 +84,65 @@ 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+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.+ df :: Signal' clk i -- Incoming data+ -> Signal' clk iEn -- Flagged with /valid/ bits @iEn@.+ -> Signal' clk oEn -- Incoming back-pressure, /ready/ edge.+ -> ( Signal' clk o -- Outgoing data.+ , Signal' clk oEn -- Flagged with /valid/ bits @oEn@.+ , Signal' 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+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.--- > )+-- @+-- 'Signal'' clk i -- Incoming data.+-- -> 'Signal'' clk Bool -- Flagged with a single /valid/ bit.+-- -> 'Signal'' clk Bool -- Incoming back-pressure, /ready/ bit.+-- -> ( 'Signal'' clk o -- Outgoing data.+-- , 'Signal'' clk oEn -- Flagged with a single /valid/ bit.+-- , 'Signal'' 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 :: (Signal' clk i -> Signal' clk Bool -> Signal' clk Bool+ -> (Signal' clk o, Signal' clk Bool, Signal' 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+ -> DataFlow Bool Bool i o mealyDF f iS = DF (\i iV oR -> let en = iV .&&. oR- (s',o) = unbundle' (f <$> s <*> i)+ (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 :: 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+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))@@ -142,16 +152,16 @@ -- -- <<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)+ => 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+ (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)+ bc = bundle' clk (b,c)+ bcV = bundle' clk (bV,cV)+ acR = bundle' clk (aR,cR) in (bc,bcV,acR) ) @@ -159,7 +169,7 @@ -- -- <<doc/swapDF.svg>> swapDF :: (KnownSymbol nm, KnownNat rate)- => DataFlow (Clk nm rate) (aEn,bEn) (bEn,aEn) (a,b) (b,a)+ => 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)@@ -169,24 +179,26 @@ -- -- <<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)+ => 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)+ => 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+-- @+-- 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@@ -196,23 +208,23 @@ -- -- <<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+ => 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 :: 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' :: 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)+ (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) ) @@ -222,19 +234,25 @@ -- -- Given: --- -- > f :: DataFlow' Bool Bool a b- -- > g :: DataFlow' Bool Bool c d- -- > h :: DataFlow' Bool Bool (b,d) (p,q)+ -- @+ -- __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+ -- @+ -- (f \`@'parDF'@\` g) \`@'seqDF'@\` h+ -- @ --- -- because, @f \`parDF\` g@, has type, @DataFlow' (Bool,Bool) (Bool,Bool) (a,c) (b,d)@,+ -- 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)+ -- @+ -- '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@@ -248,40 +266,50 @@ -- The 'lockStep' function ensures that all synchronisation signals are -- properly connected: --- -- > (f `parDF` g) `seqDF` lockStep `seqDF` h+ -- @+ -- (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+ -- @+ -- 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+ => 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)+ -- @+ -- __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)+ -- @+ -- h \`@'seqDF'@\` (f \`@'parDF'@\` g)+ -- @ --- -- because, @f \`parDF\` g@, has type, @DataFlow' (Bool,Bool) (Bool,Bool) (a,c) (b,d)@,+ -- 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)+ -- @+ -- '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@@ -295,22 +323,26 @@ -- The 'stepLock' function ensures that all synchronisation signals are -- properly connected: --- -- > h `seqDF` stepLock `seqDF` (f `parDF` g)+ -- @+ -- 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+ -- @+ -- 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+ => DataFlow' (Clk nm rate) Bool a b b instance LockStep Bool c where lockStep = idDF@@ -319,18 +351,18 @@ 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+ (xV,yV) = unbundle' clk xyV val = xV .&&. yV xR = yV .&&. rdy yR = xV .&&. rdy- xyR = bundle clk (xR,yR)+ xyR = bundle' clk (xR,yR) in (xy,val,xyR))) stepLock = (DF (\xy val xyR -> let clk = sclock- (xR,yR) = unbundle clk xyR+ (xR,yR) = unbundle' clk xyR rdy = xR .&&. yR xV = val .&&. yR yV = val .&&. xR- xyV = bundle clk (xV,yV)+ xyV = bundle' clk (xV,yV) in (xy,xyV,rdy))) `seqDF` (stepLock `parDF` stepLock)
src/CLaSH/Prelude/Explicit.hs view
@@ -2,32 +2,37 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} -{- |- This module defines the explicitly clocked counterparts of the functions- defined in "CLaSH.Prelude".+{-# OPTIONS_HADDOCK show-extensions #-} - This module uses the explicitly clocked 'CSignal's synchronous signals, as- opposed to the implicitly clocked 'Signal's used in "CLaSH.Prelude". Take a- look at "CLaSH.Signal.Explicit" to see how you can make multi-clock designs- using explicitly clocked signals.+{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++This module defines the explicitly clocked counterparts of the functions+defined in "CLaSH.Prelude".++This module uses the explicitly clocked 'Signal'' synchronous signals, as+opposed to the implicitly clocked 'Signal' used in "CLaSH.Prelude". Take a+look at "CLaSH.Signal.Explicit" to see how you can make multi-clock designs+using explicitly clocked signals. -} module CLaSH.Prelude.Explicit ( -- * Creating synchronous sequential circuits- cmealy- , cmealyB- , cregisterB+ mealy'+ , mealyB'+ , registerB' -- * BlockRAM primitives- , cblockRam- , cblockRamPow2+ , blockRam'+ , blockRamPow2' -- * Utility functions- , cwindow- , cwindowD- , cisRising- , cisFalling+ , window'+ , windowD'+ , isRising'+ , isFalling' -- * Testbench functions- , csassert- , cstimuliGenerator- , coutputVerifier+ , stimuliGenerator'+ , outputVerifier' -- * Exported modules -- ** Explicitly clocked synchronous signals , module CLaSH.Signal.Explicit@@ -39,85 +44,104 @@ import GHC.TypeLits (KnownNat, type (+), natVal) import Prelude hiding (repeat) -import CLaSH.Prelude.BlockRam (cblockRam, cblockRamPow2)-import CLaSH.Prelude.Mealy (cmealy, cmealyB)-import CLaSH.Prelude.Testbench (csassert, cstimuliGenerator, coutputVerifier)+import CLaSH.Prelude.BlockRam (blockRam', blockRamPow2')+import CLaSH.Prelude.Mealy (mealy', mealyB')+import CLaSH.Prelude.Testbench (stimuliGenerator', outputVerifier') import CLaSH.Signal.Explicit import CLaSH.Sized.Vector (Vec (..), (+>>), asNatProxy, repeat) -{-# INLINE cregisterB #-}+{-# INLINE registerB' #-} -- | Create a 'register' function for product-type like signals (e.g.--- '(Signal a, Signal b)')+-- @('Signal' a, 'Signal' b)@) ----- > clk100 = Clock d100--- >--- > rP :: (CSignal 100 Int, CSignal 100 Int) -> (CSignal 100 Int, CSignal 100 Int)--- > rP = cregisterB d100 (8,8)+-- @+-- type ClkA = 'Clk' \"A\" 100 ----- >>> csimulateB clk100 clk100 rP [(1,1),(2,2),(3,3),...+-- clkA100 :: 'SClock' ClkA+-- clkA100 = 'sclock'+--+-- rP :: ('Signal'' ClkA Int, 'Signal'' ClkA Int) -> ('Signal'' ClkA Int, 'Signal'' ClkA Int)+-- rP = 'registerB'' clkA100 (8,8)+-- @+--+-- >>> simulateB' rP [(1,1),(2,2),(3,3),... -- [(8,8),(1,1),(2,2),(3,3),...-cregisterB :: Bundle a => SClock clk -> a -> Unbundled clk a -> Unbundled clk a-cregisterB clk i = unbundle clk Prelude.. cregister clk i Prelude.. bundle clk+registerB' :: Bundle a => SClock clk -> a -> Unbundled' clk a -> Unbundled' clk a+registerB' clk i = unbundle' clk Prelude.. register' clk i Prelude.. bundle' clk -{-# INLINABLE cwindow #-}--- | Give a window over a 'CSignal'+{-# INLINABLE window' #-}+-- | Give a window over a 'Signal'' ----- > window4 :: Signal Int -> Vec 4 (Signal Int)--- > window4 = window+-- @+-- type ClkA = 'Clk' \"A\" 100 ----- >>> csimulateB window4 [1,2,3,4,5,...+-- clkA100 :: 'SClock' ClkA+-- clkA100 = 'sclock'+--+-- window4 :: 'Signal'' ClkA Int -> 'Vec' 4 ('Signal'' ClkA Int)+-- window4 = 'window'' clkA100+-- @+--+-- >>> simulateB' clkA100 clkA100 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, Default a)+window' :: (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+ -> Signal' clk a -- ^ Signal to create a window over+ -> Vec (n + 1) (Signal' clk a) -- ^ Window of at least size 1+window' clk x = res where res = x :> prev prev = case natVal (asNatProxy prev) of 0 -> repeat def _ -> let next = x +>> prev- in cregisterB clk (repeat def) next+ in registerB' clk (repeat def) next -{-# INLINABLE cwindowD #-}--- | Give a delayed window over a 'CSignal'+{-# INLINABLE windowD' #-}+-- | Give a delayed window over a 'Signal'' ----- > windowD3 :: Signal Int -> Vec 3 (Signal Int)--- > windowD3 = windowD+-- @+-- type ClkA = 'Clk' \"A\" 100 ----- >>> csimulateB windowD3 [1,2,3,4,...+-- clkA100 :: 'SClock' ClkA+-- clkA100 = 'sclock'+--+-- windowD3 :: 'Signal'' ClkA Int -> 'Vec' 3 ('Signal'' ClkA Int)+-- windowD3 = 'windowD'+-- @+--+-- >>> simulateB' clkA100 clkA100 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)+windowD' :: (KnownNat (n + 1), 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-cwindowD clk x = prev+ -> Signal' clk a -- ^ Signal to create a window over+ -> Vec (n + 1) (Signal' clk a) -- ^ Window of at least size 1+windowD' clk x = prev where- prev = cregisterB clk (repeat def) next+ prev = registerB' clk (repeat def) next next = x +>> prev -{-# INLINABLE cisRising #-}--- | Give a pulse when the 'CSignal' goes from 'minBound' to 'maxBound'-cisRising :: (Bounded a, Eq a)+{-# INLINABLE isRising' #-}+-- | Give a pulse when the 'Signal'' goes from 'minBound' to 'maxBound'+isRising' :: (Bounded a, Eq a) => SClock clk -> a -- ^ Starting value- -> CSignal clk a- -> CSignal clk Bool-cisRising clk is s = liftA2 edgeDetect prev s+ -> Signal' clk a+ -> Signal' clk Bool+isRising' clk is s = liftA2 edgeDetect prev s where- prev = cregister clk is s+ prev = register' clk is s edgeDetect old new = old == minBound && new == maxBound -{-# INLINABLE cisFalling #-}--- | Give a pulse when the 'CSignal' goes from 'maxBound' to 'minBound'-cisFalling :: (Bounded a, Eq a)+{-# INLINABLE isFalling' #-}+-- | Give a pulse when the 'Signal'' goes from 'maxBound' to 'minBound'+isFalling' :: (Bounded a, Eq a) => SClock clk -> a -- ^ Starting value- -> CSignal clk a- -> CSignal clk Bool-cisFalling clk is s = liftA2 edgeDetect prev s+ -> Signal' clk a+ -> Signal' clk Bool+isFalling' clk is s = liftA2 edgeDetect prev s where- prev = cregister clk is s+ prev = register' clk is s edgeDetect old new = old == maxBound && new == minBound
src/CLaSH/Prelude/Mealy.hs view
@@ -1,61 +1,72 @@+{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Prelude.Mealy ( -- * Mealy machine synchronised to the system clock mealy , mealyB , (<^>) -- * Mealy machine synchronised to an arbitrary clock- , cmealy- , cmealyB+ , mealy'+ , mealyB' ) where import Control.Applicative ((<$>), (<*>)) -import CLaSH.Signal (Signal, Unbundled')-import CLaSH.Signal.Explicit (CSignal, SClock, cregister, systemClock)-import CLaSH.Signal.Bundle (Bundle (..), Unbundled)+import CLaSH.Signal (Signal, Unbundled)+import CLaSH.Signal.Explicit (Signal', SClock, register', 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+-- @+-- 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))+-- @+-- dualMac :: ('Signal' Int, 'Signal' Int)+-- -> ('Signal' Int, 'Signal' Int)+-- -> 'Signal' Int+-- dualMac (a,b) (x,y) = s1 + s2+-- where+-- s1 = 'mealy' mac 0 ('CLaSH.Signal.bundle' (a,x))+-- s2 = 'mealy' mac 0 ('CLaSH.Signal.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+mealy = mealy' 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))+-- @+-- __f__ :: Int -> (Bool, Int) -> (Int, (Int, Bool))+-- @ -- -- When we want to make compositions of @f@ in @g@ using 'mealy', we have to -- write:@@ -63,24 +74,26 @@ -- @ -- 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)))+-- (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)+-- @+-- 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)+ -> (Unbundled i -> Unbundled o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine-mealyB = cmealyB systemClock+mealyB = mealyB' systemClock {-# INLINE (<^>) #-} -- | Infix version of 'mealyB'@@ -88,80 +101,91 @@ => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form: -- @state -> input -> (newstate,output)@ -> s -- ^ Initial state- -> (Unbundled' i -> Unbundled' o)+ -> (Unbundled i -> Unbundled o) -- ^ Synchronous sequential function with input and output matching that -- of the mealy machine (<^>) = mealyB -{-# INLINABLE cmealy #-}+{-# INLINABLE 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--- >--- > clk100 = Clock d100--- >--- > topEntity :: CSignal 100 (Int, Int) -> CSignal 100 Int--- > topEntity = cmealy clk100 mac 0+-- @+-- mac :: Int -- Current state+-- -> (Int,Int) -- Input+-- -> (Int,Int) -- (Updated state, output)+-- mac s (x,y) = (s',s)+-- where+-- s' = x * y + s ----- >>> csimulate clk100 clk100 topEntity [(1,1),(2,2),(3,3),(4,4),...+-- type ClkA = 'CLaSH.Signal.Explicit.Clk' \"A\" 100+--+-- clkA100 :: 'SClock' ClkA+-- clkA100 = 'CLaSH.Signal.Explicit.sclock'+--+-- topEntity :: 'Signal'' ClkA (Int, Int) -> 'Signal'' ClkA Int+-- topEntity = 'mealy'' clkA100 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 :: (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+-- @+-- dualMac :: ('Signal'' clkA100 Int, 'Signal'' clkA100 Int)+-- -> ('Signal'' clkA100 Int, 'Signal'' clkA100 Int)+-- -> 'Signal'' clkA100 Int+-- dualMac (a,b) (x,y) = s1 + s2+-- where+-- s1 = 'mealy'' clkA100 mac 0 ('CLaSH.Signal.Explicit.bundle'' clkA100 (a,x))+-- s2 = 'mealy'' clkA100 mac 0 ('CLaSH.Signal.Explicit.bundle'' clkA100 (b,y))+-- @+mealy' :: 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)+ -> (Signal' clk i -> Signal' 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'+mealy' clk f iS = \i -> let (s',o) = unbundle' clk $ f <$> s <*> i+ s = register' clk iS s' in o -{-# INLINE cmealyB #-}--- | A version of 'cmealy' that does automatic 'Bundle'ing+{-# INLINE mealyB' #-}+-- | A version of 'mealy'' that does automatic 'Bundle'ing -- -- Given a function @f@ of type: ----- > f :: Int -> (Bool,Int) -> (Int,(Int,Bool))+-- @+-- __f__ :: Int -> (Bool,Int) -> (Int,(Int,Bool))+-- @ ----- When we want to make compositions of @f@ in @g@ using 'cmealy', we have to+-- When we want to make compositions of @f@ in @g@ using 'mealy'', 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)))+-- (i1,b1) = 'CLaSH.Signal.Explicit.unbundle'' clk (mealy' clk f 0 ('CLaSH.Signal.Explicit.bundle'' clk (a,b)))+-- (i2,b2) = 'CLaSH.Signal.Explicit.unbundle'' clk (mealy' clk f 3 ('CLaSH.Signal.Explicit.bundle'' clk (i1,c))) -- @ ----- Using 'cmealyB' however we can write:+-- Using 'mealyB'' 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)+-- @+-- g clk a b c = (b1,b2,i2)+-- where+-- (i1,b1) = 'mealyB'' clk f 0 (a,b)+-- (i2,b2) = 'mealyB'' clk f 3 (i1,c)+-- @+mealyB' :: (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)+ -> (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))+mealyB' clk f iS i = unbundle' clk (mealy' clk f iS (bundle' clk i))
src/CLaSH/Prelude/Testbench.hs view
@@ -1,14 +1,20 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Prelude.Testbench ( -- * Testbench functions for circuits synchronised to the system slock- sassert+ assert , stimuliGenerator , outputVerifier -- * Testbench functions for circuits synchronised to arbitrary clocks- , csassert- , cstimuliGenerator- , coutputVerifier+ , stimuliGenerator'+ , outputVerifier' ) where @@ -18,40 +24,11 @@ import Prelude hiding ((!!)) import CLaSH.Signal (Signal)-import CLaSH.Signal.Explicit (CSignal, SClock, cregister, systemClock)-import CLaSH.Signal.Bundle (unbundle)+import CLaSH.Signal.Explicit (Signal', SClock, register', 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@@ -59,15 +36,17 @@ -- -- Example: ----- > testInput :: Signal Int--- > testInput = stimuliGenerator $(v [(1::Int),3..21])+-- @+-- testInput :: 'Signal' Int+-- testInput = 'stimuliGenerator' $('CLaSH.Sized.Vector.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+stimuliGenerator = stimuliGenerator' systemClock {-# INLINE outputVerifier #-} -- | To be used as a functions to generate the \"magical\" 'expectedOutput'@@ -76,8 +55,10 @@ -- -- Example: ----- > expectedOutput :: Signal Int -> Signal Bool--- > expectedOutput = outputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int]))+-- @+-- expectedOutput :: 'Signal' Int -> 'Signal' Bool+-- expectedOutput = 'outputVerifier' $('CLaSH.Sized.Vector.v' ([70,99,2,3,4,5,7,8,9,10]::[Int]))+-- @ -- -- >>> sample (expectedOutput (fromList ([0..10] ++ [10,10,10]))) -- [@@ -97,37 +78,22 @@ => Vec l a -- ^ Samples to compare with -> Signal a -- ^ Signal to verify -> Signal Bool -- ^ Indicator that all samples are verified-outputVerifier = coutputVerifier systemClock+outputVerifier = outputVerifier' systemClock -{-# NOINLINE csassert #-}+{-# NOINLINE assert #-} -- | 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+-- __NB__: This function is /can/ be used in synthesizable designs.+assert :: (Eq a,Show a)+ => Signal' t a -- ^ Checked value+ -> Signal' t a -- ^ Expected value+ -> Signal' t b -- ^ Return valued+ -> Signal' t b+assert = liftA3 (\a' b' c' -> if a' == b' then c' else trace (concat [ "\nexpected value: " , show b'@@ -135,30 +101,32 @@ , show a' ]) c') -{-# INLINABLE cstimuliGenerator #-}+{-# 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: ----- > type ClkA = Clk "A" 100--- >--- > clkA :: SClock ClkA--- > clkA = sclock--- >--- > testInput :: CSignal clkA Int--- > testInput = cstimuliGenerator clkA $(v [(1::Int),3..21])+-- @+-- type ClkA = 'CLaSH.Signal.Explicit.Clk' \"A\" 100 ----- >>> csample testInput+-- clkA :: 'SClock' ClkA+-- clkA = 'CLaSH.Signal.Explicit.sclock'+--+-- testInput :: 'Signal'' clkA Int+-- testInput = 'stimuliGenerator'' clkA $('CLaSH.Sized.Vector.v' [(1::Int),3..21])+-- @+--+-- >>> sample testInput -- [1,3,5,7,9,11,13,15,17,19,21,21,21,...-cstimuliGenerator :: forall l clk a . KnownNat l+stimuliGenerator' :: 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)+ -> Signal' clk a -- ^ Signal of given samples+stimuliGenerator' clk samples =+ let (r,o) = unbundle' clk (genT <$> register' clk 0 r) in o where genT :: Index l -> (Index l,a)@@ -170,22 +138,24 @@ then s + 1 else s -{-# INLINABLE coutputVerifier #-}+{-# 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: ----- > 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]))+-- @+-- type ClkA = 'CLaSH.Signal.Explicit.Clk' \"A\" 100 ----- >>> csample (expectedOutput (cfromList ([0..10] ++ [10,10,10])))+-- clkA :: 'SClock' ClkA+-- clkA = 'CLaSH.Signal.Explicit.sclock'+--+-- expectedOutput :: 'Signal'' ClkA Int -> 'Signal'' ClkA Bool+-- expectedOutput = 'outputVerifier'' clkA $('CLaSH.Sized.Vector.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,@@ -199,16 +169,16 @@ -- False, -- expected value: 10, not equal to actual value: 9 -- False,True,True,...-coutputVerifier :: forall l clk a . (KnownNat l, Eq a, Show a)+outputVerifier' :: 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)+ -> Signal' clk a -- ^ Signal to verify+ -> Signal' clk Bool -- ^ Indicator that all samples are verified+outputVerifier' clk samples i =+ let (s,o) = unbundle' clk (genT <$> register' clk 0 s)+ (e,f) = unbundle' clk o+ in assert i e (register' clk False f) where genT :: Index l -> (Index l,(a,Bool)) genT s = (s',(samples !! s,finished))
src/CLaSH/Promoted/Nat.hs view
@@ -3,6 +3,14 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Promoted.Nat ( SNat (..), snat, withSNat, snatToInteger , UNat (..), toUNat, addUNat, multUNat, powUNat
src/CLaSH/Promoted/Nat/Literals.hs view
@@ -1,15 +1,27 @@-{-# LANGUAGE TemplateHaskell, DataKinds #-}--- | Predefined 'SNat' singleton literals in the range [0 .. 1024]------ Defines:------ > d0 = snat :: SNat 0--- > d1 = snat :: SNat 1--- > d2 = snat :: SNat 2--- > ...--- > d1024 = snat :: SNat 1024------ You can generate more 'SNat' literals using 'decLiteralsD' from "CLaSH.Promoted.Nat.TH"+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DataKinds #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++Predefined 'SNat' singleton literals in the range [0 .. 1024]++Defines:++@+d0 = snat :: SNat 0+d1 = snat :: SNat 1+d2 = snat :: SNat 2+...+d1024 = snat :: SNat 102+@++You can generate more 'SNat' literals using 'decLiteralsD' from "CLaSH.Promoted.Nat.TH"+-} module CLaSH.Promoted.Nat.Literals where import CLaSH.Promoted.Nat.TH
src/CLaSH/Promoted/Nat/TH.hs view
@@ -1,4 +1,12 @@ {-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Promoted.Nat.TH where import Language.Haskell.TH
src/CLaSH/Promoted/Ord.hs view
@@ -2,6 +2,14 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Promoted.Ord where import Data.Type.Bool
src/CLaSH/Promoted/Symbol.hs view
@@ -1,6 +1,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Promoted.Symbol where import Data.Proxy (Proxy (..))
src/CLaSH/Signal.hs view
@@ -1,5 +1,13 @@ {-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Signal ( -- * Implicitly clocked synchronous signal Signal@@ -12,9 +20,9 @@ , (.&&.), (.||.), not1 -- * Product/Signal isomorphism , Bundle- , Unbundled'- , bundle'- , unbundle'+ , Unbundled+ , bundle+ , unbundle -- * Simulation functions (not synthesisable) , simulate , simulateB@@ -49,31 +57,25 @@ ) 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)+import Data.Bits (Bits) -- Haddock only +import CLaSH.Signal.Internal (Signal', register#, regEn#, (.==.), (./=.),+ compare1, (.<.), (.<=.), (.>=.), (.>.), fromEnum1,+ toRational1, toInteger1, testBit1, popCount1,+ shift1, rotate1, setBit1, clearBit1, shiftL1,+ unsafeShiftL1, shiftR1, unsafeShiftR1, rotateL1,+ rotateR1, (.||.), (.&&.), not1, mux, sample,+ sampleN, fromList, simulate, signal)+import CLaSH.Signal.Explicit (SystemClock, systemClock, simulateB')+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+type Signal a = Signal' 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@@@ -88,8 +90,8 @@ -- is asserted. So given: -- -- @--- oscillate = register False ('not1' oscillate)--- count = regEn 0 oscillate (count + 1)+-- oscillate = 'register' False ('not1' oscillate)+-- count = 'regEn' 0 oscillate (count + 1) -- @ -- -- We get:@@ -105,84 +107,44 @@ -- | 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+type Unbundled a = Unbundled' SystemClock a -{-# INLINE unbundle' #-}+{-# INLINE unbundle #-} -- | Example: ----- > unbundle' :: Signal (a,b) -> (Signal a, Signal b)+-- @+-- __unbundle__ :: 'Signal' (a,b) -> ('Signal' a, 'Signal' b)+-- @ -- -- However: ----- > unbundle' :: Signal Bit -> Signal Bit-unbundle' :: Bundle a => Signal a -> Unbundled' a-unbundle' = unbundle systemClock+-- @+-- __unbundle__ :: 'Signal' 'CLaSH.Sized.BitVector.Bit' -> 'Signal' 'CLaSH.Sized.BitVector.Bit'+-- @+unbundle :: Bundle a => Signal a -> Unbundled a+unbundle = unbundle' systemClock -{-# INLINE bundle' #-}+{-# INLINE bundle #-} -- | Example: ----- > bundle' :: (Signal a, Signal b) -> Signal (a,b)+-- @+-- __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+-- @+-- __bundle__ :: 'Signal' 'CLaSH.Sized.BitVector.Bit' -> 'Signal' 'CLaSH.Sized.BitVector.Bit'+-- @+bundle :: Bundle a => Unbundled a -> Signal a+bundle = bundle' systemClock --- | Create a 'Signal' from a list------ Every element in the list will correspond to a value of the signal for one--- clock cycle.+-- | Simulate a (@'Unbundled' a -> 'Unbundled' b@) function given a list of+-- samples of type @a@ ----- >>> sampleN 2 (fromList [1,2,3,4,5])--- [1,2]+-- >>> simulateB (unbundle . register (8,8) . bundle) [(1,1), (2,2), (3,3)] :: [(Int,Int)]+-- [(8,8), (1,1), (2,2), (3,3),*** Exception: finite list -- -- __NB__: This function is not synthesisable-fromList :: [a] -> Signal a-fromList = cfromList+simulateB :: (Bundle a, Bundle b) => (Unbundled a -> Unbundled b) -> [a] -> [b]+simulateB = simulateB' systemClock systemClock
src/CLaSH/Signal/Bundle.hs view
@@ -4,7 +4,15 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} --- | The Product/Signal isomorphism+{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++The Product/Signal isomorphism+-} module CLaSH.Signal.Bundle ( Bundle (..) )@@ -15,7 +23,7 @@ import GHC.TypeLits (KnownNat) import Prelude hiding (head, map, tail) -import CLaSH.Signal.Internal (Clock, CSignal (..), SClock)+import CLaSH.Signal.Internal (Clock, Signal' (..), SClock) import CLaSH.Sized.BitVector (BitVector) import CLaSH.Sized.Fixed (Fixed) import CLaSH.Sized.Index (Index)@@ -23,42 +31,71 @@ 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.+-- | Isomorphism between a 'CLaSH.Signal.Signal' of a product type (e.g. a tuple) and a+-- product type of 'CLaSH.Signal.Signal''s. -- -- Instances of 'Bundle' must satisfy the following laws: -- -- @--- bundle . unbundle = 'id'--- unbundle . bundle = 'id'+-- 'bundle'' . 'unbundle'' = 'id'+-- 'unbundle'' . 'bundle'' = 'id' -- @+--+-- By default, 'bundle'' and 'unbundle'', are defined as the identity, that is,+-- writing:+--+-- @+-- data D = A | B+--+-- instance 'Bundle' D+-- @+--+-- is the same as:+--+-- @+-- data D = A | B+--+-- instance 'Bundle' D where+-- type 'Unbundled'' clk D = 'Signal'' clk D+-- 'bundle'' _ s = s+-- 'unbundle'' _ s = s+-- @+-- class Bundle a where- type Unbundled (clk :: Clock) a- type Unbundled clk a = CSignal clk a+ type Unbundled' (clk :: Clock) a+ type Unbundled' clk a = Signal' clk a -- | Example: --- -- > bundle :: (CSignal clk a, CSignal clk b) -> CSignal clk (a,b)+ -- @+ -- __bundle'__ :: ('Signal'' clk a, 'Signal'' clk b) -> 'Signal'' clk (a,b)+ -- @ -- -- However: --- -- > bundle :: CSignal clk Bit -> CSignal clk Bit- bundle :: SClock clk -> Unbundled clk a -> CSignal clk a+ -- @+ -- __bundle'__ :: 'Signal'' clk 'CLaSH.Sized.BitVector.Bit' -> 'Signal'' clk 'CLaSH.Sized.BitVector.Bit'+ -- @+ bundle' :: SClock clk -> Unbundled' clk a -> Signal' clk a - {-# INLINE bundle #-}- default bundle :: SClock clk -> CSignal clk a -> CSignal clk a- bundle _ s = s+ {-# INLINE bundle' #-}+ default bundle' :: SClock clk -> Signal' clk a -> Signal' clk a+ bundle' _ s = s -- | Example: --- -- > unbundle :: CSignal clk (a,b) -> (CSignal clk a, CSignal clk b)+ -- @+ -- __unbundle'__ :: 'Signal'' clk (a,b) -> ('Signal'' clk a, 'Signal'' clk b)+ -- @ -- -- However: --- -- > unbundle :: CSignal clk Bit -> CSignal clk Bit- unbundle :: SClock clk -> CSignal clk a -> Unbundled clk a+ -- @+ -- __unbundle'__ :: 'Signal'' clk 'CLaSH.Sized.BitVector.Bit' -> 'Signal'' clk 'CLaSH.Sized.BitVector.Bit'+ -- @+ unbundle' :: SClock clk -> Signal' clk a -> Unbundled' clk a - {-# INLINE unbundle #-}- default unbundle :: SClock clk -> CSignal clk a -> CSignal clk a- unbundle _ s = s+ {-# INLINE unbundle' #-}+ default unbundle' :: SClock clk -> Signal' clk a -> Signal' clk a+ unbundle' _ s = s instance Bundle Bool instance Bundle Integer@@ -76,94 +113,94 @@ 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)+ type Unbundled' t (a,b) = (Signal' t a, Signal' 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- )+ type Unbundled' t (a,b,c) = (Signal' t a, Signal' t b, Signal' 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- )+ type Unbundled' t (a,b,c,d) = ( Signal' t a, Signal' t b, Signal' t c+ , Signal' 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- )+ type Unbundled' t (a,b,c,d,e) = ( Signal' t a, Signal' t b, Signal' t c+ , Signal' t d, Signal' 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- )+ type Unbundled' t (a,b,c,d,e,f) = ( Signal' t a, Signal' t b, Signal' t c+ , Signal' t d, Signal' t e, Signal' 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+ type Unbundled' t (a,b,c,d,e,f,g) = ( Signal' t a, Signal' t b, Signal' t c+ , Signal' t d, Signal' t e, Signal' t f+ , Signal' 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- )+ 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+ type Unbundled' t (a,b,c,d,e,f,g,h) = ( Signal' t a, Signal' t b, Signal' t c+ , Signal' t d, Signal' t e, Signal' t f+ , Signal' t g, Signal' 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- )+ 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)+ type Unbundled' t (Vec n a) = Vec n (Signal' t a) -- The 'Traversable' instance of 'Vec' is not synthesisable, so we must- -- define 'bundle' as a primitive.- bundle = vecBundle#- unbundle _ = sequenceA+ -- 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# :: SClock t -> Vec n (Signal' t a) -> Signal' t (Vec n a) vecBundle# _ = sequenceA
src/CLaSH/Signal/Delayed.hs view
@@ -1,41 +1,53 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} 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+ -- * Experimental+ , unsafeFromSignal+ , antiDelay ) where +import Data.Bits (Bits, FiniteBits) import Data.Coerce (coerce) import Data.Default (Default(..))-import Control.Applicative (Applicative (..))+import Data.Foldable (Foldable)+import Data.Traversable (Traversable)+import Control.Applicative (Applicative (..), liftA2) import GHC.TypeLits (KnownNat, Nat, type (-)) import Language.Haskell.TH.Syntax (Lift) import Prelude hiding (head, length, repeat) +import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum)+import CLaSH.Promoted.Nat (SNat) import CLaSH.Sized.Vector (Vec, head, length, repeat, shiftInAt0, singleton)--import CLaSH.Signal (Signal, fromList, register, sample, sampleN,- bundle', unbundle')+import CLaSH.Signal (Signal, fromList, register, bundle, unbundle) -- | A synchronized signal with samples of type @a@, synchronized to \"system\" -- clock (period 1000), that has accumulated @delay@ amount of samples delay@@ -44,56 +56,37 @@ DSignal { -- | Strip a 'DSignal' from its delay information. toSignal :: Signal a }- deriving (Show,Default,Lift,Functor,Applicative,Num)+ deriving (Show,Default,Lift,Functor,Applicative,Num,Bounded,Fractional,+ Real,Integral,SaturatingNum,Eq,Ord,Enum,Bits,FiniteBits,Foldable,+ Traversable) +instance ExtendingNum a b => ExtendingNum (DSignal n a) (DSignal n b) where+ type AResult (DSignal n a) (DSignal n b) = DSignal n (AResult a b)+ plus = liftA2 plus+ minus = liftA2 minus+ type MResult (DSignal n a) (DSignal n b) = DSignal n (MResult a b)+ times = liftA2 times+ -- | 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])+-- >>> sampleN 2 (dfromList [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)+-- @+-- delay3 :: 'DSignal' (n - 3) Int -> 'DSignal' n Int+-- delay3 = 'delay' (0 ':>' 0 ':>' 0 ':>' 'Nil')+-- @ ----- >>> dsampleN 6 (delay3 (dfromList [1..]))+-- >>> sampleN 6 (delay3 (dfromList [1..])) -- [0,0,0,1,2,3] delay :: forall a n m . KnownNat m => Vec m a@@ -104,16 +97,18 @@ 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')+ _ -> 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+-- @+-- delay2 :: 'DSignal' (n - 2) Int -> 'DSignal' n Int+-- delay2 = 'delayI'+-- @ ----- >>> dsampleN 6 (delay2 (dfromList [1..])+-- >>> sampleN 6 (delay2 (dfromList [1..]) -- [0,0,1,2,3,4] delayI :: (Default a, KnownNat m) => DSignal (n - m) a@@ -123,16 +118,16 @@ -- | Feed the delayed result of a function back to its input: -- -- @--- mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int+-- 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' :: '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')+-- in (acc, 'delay' ('singleton' 0) acc') -- @ ----- >>> dsampleN 6 (mac (dfromList [1..]) (dfromList [1..]))+-- >>> sampleN 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@@ -144,10 +139,25 @@ fromSignal :: Signal a -> DSignal 0 a fromSignal = coerce ---- | __Unsafely__ convert a 'Signal' to /any/ 'DSignal'.+-- | __EXPERIMENTAL__ --+-- __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++-- | __EXPERIMENTAL__+--+-- Access a /delayed/ signal in the present.+--+-- @+-- mac :: 'DSignal' 0 Int -> 'DSignal' 0 Int -> 'DSignal' 0 Int+-- mac x y = acc'+-- where+-- acc' = (x * y) + 'antiDelay' d1 acc+-- acc = 'delay' ('singleton' 0) acc'+-- @+antiDelay :: SNat d -> DSignal n a -> DSignal (n - d) a+antiDelay _ = coerce
src/CLaSH/Signal/Explicit.hs view
@@ -2,10 +2,17 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Signal.Explicit ( -- * Explicitly clocked synchronous signal -- $relativeclocks- CSignal+ Signal' -- * Clock domain crossing -- ** Clock , Clock (..)@@ -15,37 +22,30 @@ , SystemClock , systemClock -- ** Synchronisation primitive- , veryUnsafeSynchronizer+ , unsafeSynchronizer -- * Basic circuit functions- , csignal- , cregister- , cregEn+ , register'+ , regEn' -- * Product/Signal isomorphism , Bundle (..) -- * Simulation functions (not synthesisable)- , csimulate- , csimulateB- -- * List \<-\> CSignal conversion (not synthesisable)- , csample- , csampleN- , cfromList+ , simulateB' ) where -import qualified Data.Foldable as F-import GHC.TypeLits (KnownNat, KnownSymbol)+import GHC.TypeLits (KnownNat, KnownSymbol) -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)+import CLaSH.Promoted.Nat (snat, snatToInteger)+import CLaSH.Promoted.Symbol (ssymbol)+import CLaSH.Signal.Internal (Signal' (..), Clock (..), SClock (..), register#,+ regEn#, simulate)+import CLaSH.Signal.Bundle (Bundle (..), Unbundled') {- $relativeclocks #relativeclocks# CλaSH supports explicitly clocked 'CLaSH.Signal's in the form of: @-'CSignal' (clk :: 'Clock') a+'Signal'' (clk :: 'Clock') a @ Where @a@ is the type of the elements, and @clk@ is the clock to which the@@ -71,14 +71,14 @@ signal: @-'CSignal' ClkA500 a+'Signal'' ClkA500 a @ is synchronized to a clock that runs 6.5 times faster than the clock to which the signal: @-'CSignal' ClkB3250 a+'Signal'' ClkB3250 a @ is synchronized to.@@ -95,6 +95,13 @@ {-# INLINE sclock #-} -- | Create a singleton clock+--+-- @+-- type ClkA = 'Clk' \"A\" 100+--+-- clkA :: 'SClock' ClkA+-- clkA = 'sclock'+-- @ sclock :: (KnownSymbol name, KnownNat period) => SClock (Clk name period) sclock = SClock ssymbol snat@@ -114,62 +121,72 @@ systemClock = sclock -- ** Synchronisation primitive-{-# NOINLINE veryUnsafeSynchronizer #-}--- | The 'veryUnsafeSynchronizer' function is a primitive that must be used to+{-# NOINLINE unsafeSynchronizer #-}+-- | The 'unsafeSynchronizer' 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: ----- > dualFlipFlop :: SClock clkA -> SClock clkB--- > -> CSignal clkA Bit -> CSignal clkB Bit--- > dualFlipFlop clkA clkB = cregister clkB low . cregister clkB low--- > . veryUnsafeSynchronizer clkA clkB+-- @+-- dualFlipFlop :: SClock clkA -> SClock clkB+-- -> Signal' clkA Bit -> Signal' clkB Bit+-- dualFlipFlop clkA clkB = 'register'' clkB low . 'register'' clkB low+-- . 'unsafeSynchronizer' clkA clkB+-- @ ----- The 'veryUnsafeSynchronizer' works in such a way that, given 2 clocks:+-- The 'unsafeSynchronizer' works in such a way that, given 2 clocks: ----- > type Clk7 = Clk "clk7" 7--- >--- > clk7 :: SClock Clk7--- > clk7 = sclock+-- @+-- type Clk7 = 'Clk' \"clk7\" 7 --+-- clk7 :: 'SClock' Clk7+-- clk7 = 'sclock'+-- @+-- -- and ----- > type Clk2 = Clk "clk2" 2--- >--- > clk2 :: SClock Clk2--- > clk2 = sclock+-- @+-- type Clk2 = 'Clk' \"clk2\" 2 --+-- clk2 :: 'SClock' Clk2+-- clk2 = 'sclock'+-- @+-- -- Oversampling followed by compression is the identity function plus 2 initial -- values: ----- > cregister clk7 i $--- > veryUnsafeSynchronizer clk2 clk7 $--- > cregister clk2 j $--- > veryUnsafeSynchronizer clk7 clk2 $--- > cregister clk7 k s--- >--- > ==--- >--- > i :- j :- s+-- @+-- 'register'' clk7 i $+-- 'unsafeSynchronizer' clk2 clk7 $+-- 'register'' clk2 j $+-- 'unsafeSynchronizer' clk7 clk2 $+-- 'register'' clk7 k s --+-- ==+--+-- i :- j :- s+-- @+-- -- Something we can easily observe: ----- > 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+-- @+-- oversampling = 'register'' clk2 99 . 'unsafeSynchronizer' clk7 clk2+-- . 'register'' clk7 50+-- almostId = 'register'' clk7 70 . 'unsafeSynchronizer' clk2 clk7+-- . 'register'' clk2 99 . 'unsafeSynchronizer' clk7 clk2+-- . 'register'' clk7 50+-- @ ----- >>> csample (oversampling (cfromList [1..10]))+-- >>> sample (oversampling (fromList [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]))+-- >>> sample (almostId (fromList [1..10])) -- [70, 99,1,2,3,4,5,6,7,8,9,10,...-veryUnsafeSynchronizer :: SClock clk1 -- ^ 'Clock' of the incoming signal- -> SClock clk2 -- ^ 'Clock' of the outgoing signal- -> CSignal clk1 a- -> CSignal clk2 a-veryUnsafeSynchronizer (SClock _ period1) (SClock _ period2) s = s'+unsafeSynchronizer :: SClock clk1 -- ^ 'Clock' of the incoming signal+ -> SClock clk2 -- ^ 'Clock' of the outgoing signal+ -> Signal' clk1 a+ -> Signal' clk2 a+unsafeSynchronizer (SClock _ period1) (SClock _ period2) s = s' where t1 = fromInteger (snatToInteger period1) t2 = fromInteger (snatToInteger period2)@@ -177,13 +194,13 @@ | t1 > t2 = oversample t1 t2 s | otherwise = same s -same :: CSignal clk1 a -> CSignal clk2 a+same :: Signal' clk1 a -> Signal' clk2 a same (s :- ss) = s :- same ss -oversample :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a+oversample :: Int -> Int -> Signal' clk1 a -> Signal' clk2 a oversample high low (s :- ss) = s :- oversampleS (reverse (repSchedule high low)) ss -oversampleS :: [Int] -> CSignal clk1 a -> CSignal clk2 a+oversampleS :: [Int] -> Signal' clk1 a -> Signal' clk2 a oversampleS sched = oversample' sched where oversample' [] s = oversampleS sched s@@ -192,10 +209,10 @@ prefixN 0 _ s = s prefixN n x s = x :- prefixN (n-1) x s -compress :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a+compress :: Int -> Int -> Signal' clk1 a -> Signal' clk2 a compress high low s = compressS (repSchedule high low) s -compressS :: [Int] -> CSignal clk1 a -> CSignal clk2 a+compressS :: [Int] -> Signal' clk1 a -> Signal' clk2 a compressS sched = compress' sched where compress' [] s = compressS sched s@@ -213,118 +230,63 @@ -- * Basic circuit functions -{-# 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,+{-# INLINE register' #-}+-- | \"@'register'' i s@\" delays the values in 'Signal'' @s@ for one cycle, -- and sets the value at time 0 to @i@ ----- > type ClkA = Clk "A" 100--- >--- > clkA100 :: SClock ClkA--- > clkA100 = sclock+-- @+-- type ClkA = 'Clk' \"A\" 100 ----- >>> csampleN 3 (cregister clkA100 8 (fromList [1,2,3,4]))+-- clkA :: 'SClock' ClkA+-- clkA = 'sclock'+-- @+--+-- >>> sampleN 3 (register' clkA 8 (fromList [1,2,3,4])) -- [8,1,2]-cregister :: SClock clk -> a -> CSignal clk a -> CSignal clk a-cregister = register#+register' :: SClock clk -> a -> Signal' clk a -> Signal' clk a+register' = register# -{-# INLINE cregEn #-}--- | Version of 'cregister' that only updates its content when its second+{-# INLINE regEn' #-}+-- | Version of 'register'' that only updates its content when its second -- argument is asserted. So given: -- -- @--- type ClkA = Clk \"A\" 100--- clkA :: SClock Clka--- clkA = sclock+-- type ClkA = 'Clk' \"A\" 100+-- clkA :: 'SClock' ClkA+-- clkA = 'sclock' ----- oscillate = cregister clkA False ('not1' oscillate)--- count = cregEn clkA 0 oscillate (count + 1)+-- oscillate = 'register'' clkA False ('CLaSH.Signal.not1' oscillate)+-- count = 'regEn'' clkA 0 oscillate (count + 1) -- @ -- -- We get: ----- >>> csampleN 8 oscillate+-- >>> sampleN 8 oscillate -- [False,True,False,True,False,True,False,True]--- >>> csampleN 8 count+-- >>> sampleN 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#+regEn' :: SClock clk -> a -> Signal' clk Bool -> Signal' clk a -> Signal' clk a+regEn' = 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, ...+-- | Simulate a (@'Unbundled'' clk1 a -> 'Unbundled'' clk2 b@) function given a+-- list of samples of type @a@ ----- __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 ----- > type ClkA = Clk "A" 100--- >--- > clkA100 :: SClock ClkA--- > clkA100 = sclock+-- clkA :: 'SClock' ClkA+-- clkA = '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), ...+-- >>> simulateB' clkA clkA (unbundle' clkA . register' clkA (8,8) . bundle' clkA) [(1,1), (2,2), (3,3)] :: [(Int,Int)]+-- [(8,8), (1,1), (2,2), (3,3), *** Exception: finite list -- -- __NB__: This function is not synthesisable-csimulateB :: (Bundle a, Bundle b)+simulateB' :: (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+ -> (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")+simulateB' clk1 clk2 f = simulate (bundle' clk2 . f . unbundle' clk1)
src/CLaSH/Signal/Internal.hs view
@@ -6,17 +6,32 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Signal.Internal ( -- * Datatypes Clock (..) , SClock (..)- , CSignal (..)+ , Signal' (..) -- * Basic circuits , register# , regEn# , mux+ , signal -- * Boolean connectives , (.&&.), (.||.), not1+ -- * Simulation functions (not synthesisable)+ , simulate+ -- * List \<-\> Signal conversion (not synthesisable)+ , sample+ , sampleN+ , fromList -- * Type classes -- ** 'Eq'-like , (.==.), (./=.)@@ -56,7 +71,7 @@ import Control.Applicative (Applicative (..), (<$>), liftA2, liftA3) import Data.Bits (Bits (..), FiniteBits (..)) import Data.Default (Default (..))-import Data.Foldable (Foldable (..))+import Data.Foldable as F (Foldable (..)) import Data.Traversable (Traversable (..)) import GHC.TypeLits (Nat, Symbol) import Language.Haskell.TH.Syntax (Lift (..))@@ -78,37 +93,37 @@ -- a clock @clk@ -- -- __NB__: The constructor, @(':-')@, is __not__ synthesisable.-data CSignal (clk :: Clock) a = a :- CSignal clk a+data Signal' (clk :: Clock) a = a :- Signal' clk a -instance Show a => Show (CSignal clk a) where+instance Show a => Show (Signal' clk a) where show (x :- xs) = show x ++ " " ++ show xs -instance Lift a => Lift (CSignal clk a) where+instance Lift a => Lift (Signal' clk a) where lift ~(x :- _) = [| signal# x |] -instance Default a => Default (CSignal clk a) where+instance Default a => Default (Signal' clk a) where def = signal# def -instance Functor (CSignal clk) where+instance Functor (Signal' clk) where fmap = mapSignal# {-# NOINLINE mapSignal# #-}-mapSignal# :: (a -> b) -> CSignal clk a -> CSignal clk b+mapSignal# :: (a -> b) -> Signal' clk a -> Signal' clk b mapSignal# f (a :- as) = f a :- mapSignal# f as -instance Applicative (CSignal clk) where+instance Applicative (Signal' clk) where pure = signal# (<*>) = appSignal# {-# NOINLINE signal# #-}-signal# :: a -> CSignal clk a+signal# :: a -> Signal' clk a signal# a = let s = a :- s in s {-# NOINLINE appSignal# #-}-appSignal# :: CSignal clk (a -> b) -> CSignal clk a -> CSignal clk b+appSignal# :: Signal' clk (a -> b) -> Signal' clk a -> Signal' clk b appSignal# (f :- fs) ~(a :- as) = f a :- appSignal# fs as -instance Num a => Num (CSignal clk a) where+instance Num a => Num (Signal' clk a) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*)@@ -123,7 +138,7 @@ -- -- * The function @f@ should be /lazy/ in its second argument. -- * The @z@ element will never be used.-instance Foldable (CSignal clk) where+instance Foldable (Signal' clk) where foldr = foldr# {-# NOINLINE foldr# #-}@@ -133,36 +148,54 @@ -- -- * 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# :: (a -> b -> b) -> b -> Signal' clk a -> b foldr# f z (a :- s) = a `f` (foldr# f z s) -instance Traversable (CSignal clk) where+instance Traversable (Signal' clk) where traverse = traverse# {-# NOINLINE traverse# #-}-traverse# :: Applicative f => (a -> f b) -> CSignal clk a -> f (CSignal clk b)+traverse# :: Applicative f => (a -> f b) -> Signal' clk a -> f (Signal' 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+-- | The above type is a generalisation for:+--+-- @+-- __(.||.)__ :: 'CLaSH.Signal.Signal' 'Bool' -> 'CLaSH.Signal.Signal' 'Bool' -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('||') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.||.) :: Applicative f => f Bool -> f Bool -> f Bool (.||.) = liftA2 (||) infixr 3 .&&.--- | Version of ('&&') that returns a 'CSignal' of 'Bool'-(.&&.) :: CSignal clk Bool -> CSignal clk Bool -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(.&&.)__ :: 'CLaSH.Signal.Signal' 'Bool' -> 'CLaSH.Signal.Signal' 'Bool' -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('&&') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.&&.) :: Applicative f => f Bool -> f Bool -> f Bool (.&&.) = liftA2 (&&) --- | Version of 'not' that operates on 'CSignal's of 'Bool'-not1 :: CSignal clk Bool -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __not1__ :: 'CLaSH.Signal.Signal' 'Bool' -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of 'not' that operates on 'CLaSH.Signal.Signal's of 'Bool'+not1 :: Functor f => f Bool -> f Bool not1 = fmap not {-# NOINLINE register# #-}-register# :: SClock clk -> a -> CSignal clk a -> CSignal clk a+register# :: SClock clk -> a -> Signal' clk a -> Signal' clk a register# _ i s = i :- s {-# NOINLINE regEn# #-}-regEn# :: SClock clk -> a -> CSignal clk Bool -> CSignal clk a -> CSignal clk a+regEn# :: SClock clk -> a -> Signal' clk Bool -> Signal' clk a -> Signal' clk a regEn# clk i b s = r where r = register# clk i s'@@ -171,116 +204,190 @@ {-# 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 :: Signal' clk Bool -> Signal' clk a -> Signal' clk a -> Signal' clk a mux = liftA3 (\b t f -> if b then t else f) -instance Bounded a => Bounded (CSignal clk a) where+{-# INLINE signal #-}+-- | The above type is a generalisation for:+--+-- @+-- __signal__ :: a -> 'CLaSH.Signal.Signal' a+-- @+--+-- Create a constant 'CLaSH.Signal.Signal' from a combinational value+--+-- >>> sample (signal 4)+-- [4, 4, 4, 4, ...+signal :: Applicative f => a -> f a+signal = pure++instance Bounded a => Bounded (Signal' 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)+instance ExtendingNum a b => ExtendingNum (Signal' clk a) (Signal' clk b) where+ type AResult (Signal' clk a) (Signal' clk b) = Signal' clk (AResult a b) plus = liftA2 plus minus = liftA2 minus- type MResult (CSignal clk a) (CSignal clk b) = CSignal clk (MResult a b)+ type MResult (Signal' clk a) (Signal' clk b) = Signal' clk (MResult a b) times = liftA2 times -instance SaturatingNum a => SaturatingNum (CSignal clk a) where+instance SaturatingNum a => SaturatingNum (Signal' 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"+instance Eq (Signal' clk a) where+ (==) = error "(==)' undefined for 'Signal'', use '(.==.)' instead"+ (/=) = error "(/=)' undefined for 'Signal'', use '(./=.)' instead" infix 4 .==.--- | Version of ('==') that returns a 'CSignal' of 'Bool'-(.==.) :: Eq a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(.==.)__ :: 'Eq' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('==') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.==.) :: (Eq a, Applicative f) => f a -> f a -> f Bool (.==.) = liftA2 (==) infix 4 ./=.--- | Version of ('/=') that returns a 'CSignal' of 'Bool'-(./=.) :: Eq a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(./=.)__ :: 'Eq' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('/=') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(./=.) :: (Eq a, Applicative f) => f a -> f a -> f 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"+instance Ord a => Ord (Signal' clk a) where+ compare = error "'compare' undefined for 'Signal'', use 'compare1' instead"+ (<) = error "'(<)' undefined for 'Signal'', use '(.<.)' instead"+ (>=) = error "'(>=)' undefined for 'Signal'', use '(.>=.)' instead"+ (>) = error "'(>)' undefined for 'Signal'', use '(.>.)' instead"+ (<=) = error "'(<=)' undefined for 'Signal'', 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+-- | The above type is a generalisation for:+--+-- @+-- __compare__ :: 'Ord' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Ordering'+-- @+--+-- It is a version of 'compare' that returns a 'CLaSH.Signal.Signal' of 'Ordering'+compare1 :: (Ord a, Applicative f) => f a -> f a -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __(.<.)__ :: 'Ord' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('<') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.<.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.<.) = liftA2 (<) infix 4 .<=.--- | Version of ('<=') that returns a 'CSignal' of 'Bool'-(.<=.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(.<=.)__ :: 'Ord' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('<=') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.<=.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.<=.) = liftA2 (<=) infix 4 .>.--- | Version of ('>') that returns a 'CSignal' of 'Bool'-(.>.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(.>.)__ :: 'Ord' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('>') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.>.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.>.) = liftA2 (>) infix 4 .>=.--- | Version of ('>=') that returns a 'CSignal' of 'Bool'-(.>=.) :: Ord a => CSignal clk a -> CSignal clk a -> CSignal clk Bool+-- | The above type is a generalisation for:+--+-- @+-- __(.>=.)__ :: 'Ord' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of ('>=') that returns a 'CLaSH.Signal.Signal' of 'Bool'+(.>=.) :: (Ord a, Applicative f) => f a -> f a -> f Bool (.>=.) = liftA2 (>=) -- | __WARNING__: 'fromEnum' is undefined, use 'fromEnum1' instead-instance Enum a => Enum (CSignal clk a) where+instance Enum a => Enum (Signal' clk a) where succ = fmap succ pred = fmap pred toEnum = signal# . toEnum- fromEnum = error "'fromEnum' undefined for 'CSignal', use 'fromEnum1'"+ fromEnum = error "'fromEnum' undefined for 'Signal'', 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+-- | The above type is a generalisation for:+--+-- @+-- __fromEnum1__ :: 'Enum' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int'+-- @+--+-- It is a version of 'fromEnum' that returns a CLaSH.Signal.Signal' of 'Int'+fromEnum1 :: (Enum a, Functor f) => f a -> f 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'"+instance (Num a, Ord a) => Real (Signal' clk a) where+ toRational = error "'toRational' undefined for 'Signal'', use 'toRational1'" --- | Version of 'toRational' that returns a 'CSignal' of 'Rational'-toRational1 :: Real a => CSignal clk a -> CSignal clk Rational+-- | The above type is a generalisation for:+--+-- @+-- __fromEnum1__ :: 'Real' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Rational'+-- @+--+-- | It is a version of 'toRational' that returns a 'CLaSH.Signal.Signal' of 'Rational'+toRational1 :: (Real a, Functor f) => f a -> f Rational toRational1 = fmap toRational -- | __WARNING__: 'toInteger' is undefined, use 'toInteger1' instead-instance Integral a => Integral (CSignal clk a) where+instance Integral a => Integral (Signal' 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'"+ toInteger = error "'toInteger' undefined for 'Signal'', use 'toInteger1'" --- | Version of 'toRational' that returns a 'CSignal' of 'Integer'-toInteger1 :: Integral a => CSignal clk a -> CSignal clk Integer+-- | The above type is a generalisation for:+--+-- @+-- __toInteger1__ :: 'Integral' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Integer'+-- @+--+-- It is a version of 'toRational' that returns a 'CLaSH.Signal.Signal' of 'Integer'+toInteger1 :: (Integral a, Functor f) => f a -> f Integer toInteger1 = fmap toInteger -- | __WARNING__: 'testBit' and 'popCount' are undefined, use 'testBit1' and -- 'popCount1' instead-instance Bits a => Bits (CSignal clk a) where+instance Bits a => Bits (Signal' clk a) where (.&.) = liftA2 (.&.) (.|.) = liftA2 (.|.) xor = liftA2 xor@@ -291,7 +398,7 @@ 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'"+ testBit = error "'testBit' undefined for 'Signal'', use 'testbit1'" bitSizeMaybe _ = bitSizeMaybe (undefined :: a) bitSize _ = bitSize (undefined :: a) isSigned _ = isSigned (undefined :: a)@@ -301,61 +408,193 @@ 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'"+ popCount = error "'popCount' undefined for 'Signal'', use 'popCount1'" -instance FiniteBits a => FiniteBits (CSignal clk a) where+instance FiniteBits a => FiniteBits (Signal' 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+-- | The above type is a generalisation for:+--+-- @+-- __testBit1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'Bool'+-- @+--+-- It is a version of 'testBit' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing+-- argument, and a result of 'CLaSH.Signal.Signal' of 'Bool'+testBit1 :: (Bits a, Applicative f) => f a -> f Int -> f Bool testBit1 = liftA2 testBit --- | Version of 'popCount' that returns a 'CSignal' of 'Int'-popCount1 :: Bits a => CSignal clk a -> CSignal clk Int+-- | The above type is a generalisation for:+--+-- @+-- __popCount1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int'+-- @+--+-- It is a version of 'popCount' that returns a 'CLaSH.Signal.Signal' of 'Int'+popCount1 :: (Bits a, Functor f) => f a -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __shift1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'shift' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+shift1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __rotate1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'rotate' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+rotate1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __setBit1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'setBit' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+setBit1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __clearBit1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'clearBit' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+clearBit1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __shiftL1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'shiftL' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+shiftL1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __unsafeShiftL1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'unsafeShiftL' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+unsafeShiftL1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __shiftR1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'shiftR' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+shiftR1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __unsafeShiftR1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'unsafeShiftR' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+unsafeShiftR1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __rotateL1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'rotateL' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+rotateL1 :: (Bits a, Applicative f) => f a -> f Int -> f 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+-- | The above type is a generalisation for:+--+-- @+-- __rotateR1__ :: 'Bits' a => 'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.Signal' 'Int' -> 'CLaSH.Signal.Signal' 'a'+-- @+--+-- It is a version of 'rotateR' that has a 'CLaSH.Signal.Signal' of 'Int' as indexing argument+rotateR1 :: (Bits a, Applicative f) => f a -> f Int -> f a rotateR1 = liftA2 rotateR -instance Fractional a => Fractional (CSignal clk a) where+instance Fractional a => Fractional (Signal' clk a) where (/) = liftA2 (/) recip = fmap recip fromRational = signal# . fromRational++-- * List \<-\> Signal conversion (not synthesisable)++-- | The above type is a generalisation for:+--+-- @+-- __sample__ :: 'CLaSH.Signal.Signal' a -> [a]+-- @+--+-- Get an infinite list of samples from a 'CLaSH.Signal.Signal'+--+-- The elements in the list correspond to the values of the 'CLaSH.Signal.Signal'+-- at consecutive clock cycles+--+-- > sample s == [s0, s1, s2, s3, ...+--+-- __NB__: This function is not synthesisable+sample :: Foldable f => f a -> [a]+sample = F.foldr (:) []++-- | The above type is a generalisation for:+--+-- @+-- __sampleN__ :: Int -> 'CLaSH.Signal.Signal' a -> [a]+-- @+--+-- Get a list of @n@ samples from a 'CLaSH.Signal.Signal'+--+-- The elements in the list correspond to the values of the 'CLaSH.Signal.Signal'+-- at consecutive clock cycles+--+-- > sampleN 3 s == [s0, s1, s2]+--+-- __NB__: This function is not synthesisable+sampleN :: Foldable f => Int -> f a -> [a]+sampleN n = take n . sample++-- | Create a 'CLaSH.Signal.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' clk a+fromList = Prelude.foldr (:-) (error "finite list")++-- * Simulation functions (not synthesisable)++-- | Simulate a (@'CLaSH.Signal.Signal' a -> 'CLaSH.Signal.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' clk1 a -> Signal' clk2 b) -> [a] -> [b]+simulate f = sample . f . fromList
src/CLaSH/Sized/BitVector.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE MagicHash #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.BitVector ( -- * Datatypes BitVector
src/CLaSH/Sized/Fixed.hs view
@@ -11,23 +11,31 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} --- | Fixed point numbers------ * The 'Num' operators for the given types saturate on overflow,--- and use truncation as the rounding method.--- * '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.------ BEWARE: rounding by truncation introduces a sign bias!------ * Truncation for positive numbers effectively results in: round towards zero.--- * Truncation for negative numbers effectively results in: round towards -infinity.+{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++Fixed point numbers++* The 'Num' operators for the given types saturate on overflow,+ and use truncation as the rounding method.+* '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.++BEWARE: rounding by truncation introduces a sign bias!++* Truncation for positive numbers effectively results in: round towards zero.+* Truncation for negative numbers effectively results in: round towards -infinity.+-} module CLaSH.Sized.Fixed ( -- * 'SFixed': 'Signed' 'Fixed' point numbers SFixed, sf, unSF@@ -233,17 +241,17 @@ lines of constraints: @-mac :: ( KnownNat frac- , KnownNat (frac + frac)- , KnownNat (int + frac)- , KnownNat (1 + (int + frac))- , KnownNat ((int + frac) + (int + frac))+mac :: ( 'GHC.TypeLits.KnownNat' frac+ , 'GHC.TypeLits.KnownNat' (frac + frac)+ , 'GHC.TypeLits.KnownNat' (int + frac)+ , 'GHC.TypeLits.KnownNat' (1 + (int + frac))+ , 'GHC.TypeLits.KnownNat' ((int + frac) + (int + frac)) , ((int + int) + (frac + frac)) ~ ((int + frac) + (int + frac)) )- => SFixed int frac- -> SFixed int frac- -> SFixed int frac- -> SFixed int frac+ => 'SFixed' int frac+ -> 'SFixed' int frac+ -> 'SFixed' int frac+ -> 'SFixed' int frac mac s x y = s + (x * y) @ @@ -251,10 +259,10 @@ @ mac1 :: 'NumSFixedC' int frac- => SFixed int frac- -> SFixed int frac- -> SFixed int frac- -> SFixed int frac+ => 'SFixed' int frac+ -> 'SFixed' int frac+ -> 'SFixed' int frac+ -> 'SFixed' int frac mac1 s x y = s + (x * y) @ @@ -266,28 +274,28 @@ really want to use constraint kinds: @-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)))+mac2 :: ( 'GHC.TypeLits.KnownNat' frac1+ , 'GHC.TypeLits.KnownNat' frac2+ , 'GHC.TypeLits.KnownNat' frac3+ , 'GHC.TypeLits.KnownNat' (Max frac1 frac2)+ , 'GHC.TypeLits.KnownNat' (int1 + frac1)+ , 'GHC.TypeLits.KnownNat' (int2 + frac2)+ , 'GHC.TypeLits.KnownNat' (int3 + frac3)+ , 'GHC.TypeLits.KnownNat' (frac1 + frac2)+ , 'GHC.TypeLits.KnownNat' (Max (frac1 + frac2) frac3)+ , 'GHC.TypeLits.KnownNat' (((int1 + int2) + (frac1 + frac2)) + (int3 + frac3))+ , 'GHC.TypeLits.KnownNat' ((int1 + int2) + (frac1 + frac2))+ , 'GHC.TypeLits.KnownNat' (1 + Max (int1 + frac1) (int2 + frac2))+ , 'GHC.TypeLits.KnownNat' (1 + Max (int1 + int2) int3 + Max (frac1 + frac2) frac3)+ , 'GHC.TypeLits.KnownNat' ((1 + Max int1 int2) + Max frac1 frac2)+ , 'GHC.TypeLits.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)+ => '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 @ @@ -297,10 +305,10 @@ 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)+ => '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 @ -}@@ -526,11 +534,15 @@ -- -- So when you type: ----- > n = $$(fLit pi) :: SFixed 4 4+-- @+-- n = $$('fLit' pi) :: 'SFixed' 4 4+-- @ -- -- The compiler sees: ----- > n = Fixed (fromInteger 50) :: 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:
src/CLaSH/Sized/Index.hs view
@@ -1,3 +1,8 @@+{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Index (Index) where
src/CLaSH/Sized/Internal/BitVector.hs view
@@ -9,6 +9,13 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Internal.BitVector ( -- * Datatypes BitVector (..)
src/CLaSH/Sized/Internal/Index.hs view
@@ -5,6 +5,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Internal.Index ( -- * Datatypes Index (..)
src/CLaSH/Sized/Internal/Signed.hs view
@@ -9,6 +9,13 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Internal.Signed ( -- * Datatypes Signed (..)
src/CLaSH/Sized/Internal/Unsigned.hs view
@@ -8,6 +8,13 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Internal.Unsigned ( -- * Datatypes Unsigned (..)
src/CLaSH/Sized/Signed.hs view
@@ -1,3 +1,8 @@+{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Signed ( Signed )
src/CLaSH/Sized/Unsigned.hs view
@@ -1,3 +1,8 @@+{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} module CLaSH.Sized.Unsigned (Unsigned) where
src/CLaSH/Sized/Vector.hs view
@@ -1,23 +1,31 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# OPTIONS_HADDOCK show-extensions #-} +{-|+Copyright : (C) 2013-2015, University of Twente+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-} 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+ , take, takeI, drop, dropI, at, select, selectI -- ** Combining 'Vec'tors , (++), (+>>), (<<+), concat, zip, unzip, shiftInAt0, shiftInAtN , shiftOutFrom0, shiftOutFromN@@ -28,13 +36,15 @@ , foldr, foldl, foldr1, foldl1, fold , scanl, scanr, sscanl, sscanr , mapAccumL, mapAccumR+ -- ** Special folds+ , dfold, vfold -- ** 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+ -- ** Functions for the 'BitPack' instance , concatBitVector# , unconcatBitVector# )@@ -44,9 +54,12 @@ import Data.Default (Default (..)) import qualified Data.Foldable as F import Data.Proxy (Proxy (..))+import Data.Singletons.Prelude (TyFun,Apply,type ($)) import Data.Traversable (Traversable (..)) import GHC.TypeLits (CmpNat, KnownNat, Nat, type (+), type (*), natVal)+import GHC.Base (Int(I#),Int#,isTrue#)+import GHC.Prim ((==#),(<#),(-#)) import Language.Haskell.TH (ExpQ) import Language.Haskell.TH.Syntax (Lift(..)) import Prelude hiding ((++), (!!), concat, drop, foldl,@@ -61,6 +74,8 @@ import CLaSH.Promoted.Nat (SNat (..), UNat (..), withSNat, toUNat) import CLaSH.Sized.Internal.BitVector (BitVector, (++#), split#) +import CLaSH.Class.BitPack (BitPack (..))+ -- | Fixed size vectors -- -- * Lists with their length encoded in their type@@ -97,6 +112,11 @@ neq# :: Eq a => Vec n a -> Vec n a -> Bool neq# v1 v2 = not (eq# v1 v2) +instance Ord a => Ord (Vec n a) where+ compare x y = foldr f EQ $ zipWith compare x y+ where f EQ keepGoing = keepGoing+ f done _ = done+ -- | __NB__: Not synthesisable instance KnownNat n => Applicative (Vec n) where pure = repeat@@ -333,7 +353,7 @@ {-# 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)+-- >>> concat ((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@@ -343,7 +363,7 @@ -- | 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)+-- >>> unconcat 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@@ -357,7 +377,7 @@ -- | 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)+-- >>> unconcatI (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@@ -485,6 +505,7 @@ -- @O('length' xs)@. -- -- __NB__: The binary operator \"@f@ in @'fold' f xs@\" must be associative.+-- __NB__: Not synthesisable -- -- > fold f (x1 :> x2 :> ... :> xn1 :> xn :> Nil) == ((x1 `f` x2) `f` ...) `f` (... `f` (xn1 `f` xn)) -- > fold f (x1 :> Nil) == x1@@ -605,21 +626,21 @@ 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)- , "]"- ])+{-# NOINLINE index_int #-}+index_int :: KnownNat n => Vec n a -> Int -> a+index_int xs i@(I# n0)+ | isTrue# (n0 <# 0#) = error "CLaSH.Sized.Vector.(!!): negative index"+ | otherwise = sub xs n0+ where+ sub :: Vec m a -> Int# -> a+ sub Nil _ = error (P.concat [ "CLaSH.Sized.Vector.(!!): index "+ , show i+ , " is larger than maximum index "+ , show (maxIndex xs)+ ])+ sub (y:>ys) n = if isTrue# (n ==# 0#)+ then y+ else sub ys (n -# 1#) {-# INLINE (!!) #-} -- | Vector index (subscript) operator.@@ -629,14 +650,14 @@ -- -- >>> (1:>2:>3:>4:>5:>Nil) !! 4 -- 5--- >>> (1:>2:>3:>4:>5:>Nil) !! maxIndex+-- >>> (1:>2:>3:>4:>5:>Nil) !! maxIndex (1:>2:>3:>4:>5:>Nil) -- 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]+-- *** Exception: CLaSH.Sized.Vector.(!!): index 14 is larger than maximum index 4 (!!) :: (KnownNat n, Integral i) => Vec n a -> i -> a-xs !! i = index_integer xs (toInteger i)+xs !! i = index_int xs (fromIntegral i) {-# NOINLINE maxIndex #-} -- | Index (subscript) of the last element in a 'Vec'tor@@ -654,23 +675,21 @@ 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)- , "]"- ])+{-# NOINLINE replace_int #-}+replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a+replace_int xs i@(I# n0) a+ | isTrue# (n0 <# 0#) = error "CLaSH.Sized.Vector.replace: negative index"+ | otherwise = sub xs n0 a+ where+ sub :: Vec m b -> Int# -> b -> Vec m b+ sub Nil _ _ = error (P.concat [ "CLaSH.Sized.Vector.replace: index "+ , show i+ , " is larger than maximum index "+ , show (maxIndex xs)+ ])+ sub (y:>ys) n b = if isTrue# (n ==# 0#)+ then b :> ys+ else y :> sub ys (n -# 1#) b {-# INLINE replace #-} -- | Replace an element of a vector at the given index (subscript).@@ -683,9 +702,9 @@ -- >>> 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]+-- <1,2,3,4,*** Exception: CLaSH.Sized.Vector.replace: index 9 is larger than maximum index 4 replace :: (KnownNat n, Integral i) => Vec n a -> i -> a -> Vec n a-replace xs i y = replace_integer xs (toInteger i) y+replace xs i y = replace_int xs (fromIntegral i) y {-# INLINABLE take #-} -- | 'take' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@@@ -742,18 +761,18 @@ dropI :: KnownNat m => Vec (m + n) a -> Vec n a dropI = withSNat drop -{-# INLINE exact #-}--- | 'exact' @n xs@ returns @n@'th element of @xs@+{-# INLINE at #-}+-- | 'at' @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+-- >>> at (snat :: SNat 1) (1:>2:>3:>4:>5:>Nil)+-- 2+-- >>> at d1 (1:>2:>3:>4:>5:>Nil)+-- 2+at :: SNat m -> Vec (m + (n + 1)) a -> a+at n xs = head $ snd $ splitAt n xs {-# NOINLINE select #-} -- | 'select' @f s n xs@ selects @n@ elements with stepsize @s@ and@@ -891,17 +910,19 @@ -- -- 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)+-- @+-- -- 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)@@ -910,11 +931,11 @@ -- In this case, adding 'lazyV' on 'zipWith's second argument: -- -- @--- sortVL xs = map fst sorted <: (snd (last sorted))+-- 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+-- lefts = 'head' xs :> map snd ('init' sorted)+-- rights = 'tail' xs+-- sorted = 'zipWith' compareSwapL ('lazyV' lefts) rights -- @ -- -- Results in a successful computation:@@ -926,11 +947,11 @@ -- meaning of the code: -- -- @--- sortV_flip xs = map fst sorted <: (snd (last sorted))+-- 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+-- lefts = 'head' xs :> 'map' snd ('init' sorted)+-- rights = 'tail' xs+-- sorted = 'zipWith' ('flip' compareSwapL) rights lefts -- @ -- -- >>> sortV_flip (4 :> 1 :> 2 :> 3 :> Nil)@@ -944,6 +965,114 @@ lazyV' Nil _ = Nil lazyV' (_ :> xs) ys = head ys :> lazyV' xs (tail ys) +{-# NOINLINE dfold #-}+-- | A /dependently/ typed fold.+--+-- __NB__: Not synthesisable+--+-- Using lists, we can define append ('Prelude.++') using 'Prelude.foldr':+--+-- @+-- xs ++ ys = 'Prelude.foldr' (':') ys xs+-- @+--+-- >>> [1,2] ++ [3,4]+-- [1,2,3,4]+--+-- However, when we try to do the same for 'Vec':+--+-- @+-- xs ++ ys = 'foldr' (:>) ys xs+-- @+--+-- We get a function with a very strange type:+--+-- >>> :t (++)+-- (++) :: (m + 1) ~ m => Vec n a -> Vec m a -> Vec m a+--+-- Which has an insoluble constraint @(m + 1) ~ m@. This becomes obvious when+-- we try to use it:+--+-- >>> (1 :> 2 :> Nil) ++ (3 :> 4 :> Nil)+-- <interactive>:7:1:+-- Couldn't match type ‘2’ with ‘1’+-- Expected type: 1+-- Actual type: 1 + 1+-- In the expression: (1 :> 2 :> Nil) ++ (3 :> 4 :> Nil)+-- In an equation for ‘it’: it = (1 :> 2 :> Nil) ++ (3 :> 4 :> Nil)+--+-- The reason is that the type of 'foldr' is:+--+-- >>> :t foldr+-- (a -> b -> b) -> b -> Vec n a -> b+--+-- While the type of (':>') is:+--+-- >>> :t (:>)+-- (:>) :: a -> Vec n a -> Vec (n + 1) a+--+-- We thus need a @fold@ function that can handle the growing vector type:+-- 'dfold'. Compared to 'foldr', 'dfold' takes an extra parameter, called the+-- /motive/, that allows the folded function to have an argument and result type+-- that /depends/ on the current index into the vector. Using 'dfold', we can+-- now correctly define ('++'):+--+-- @+-- data Append (m :: Nat) (a :: *) (f :: 'TyFun' Nat *) :: *+-- type instance 'Apply' (Append m a) l = 'Vec' (l + m) a+--+-- xs ++ ys = dfold (Proxy :: Proxy (Append m a)) (const (':>')) ys xs+-- @+--+-- We now see that ('++') has the appropriate type:+--+-- >>> :t (++)+-- (++) :: Vec k a -> Vec m a -> Vec (k + m) a+--+-- And that it works:+--+-- >>> (1 :> 2 :> Nil) ++ (3 :> 4 :> Nil)+-- <1,2,3,4>+dfold :: Proxy (p :: TyFun Nat * -> *) -- ^ The /motive/+ -> (forall l . Proxy l -> a -> p $ l -> p $ (l + 1)) -- ^ Function to fold+ -> (p $ 0) -- ^ Initial element+ -> Vec k a -- ^ Vector to fold over+ -> p $ k+dfold _ _ z Nil = z+dfold p f z (x :> (xs :: Vec l a)) = f (Proxy :: Proxy l) x (dfold p f z xs)++data V (a :: *) (f :: TyFun Nat *) :: *+type instance Apply (V a) l = Vec l a++{-# NOINLINE vfold #-}+-- | Specialised version of 'dfold' that builds a triangular computational+-- structure.+--+-- __NB__: Not synthesisable+--+-- Example:+--+-- @+-- cs a b = if a > b then (a,b) else (b,a)+-- csRow y xs = let (y',xs') = 'mapAccumL' cs y xs in xs' '<:' y'+-- csSort = 'vfold' csRow+-- @+--+-- Builds a triangular structure of compare and swaps to sort a row.+--+-- >>> csSort (7 :> 3 :> 9 :> 1 :> Nil)+-- <1,3,7,9>+vfold :: (forall l . a -> Vec l b -> Vec (l + 1) b)+ -> Vec k a+ -> Vec k b+vfold f xs = dfold (Proxy :: Proxy (V a)) (const f) Nil xs+++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#+ {-# NOINLINE concatBitVector# #-} concatBitVector# :: KnownNat m => Vec n (BitVector m)@@ -963,3 +1092,7 @@ ucBV UZero _ = Nil ucBV (USucc n) bv = let (bv',x :: BitVector m) = split# (unsafeCoerce bv) in x :> ucBV n bv'++instance Lift a => Lift (Vec n a) where+ lift Nil = [| Nil |]+ lift (x:>xs) = [| x :> $(lift xs) |]
src/CLaSH/Tutorial.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-|-Copyright : © Christiaan Baaij, 2014+Copyright : © Christiaan Baaij, 2014-2015 Licence : Creative Commons 4.0 (CC BY-NC 4.0) (http://creativecommons.org/licenses/by-nc/4.0/) -} module CLaSH.Tutorial (@@ -20,24 +20,30 @@ -- *** Sequential circuit -- $mac2 - -- *** Creating VHDL+ -- *** Generating VHDL -- $mac3 -- *** Circuit testbench -- $mac4 - -- *** Alternative specifications+ -- *** Generating SystemVerilog -- $mac5 + -- *** Alternative specifications+ -- $mac6+ -- * Higher-order functions -- $higher_order -- * Composition of sequential circuits -- $composition_sequential - -- * Advanced: VHDL primitives- -- $vhdlprimitives+ -- * Advanced: Primitives+ -- $primitives + -- *** SystemVerilog primitives+ -- $svprimitives+ -- * Conclusion -- $conclusion @@ -66,7 +72,8 @@ from the fact that combinational circuits can be directly modeled as mathematical functions and that functional languages lend themselves very well at describing and (de-)composing mathematical functions. The CλaSH compiler-transforms these high-level descriptions to low-level synthesizable VHDL.+transforms these high-level descriptions to low-level synthesizable VHDL or+SystemVerilog. Although we say that CλaSH borrows the semantics of Haskell, that statement should be taken with a grain of salt. What we mean to say is that the CλaSH@@ -89,7 +96,7 @@ @ counter = s where- s = register 0 (s + 1)+ s = 'register' 0 (s + 1) @ Over time, you will get a better feeling for the consequences of taking a@@ -133,14 +140,20 @@ (2) Install __CλaSH__ * Run @cabal install clash-ghc@+ * Add @cabal@'s @bin@ directory to our @PATH@: + * Windows: @%appdata%\\cabal\\bin@+ * Unix: @\$HOME\/.cabal\/bin@+ (4) Verify that everything is working by: - * Downloading the <https://raw.github.com/christiaanb/clash2/master/examples/FIR.hs Fir.hs> example+ * Downloading the <https://raw.github.com/clash-lang/clash-compiler/master/examples/FIR.hs Fir.hs> example * Run @clash --interactive FIR.hs@- * Execute, in the interpreter, the @:vhdl@ command.+ * Execute, in the interpreter, the @:vhdl@ command+ * Execute, in the interpreter, the @:systemverilog@ command * Exit the interpreter using @:q@ * Examine the VHDL code in the @vhdl@ directory+ * Examine the SystemVerilog code in the @systemverilog@ directory -} @@ -153,10 +166,10 @@ clash --interactive @ -For those familiar with Haskell/GHC, this is indeed just @GHCi@, with one added-command (@:vhdl@). You can load files into the interpreter using the-@:l \<FILENAME\>@ command. Now, depending on your choice in editor, the following-@edit-load-run@ cycle probably work best for you:+For those familiar with Haskell/GHC, this is indeed just @GHCi@, with two added+command (@:vhdl@ and @:systemverilog@). You can load files into the interpreter+using the @:l \<FILENAME\>@ command. Now, depending on your choice in editor,+the following @edit-load-run@ cycle probably work best for you: * __Commandline (e.g. emacs, vim):__ @@ -231,11 +244,11 @@ tutorial: /types/ and /synchronous sequential logic/. Especially how we can always determine, through the types of a specification, if it describes combinational logic or (synchronous) sequential logic. We do this by examining-the type of one of the sequential primitives, the @register@ function:+the type of one of the sequential primitives, the @'register'@ function: @-register :: a -> Signal a -> Signal a-regiser i s = ...+register :: a -> 'Signal' a -> 'Signal' a+register i s = ... @ Where we see that the second argument and the result are not just of the@@ -307,77 +320,32 @@ The "CLaSH.Prelude" library contains a function that creates a sequential circuit from a combinational circuit that has the same Mealy machine type /-shape of 'macT':+shape of @macT@: @-(\<^\>) :: (Bundle i, Bundle o)- => (s -> i -> (s,o))+mealy :: (s -> i -> (s,o)) -> s- -> (Unbudled' i -> Unbundled' o)-f \<^\> initS = ...+ -> ('Signal' i -> 'Signal' o)+mealy f initS = ... @ The complete sequential MAC circuit can now be specified as: @-mac = macT \<^\> 0+mac = 'mealy' macT 0 @ -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:+Where the first argument of @'mealy'@ is our @macT@ function, and the second+argument is the initial state, in this case 0. We can see it is functioning+correctly in our interpreter: ->>> Data.List.take 4 $ simulateB mac [(1::Int,1),(2,2),(3,3),(4,4)] :: [Int]+>>> import qualified Data.List+>>> Data.List.take 4 $ simulate 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 the first 4 output samples. We have now completed our first sequential circuit and have made an initial confirmation that it is working as expected.--The observant reader already saw that the '<^>' operator does not create a-function that works on 'Signal's, but on on 'SignalP's. Indeed, when we look at-the type of our 'mac' circuit:-->>> :t mac-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 Unbundled (a,b) = (Signal a, Signal b)-@--'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 '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--But they are defined as /identities/ for:-- * All elementary / primitive types such as: 'Bit', 'Bool', @'Signed' n@, etc.--That is:--@-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 '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 'Bunlde' type class allow easy conversion between the-two. -} {- $mac3@@ -390,7 +358,7 @@ if the function is monomorphic: @-topEntity :: (Signal (Signed 9),Signal (Signed 9)) -> Signal (Signed 9)+topEntity :: 'Signal' ('Signed' 9, 'Signed' 9) -> 'Signal' ('Signed' 9) topEntity = mac @ @@ -409,9 +377,9 @@ acc' = ma acc (x,y) o = acc -mac = macT \<^\> 0+mac = 'mealy' macT 0 -topEntity :: (Signal (Signed 9),Signal (Signed 9)) -> Signal (Signed 9)+topEntity :: 'Signal' ('Signed' 9, 'Signed' 9) -> 'Signal' ('Signed' 9) topEntity = mac @ @@ -426,8 +394,8 @@ to VHDL by executing the @:vhdl@ command in the interpreter. This will create a directory called 'vhdl', which contains a directory called @MAC@, which ultimately contains all the generated VHDL files. You can now load these files-(except @testbench.vhdl@) into your favourite VHDL synthesis tool, marking-@topEntity_0.vhdl@ as the file containing the top level entity.+into your favourite VHDL synthesis tool, marking @topEntity_0.vhdl@ as the file+containing the top level entity. -} {- $mac4@@ -447,10 +415,10 @@ 1. @testInput@ for the stimulus generator. 2. @expectedOutput@ for the output verification. -Given a 'topEntity' with the type:+Given a @topEntity@ with the type: @-topEntity :: SignalP a -> SignalP b+__topEntity__ :: 'Signal' a -> 'Signal' b @ Where @a@ and @b@ are placeholders for monomorphic types: the 'topEntity' is@@ -458,28 +426,28 @@ type of 'testInput' should be: @-testInput :: Signal a+__testInput__ :: 'Signal' a @ -And the type of 'expectedOutput' should be:+And the type of @expectedOutput@ should be: @-expectedOutput :: Signal b -> Signal Bool+__expectedOutput__ :: 'Signal' b -> 'Signal' Bool @ Where the 'expectedOutput' function should assert to 'True' once it has verified all expected values. The "CLaSH.Prelude" module contains two standard functions to serve the above purpose, but a user is free to use any CλaSH specification to describe these two functions. For this tutorial we will be using the-functions specified in the "CLaSH.Prelude" module, which are 'stimuliGenerator'-and 'outputVerifier':+functions specified in the "CLaSH.Prelude" module, which are @'stimuliGenerator'@+and @'outputVerifier'@: @-testInput :: Signal (Signed 9,Signed 9)-testInput = stimuliGenerator $(v [(1,1) :: (Signed 9,Signed 9),(2,2),(3,3),(4,4)])+testInput :: 'Signal' ('Signed' 9,'Signed' 9)+testInput = 'stimuliGenerator' $('v' [(1,1) :: ('Signed' 9,'Signed' 9),(2,2),(3,3),(4,4)]) -expectedOutput :: Signal (Signed 9) -> Signal Bool-expectedOutput = outputVerifier $(v [0 :: Signed 9,1,5,14])+expectedOutput :: 'Signal' ('Signed' 9) -> 'Signal' Bool+expectedOutput = 'outputVerifier' $('v' [0 :: 'Signed' 9,1,5,14]) @ This will create a stimulus generator that creates the same inputs as we used@@ -504,23 +472,30 @@ You should now again run @:vhdl@ in the interpreter; this time the compiler will take a bit longer to generate all the circuits. After it is finished you-can load all the files in your favourite VHDL simulation tool that has support-for VHDL-2008. VHDL-2008 support is required because the output verifier will-use the VHDL-2008-only @to_string@ function. Once all files are loaded into-the VHDL simulator, run the simulation on the @testbench@ entity. On questasim /-modelsim: doing a @run -all@ will finish once the output verifier will assert-its output to @true@. The generated testbench, modulo the clock signal-generator(s), is completely synthesizable. This means that if you want to test-your circuit on an FPGA, you will only have to replace the clock signal+can load all the files in your favourite VHDL simulation tool. Once all files+are loaded into the VHDL simulator, run the simulation on the @testbench@ entity.+On questasim / modelsim: doing a @run -all@ will finish once the output verifier+will assert its output to @true@. The generated testbench, modulo the clock+signal generator(s), is completely synthesizable. This means that if you want to+test your circuit on an FPGA, you will only have to replace the clock signal generator(s) by actual clock sources, such as an onboard PLL.+-} +{- $mac5+Aside from being to generate VHDL, the CλaSH compiler can also generate+SystemVerilog. You can repeat the previous two parts of the tutorial, but+instead of executing the @:vhdl@ command, you execute the @:sytemverilog@+command in the interpreter. This will create a directory called 'systemverilog',+which contains a directory called @MAC@, which ultimately contains all the+generated SystemVerilog files. SystemVerilog files end in the extension @sv@.+ This concludes the main part of this section on \"Your first circuit\", read on for alternative specifications for the same 'mac' circuit, or just skip to the next section where we will describe another DSP classic: an FIR filter structure. -} -{- $mac5+{- $mac6 * __'Num' instance for 'Signal'__: @'Signal' a@ is also also considered a 'Num'eric type as long as the value@@ -532,7 +507,7 @@ @ macN (x,y) = acc where- acc = register 0 (acc + x * y)+ acc = 'register' 0 (acc + x * y) @ * __'Applicative' instance for 'Signal'__:@@ -545,14 +520,14 @@ @ macA (x,y) = acc where- acc = register 0 acc'- acc' = ma \<$\> acc \<*\> pack (x,y)+ acc = 'register' 0 acc'+ acc' = ma '<$>' acc '<*>' 'bundle' (x,y) @ -* __<http://hackage.haskell.org/package/mtl/docs/Control-Monad-State-Lazy.html#t:State State> Monad__+* __'Control.Monad.State.Lazy.State' Monad__ - We can also implement the original 'macT' function as a- @<http://hackage.haskell.org/package/mtl/docs/Control-Monad-State-Lazy.html#t:State State>@+ We can also implement the original @macT@ function as a+ @'Control.Monad.State.Lazy.State'@ monadic computation. First we must an extra import statement, right after the import of "CLaSH.Prelude": @@ -564,22 +539,21 @@ @ macTS (x,y) = do- acc <- get- put (acc + x * y)+ acc <- 'Control.Monad.State.Lazy.get'+ 'Control.Monad.State.Lazy.put' (acc + x * y) return acc @ - We can use the '<^>' operator again, although we will have to change+ We can use the 'mealy' function again, although we will have to change position of the arguments and result: @- asStateM :: (Bundle o, Bundle i)- => (i -> State s o)+ asStateM :: (i -> 'Control.Monad.State.Lazy.State' s o) -> s- -> (Unbundled i -> Unbundled o)- asStateM f i = g \<^\> i+ -> ('Signal' i -> 'Signal' o)+ asStateM f i = 'mealy' g i where- g s x = let (o,s') = runState (f x) s+ g s x = let (o,s') = 'Control.Monad.State.Lazy.runState' (f x) s in (s',o) @ @@ -596,15 +570,15 @@ of coefficients. @-dotp as bs = foldl (+) 0 (zipWith (*) as bs)+dotp as bs = 'foldl' (+) 0 ('zipWith' (*) as bs) fir coeffs x_t = y_t where y_t = dotp coeffs xs- xs = window x_t+ xs = 'window' x_t -topEntity :: Signal (Signed 16) -> Signal (Signed 16)-topEntity = fir $(v [0::Signal (Signed 16),1,2,3])+topEntity :: 'Signal' ('Signed' 16) -> 'Signal' ('Signed' 16)+topEntity = fir $('v' [0::'Signal' ('Signed' 16),1,2,3]) @ Here we can see that, although the CλaSH compiler does not support recursion,@@ -614,75 +588,119 @@ -} {- $composition_sequential+Given a function @f@ of type: -First we define some types:+@+__f__ :: Int -> (Bool, Int) -> (Int, (Int, Bool))+@ +When we want to make compositions of @f@ in @g@ using 'mealy', we have to+write:+ @-module CalculatorTypes where+g a b c = (b1,b2,i2)+ where+ (i1,b1) = 'unbundle' ('mealy' f 0 ('bundle' (a,b)))+ (i2,b2) = 'unbundle' ('mealy' f 3 ('bundle' (i1,c)))+@ -import CLaSH.Prelude+Why do we need these 'bundle', and 'unbundle' functions you might ask? When we+look at the type of 'mealy': -type Word = Signed 4-data OPC a = ADD | MUL | Imm a | Pop | Push+@+__mealy__ :: (s -> i -> (s,o))+ -> s+ -> ('Signal' i -> 'Signal' o)+@ -deriveLift ''OPC+we see that the resulting function has an input of type @'Signal' i@, and an+output of @'Signal' o@. However, the type of @(a,b)@ in the definition of @g@ is:+@('Signal' Bool, 'Signal' Int)@. And the type of @(i1,b1)@ is of type+@('Signal' Int, 'Signal' Bool)@.++Syntactically, @'Signal' (Bool,Int)@ and @('Signal' Bool, 'Signal' Int)@ are /unequal/.+So we need to make a conversion between the two, that is what 'bundle' and+'unbundle' are for. In the above case 'bundle' gets the type:+ @+__bundle__ :: ('Signal' Bool, 'Signal' Int) -> 'Signal' (Bool,Int)+@ -Now we define the actual calculator:+and 'unbundle': @-module Calculator where+__unbundle__ :: 'Signal' (Int,Bool) -> ('Signal' Int, 'Signal' Bool)+@ -import CLaSH.Prelude-import CalculatorTypes+The /true/ types of these two functions are, however: -(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d-(f .: g) a b = f (g a b)+@+__bundle__ :: 'Bundle' a => 'Unbundled' a -> 'Signal' a+__unbundle__ :: 'Bundle' a => 'Signal' a -> 'Unbundled' a+@ -infixr 9 .:+'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 'bundle' and 'unbundle'. -alu :: Num a => OPC a -> a -> a -> Maybe a-alu ADD = Just .: (+)-alu MUL = Just .: (*)-alu (Imm i) = const . const (Just i)-alu _ = const . const Nothing+Instances of this 'Bundle' type-class are defined as /isomorphisms/ for: -pu :: (Num a, Num b)- => (OPC a -> a -> a -> Maybe a)- -> (a, a, b) -- Current state- -> (a, OPC a) -- Input- -> ( (a, a, b) -- New state- , (b, Maybe a) -- Output- )-pu alu (op1,op2,cnt) (dmem,Pop) = ((dmem,op1,cnt-1),(cnt,Nothing))-pu alu (op1,op2,cnt) (dmem,Push) = ((op1,op2,cnt+1) ,(cnt,Nothing))-pu alu (op1,op2,cnt) (dmem,opc) = ((op1,op2,cnt) ,(cnt,alu opc op1 op2))+ * All tuples until and including 8-tuples+ * The 'Vec'tor type -datamem :: (KnownNat n, Integral i)- => 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) = (replace mem addr val,mem !! addr)+But they are defined as /identities/ for: -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 = replicate d8 0+ * All elementary / primitive types such as: 'Bit', 'Bool', @'Signed' n@, etc.++That is:+ @+instance 'Bundle' (a,b) where+ type 'Unbundled'' clk (a,b) = ('Signal'' clk a, 'Signal'' clk b)+ bundle' _ (a,b) = (,) '<$>' a '<*>' b+ unbundle' _ tup = (fst '<$>' tup, snd '<*>' tup)+@ -Here we can finally see the advantage of having the '<^>' return a function-of type: @('Unbundled' i -> 'Unbundled' o)@ (instead of:-@('Signal' i -> 'Signal' o)@):+but, - * We can use normal pattern matching to get parts of the result, and,- * We can use normal tuple-constructors to build the input values for the- circuits.+@+instance 'Bundle' Bool where+ type 'Unbundled'' clk Bool = 'Signal'' clk Bool+ bundle' _ s = s+ unpack' _ s = s+@++What you need take away from the above is that a product type (e.g. a tuple) of+'Signal's is not syntactically equal to a 'Signal' of a product type, but that+the functions of the 'Bundle' type class allow easy conversion between the two.++As a final note on this section we also want to mention the 'mealyB' function,+which does the bundling and unbundling for us:++@+mealyB :: ('Bundle' i, 'Bundle' o)+ => (s -> i -> (s,o))+ -> s+ -> ('Unbundled' i -> 'Unbundled' o)+@++Using 'mealyB' we can define @g@ as:++@+g a b c = (b1,b2,i2)+ where+ (i1,b1) = 'mealyB' f 0 (a,b)+ (i2,b2) = 'mealyB' f 3 (i1,c)+@++The general rule of thumb is: always use 'mealy', unless you do pattern matching+or construction of product types, then use 'mealyB'. -} -{- $vhdlprimitives+{- $primitives There are times when you already have an existing piece of IP, or there are times where you need the VHDL to have a specific shape so that the VHDL synthesis tool can infer a specific component. In these specific cases you can@@ -690,9 +708,10 @@ in CλaSH are specified in the same way as you will read about in this section. There are perhaps 10 (at most) functions which are truly hard-coded into the CλaSH compiler. You can take a look at the files in-<http://github.com/christiaanb/clash2/tree/master/primitives>-if you want to know which functions are defined as \"regular\" primitives. The-compiler looks for primitives in two locations:+<https://github.com/clash-lang/clash-compiler/tree/master/clash-vhdl/primitives>+(or <https://github.com/clash-lang/clash-compiler/tree/master/clash-systemverilog/primitives>+for the SystemVerilog primitives) if you want to know which functions are defined+as \"regular\" primitives. The compiler looks for primitives in two locations: * The official install location: e.g. @$CABAL_DIR\/share\/\<GHC_VERSION\>\/clash-ghc\-<VERSION\>\/primitives@@@ -710,11 +729,11 @@ @ {\-\# NOINLINE (*#) \#-\}-(*#) :: KnownNat n => Signed n -> Signed n -> Signed n+(*#) :: 'GHC.TypeLits.KnownNat' n => 'Signed' n -> 'Signed' n -> 'Signed' n (S a) *# (S b) = fromInteger_INLINE (a * b) @ -For which the /expression/ primitive is:+For which the VHDL /expression/ primitive is: @ { \"BlackBox\" :@@ -751,48 +770,50 @@ We will use 'cblockRam' as an example, for which the Haskell/CλaSH code is: @-{\-\# NOINLINE cblockRam \#-\}+{\-\# NOINLINE blockRam' \#-\} -- | 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+-- \@+-- type ClkA = Clk \\\"A\\\" 100+--+-- clkA100 :: SClock ClkA+-- clkA100 = sclock+--+-- bram40 :: Signal' ClkA (Unsigned 6) -> Signal' ClkA (Unsigned 6)+-- -> Signal' ClkA Bool -> Signal' ClkA Bit -> Signal' ClkA Bit+-- bram40 = \'blockRam'' clkA100 (\'CLaSH.Sized.Vector.replicate\' d40 1)+-- \@+blockRam' :: ('GHC.TypeLits.KnownNat' n, 'GHC.TypeLits.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+ -> 'Signal'' clk ('Unsigned' m) -- ^ Write address \@w\@+ -> 'Signal'' clk ('Unsigned' m) -- ^ Read address \@r\@+ -> 'Signal'' clk Bool -- ^ Write enable+ -> 'Signal'' clk a -- ^ Value to write (at address \@w\@)+ -> 'Signal'' 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))+blockRam' clk binit wr rd en din =+ 'mealy'' 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+ 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.cblockRam"+ { "name" : "CLaSH.Prelude.BlockRam.blockRam'" , "templateD" : "blockram_~SYM[0] : block signal ~SYM[1] : ~TYP[3] := ~LIT[3]; -- ram@@ -844,7 +865,14 @@ * @~SYM[N]@: Randomly generated, but unique, symbol. Multiple occurrences of @~SYM[N]@ in the same primitive definition all refer to the same random, but unique, symbol.+* @~SIGD[\<HOLE\>][N]@: Create a signal declaration, using @\<HOLE\>@ as the name+ of the signal, and the type of the @(N+1)@'th argument.+* @~SIGDO[\<HOLE\>]@: Create a signal declaration, using @\<HOLE\>@ as the name+ of the signal, and the type of the result.+* @~TYPELEM[\<HOLE\>]@: The element type of the vector type represented by @\<HOLE\>@.+ The content of @\<HOLE\>@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@. + Some final remarks to end this section: VHDL primitives are there to instruct the CλaSH compiler to use the given VHDL template, instead of trying to do normal synthesis. As a consequence you can use constructs inside the Haskell@@ -859,6 +887,45 @@ worlds, using e.g. VHDL's foreign function interface VHPI. -} +{- $svprimitives+For those who are interested, the equivalent SystemVerilog primitives are:++@+{ \"BlackBox\" :+ { "name" : "CLaSH.Sized.Internal.Signed.*#"+ , "templateE" : "~ARG[1] * ~ARG[2]"+ }+}+@++and++@+{ \"BlackBox\" :+ { "name" : "CLaSH.Prelude.BlockRam.blockRam'"+ , "templateD" :+"// blockRam+~SIGD[~SYM[0]][3];+~SIGD[~SYM[1]][7];++initial begin+ ~SYM[0] = ~LIT[3];+end++always @(posedge ~CLK[2]) begin+ if (~ARG[6]) begin+ ~SYM[0][~ARG[4]] <= ~ARG[7];+ end+ ~SYM[1] <= ~SYM[0][~ARG[5]];+end++assign ~RESULT = ~SYM[1];"+ }+ }+@++-}+ {- $conclusion For now, this is the end of this tutorial. We will be adding updates over time, so check back from time to time. For now, we recommend that you continue with@@ -869,8 +936,8 @@ {- $errorsandsolutions A list of often encountered errors and their solutions: -* __Type error: Couldn't match expected type ‘Signal (a,b)’ with actual type__- __‘(Signal a, Signal b)’__:+* __Type error: Couldn't match expected type @'Signal' (a,b)@ with actual type__+ __@('Signal' a, 'Signal' b)@__: Signals of product types and product types (to which tuples belong) of signals are __isomorphic__ due to synchronisity principle, but are not@@ -884,18 +951,18 @@ add the 'bundle'' function like so: @- ... = f a b (bundle' (c,d))+ ... = f a b ('bundle' (c,d)) @ - Product types supported by 'bundle'' are:+ Product types supported by 'bundle are: * All tuples until and including 8-tuples * The 'Vec'tor type - NB: Use 'bundle' when you are using explicitly clocked 'CSignal's+ NB: Use 'bundle'' when you are using explicitly clocked 'CLaSH.Signal.Explicit.Signal''s -* __Type error: Couldn't match expected type ‘(Signal a, Signal b)’ with__- __ actual type ‘Signal (a,b)’__:+* __Type error: Couldn't match expected type @('Signal' a, 'Signal' b)@ with__+ __ actual type @'Signal' (a,b)@__: Product types (to which tuples belong) of signals and signals of product types are __isomorphic__ due to synchronicity principle, but are not@@ -906,18 +973,18 @@ (c,d) = f a b @ - add the 'unbundle'' function like so:+ add the 'unbundle' function like so: @- (c,d) = unbundle' (f a b)+ (c,d) = 'unbundle' (f a b) @ - Product types supported by 'unbundle'' are:+ Product types supported by 'unbundle are: * All tuples until and including 8-tuples * The 'Vec'tor type - NB: Use 'unbundle' when you are using explicitly clocked 'CSignal's+ NB: Use 'unbundle'' when you are using explicitly clocked 'CLaSH.Signal.Explicit.Signal''s * __CLaSH.Netlist(..): Not in normal form: \<REASON\>: \<EXPR\>__: @@ -945,7 +1012,7 @@ @ topEntity x y = acc where- acc = register 3 (acc + x * y)+ acc = 'register' 3 (acc + x * y) @ The above function, works for any number-like type. This means that @acc@ is@@ -953,10 +1020,10 @@ annotation makes the error go away: @- topEntity :: Signal (Signed 8) -> Signal (Signed 8) -> Signal (Signed 8)+ topEntity :: 'Signal' ('Signed' 8) -> 'Signal' ('Signed' 8) -> 'Signal' ('Signed' 8) topEntity x y = acc where- acc = register 3 (acc + x * y)+ acc = 'register' 3 (acc + x * y) @ Or, alternatively:@@ -964,7 +1031,7 @@ @ topEntity x y = acc where- acc = register (3 :: Signed 8) (acc + x * y)+ acc = 'register' (3 :: 'Signed' 8) (acc + x * y) @ * __CLaSH.Normalize.Transformations(155): InlineNonRep: \<FUNCTION\> already__@@ -990,11 +1057,11 @@ @ -- Bubble sort for 1 iteration- sortV xs = map fst sorted <: (snd (last sorted))+ sortV xs = 'map' fst sorted '<:' (snd ('last' sorted)) where- lefts = head xs :> map snd (init sorted)- rights = tail xs- sorted = zipWith 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)@@ -1009,11 +1076,11 @@ In this case, adding 'lazyV' on 'zipWith's second argument: @- sortVL xs = map fst sorted <: (snd (last sorted))+ 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+ lefts = 'head' xs :> map snd ('init' sorted)+ rights = 'tail' xs+ sorted = 'zipWith' compareSwapL ('lazyV' lefts) rights @ Results in a successful computation:@@ -1024,7 +1091,7 @@ {- $unsupported #unsupported# Here is a list of Haskell features which the CλaSH compiler cannot synthesize-to VHDL (for now):+to VHDL/SystemVerilog (for now): [@Recursive functions@] @@ -1041,11 +1108,11 @@ is the following function that performs one iteration of bubble sort: @- sortV xs = map fst sorted <: (snd (last sorted))+ sortV xs = 'map' fst sorted <: (snd ('last' sorted)) where- lefts = head xs :> map snd (init sorted)- rights = tail xs- sorted = zipWith compareSwapL 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@@ -1089,14 +1156,13 @@ The translations of 'Int', @<http://hackage.haskell.org/package/ghc-prim/docs/GHC-Prim.html#t:Int-35- Int#>@, and 'Integer' are also incorrect: they are translated to the VHDL @integer@- type, which can only represent 32-bit integer values. Use these types with- due diligence.+ type, or the SystemVerilog @signed logic [31:0]@ type, which can only+ represent 32-bit integer values. Use these types with due diligence. - [@Side-effects: 'IO', <http://hackage.haskell.org/package/base/docs/Control-Monad-ST.html#t:ST ST>, etc.@]+ [@Side-effects: 'IO', 'Control.Monad.ST.ST', etc.@] There is no support for side-effecting computations such as those in the- 'IO' or @<http://hackage.haskell.org/package/base/docs/Control-Monad-ST.html#t:ST ST>@- monad. There is also no support for Haskell's+ 'IO' or 'Control.Monad.ST.ST' monad. There is also no support for Haskell's <http://www.haskell.org/haskellwiki/Foreign_Function_Interface FFI>. -}