diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.10.4 *December 11th 2015* +* New features: + * Add `pureDF` to `CLaSH.Prelude.DataFlow`: lift combinational circuits to `DataFlow` circuits. + * Add `fifoDF` to `CLaSH.Prelude.DataFlow`: a simple FIFO buffer adhering to the `DataFlow` protocol. + * `loopDF` no longer uses the `lockStep` and `stepLock` automatically, and now includes a FIFO buffer on the feedback path. + * Add `loopDF_nobuf` to `CLaSH.Prelude.DataFlow`: a version of `loopDF` with no FIFO buffer on the feedback path. + * Add `boolToBV` to `CLaSH.CLass.BitPack`: convert `Bool`eans to `n`-bit `BitVector`s. + * `ClockSource` in `CLaSH.Annotations.TopEntity` can now have multiple clock inputs [#33](https://github.com/clash-lang/clash-prelude/issues/33) +* Bug fixes: + * `asyncRomFile` reads file multiple times. + ## 0.10.3 *October 24th 2015* * Disable CPR analysis (See https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c): * GHC < 7.11: In all modules using `-fcpr-off` diff --git a/clash-prelude.cabal b/clash-prelude.cabal --- a/clash-prelude.cabal +++ b/clash-prelude.cabal @@ -1,5 +1,5 @@ Name: clash-prelude -Version: 0.10.3 +Version: 0.10.4 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -134,6 +134,7 @@ DataKinds ConstraintKinds DefaultSignatures + DeriveTraversable DeriveDataTypeable FlexibleContexts GADTs @@ -170,6 +171,9 @@ -- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c -- as to why we need this. ghc-options: -fcpr-off + -- Uncomment the 'else' branch once hackage recognises the DeriveLift extension + -- else + -- other-extensions: DeriveLift if flag(doclinks) CPP-Options: -DDOCLINKS diff --git a/doc/loopDF.svg b/doc/loopDF.svg --- a/doc/loopDF.svg +++ b/doc/loopDF.svg @@ -1,3 +1,3 @@ - + -2014-11-05 14:15ZCanvas 1Layer 1datavalidreadydatavalidreadyhstepLockloopDF hlockStepvalidreadyvalidready + Produced by OmniGraffle 6.1.3 2015-12-11 12:29:21 +0000Canvas 1Layer 1datavalidreadydatavalidreadyhloopDF hfifoDF diff --git a/doc/loopDF_sync.svg b/doc/loopDF_sync.svg new file mode 100644 --- /dev/null +++ b/doc/loopDF_sync.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-12-11 12:37:11 +0000Canvas 1Layer 1datavalidreadydatavalidreadyhstepLockloopDF hlockStepvalidreadyvalidreadyfifoDF diff --git a/src/CLaSH/Annotations/TopEntity.hs b/src/CLaSH/Annotations/TopEntity.hs --- a/src/CLaSH/Annotations/TopEntity.hs +++ b/src/CLaSH/Annotations/TopEntity.hs @@ -178,6 +178,7 @@ , alteraPll -- ** Xilinx clock sources , clockWizard + , clockWizardDifferential ) where @@ -219,7 +220,7 @@ data ClockSource = ClockSource { c_name :: String -- ^ Component name - , c_inp :: Maybe (String,String) -- ^ optional: @(Input port, clock pin/expression)@ + , c_inp :: [(String,String)] -- ^ Zero..two times: @(Input port, clock pin/expression)@ , c_outp :: [(String,String)] -- ^ List of @(Output port, clock)@ -- @@ -278,7 +279,7 @@ -- with default settings to provide a stable 'systemClock'. -- -- >>> altpll "altpll50" "CLOCK(0)" "not KEY(0)" --- ClockSource {c_name = "altpll50", c_inp = Just ("inclk0","CLOCK(0)"), c_outp = [("c0","system1000")], c_reset = Just ("areset","not KEY(0)"), c_lock = "locked", c_sync = False} +-- ClockSource {c_name = "altpll50", c_inp = [("inclk0","CLOCK(0)")], c_outp = [("c0","system1000")], c_reset = Just ("areset","not KEY(0)"), c_lock = "locked", c_sync = False} -- -- Will generate the following VHDL: -- @@ -292,7 +293,7 @@ -- If you are however generating (System)Verilog you should write: -- -- >>> altpll "altpll50" "CLOCK[0]" "~ KEY[0]" --- ClockSource {c_name = "altpll50", c_inp = Just ("inclk0","CLOCK[0]"), c_outp = [("c0","system1000")], c_reset = Just ("areset","~ KEY[0]"), c_lock = "locked", c_sync = False} +-- ClockSource {c_name = "altpll50", c_inp = [("inclk0","CLOCK[0]")], c_outp = [("c0","system1000")], c_reset = Just ("areset","~ KEY[0]"), c_lock = "locked", c_sync = False} -- -- so that the following (System)Verilog is created: -- @@ -307,7 +308,7 @@ -> ClockSource altpll pllName clkExpr resExpr = ClockSource { c_name = pllName - , c_inp = Just ("inclk0",clkExpr) + , c_inp = pure ("inclk0",clkExpr) , c_outp = [("c0",show systemClock)] , c_reset = Just ("areset",resExpr) , c_lock = "locked" @@ -318,7 +319,7 @@ -- with default settings to provide a stable 'systemClock'. -- -- >>> alteraPll "alteraPll50" "CLOCK(0)" "not KEY(0)" --- ClockSource {c_name = "alteraPll50", c_inp = Just ("refclk","CLOCK(0)"), c_outp = [("outclk_0","system1000")], c_reset = Just ("rst","not KEY(0)"), c_lock = "locked", c_sync = False} +-- ClockSource {c_name = "alteraPll50", c_inp = [("refclk","CLOCK(0)")], c_outp = [("outclk_0","system1000")], c_reset = Just ("rst","not KEY(0)"), c_lock = "locked", c_sync = False} -- -- Will generate the following VHDL: -- @@ -332,7 +333,7 @@ -- If you are however generating (System)Verilog you should write: -- -- >>> alteraPll "alteraPll50" "CLOCK[0]" "~ KEY[0]" --- ClockSource {c_name = "alteraPll50", c_inp = Just ("refclk","CLOCK[0]"), c_outp = [("outclk_0","system1000")], c_reset = Just ("rst","~ KEY[0]"), c_lock = "locked", c_sync = False} +-- ClockSource {c_name = "alteraPll50", c_inp = [("refclk","CLOCK[0]")], c_outp = [("outclk_0","system1000")], c_reset = Just ("rst","~ KEY[0]"), c_lock = "locked", c_sync = False} -- -- so that the following (System)Verilog is created: -- @@ -347,7 +348,7 @@ -> ClockSource alteraPll pllName clkExpr resExpr = ClockSource { c_name = pllName - , c_inp = Just ("refclk",clkExpr) + , c_inp = pure ("refclk",clkExpr) , c_outp = [("outclk_0",show systemClock)] , c_reset = Just ("rst",resExpr) , c_lock = "locked" @@ -358,36 +359,82 @@ -- with the \"Clock Wizard\", with settings to provide a stable 'systemClock'. -- -- >>> clockWizard "clkwiz50" "CLOCK(0)" "not KEY(0)" --- ClockSource {c_name = "clkwiz50", c_inp = Just ("CLK_IN1","CLOCK(0)"), c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","not KEY(0)"), c_lock = "LOCKED", c_sync = False} +-- ClockSource {c_name = "clkwiz50", c_inp = [("CLK_IN1","CLOCK(0)")], c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","not KEY(0)"), c_lock = "LOCKED", c_sync = False} -- -- Will generate the following VHDL: -- -- > clkwiz50_inst : entity clkwiz50 -- > port map --- > (CLK_IN1 => CLOCK_50(0) +-- > (CLK_IN1 => CLOCK(0) -- > ,CLK_OUT1 => system1000 --- > ,RESET => not KEY0(0) --- > ,LOCKED => altpll50_locked); +-- > ,RESET => not KEY(0) +-- > ,LOCKED => clkwiz50_locked); -- -- If you are however generating (System)Verilog you should write: -- -- >>> clockWizard "clkwiz50" "CLOCK[0]" "~ KEY[0]" --- ClockSource {c_name = "clkwiz50", c_inp = Just ("CLK_IN1","CLOCK[0]"), c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","~ KEY[0]"), c_lock = "LOCKED", c_sync = False} +-- ClockSource {c_name = "clkwiz50", c_inp = [("CLK_IN1","CLOCK[0]")], c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","~ KEY[0]"), c_lock = "LOCKED", c_sync = False} -- -- so that the following (System)Verilog is created: -- -- > clkwiz50 clkwiz50_inst --- > (.CLK_IN1 (CLOCK_50[0]) +-- > (.CLK_IN1 (CLOCK[0]) -- > ,.CLK_OUT1 (system1000) --- > ,.RESET (~ KEY0[0]) --- > ,.LOCKED (altpll50_locked)); +-- > ,.RESET (~ KEY[0]) +-- > ,.LOCKED (clkwiz50_locked)); clockWizard :: String -- ^ Name of the component. -> String -- ^ Clock Pin/Expression of the free running clock. -> String -- ^ Reset Pin/Expression controlling the reset of the PLL. -> ClockSource clockWizard pllName clkExpr resExpr = ClockSource { c_name = pllName - , c_inp = Just ("CLK_IN1",clkExpr) + , c_inp = pure ("CLK_IN1",clkExpr) + , c_outp = [("CLK_OUT1",show systemClock)] + , c_reset = Just ("RESET",resExpr) + , c_lock = "LOCKED" + , c_sync = False + } + +-- | A clock source that corresponds to the Xilinx PLL/MMCM component created +-- with the \"Clock Wizard\", with settings to provide a stable 'systemClock' +-- from differential free-running inputs. +-- +-- >>> clockWizardDifferential "clkwiz50" "CLOCK(0)" "CLOCK(1)" "not KEY(0)" +-- ClockSource {c_name = "clkwiz50", c_inp = [("CLK_IN1_D_clk_n","CLOCK(0)"),("CLK_IN1_D_clk_p","CLOCK(1)")], c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","not KEY(0)"), c_lock = "LOCKED", c_sync = False} +-- +-- Will generate the following VHDL: +-- +-- > clkwiz50_inst : entity clkwiz50 +-- > port map +-- > (CLK_IN1_D_clk_n => CLOCK(0) +-- > ,CLK_IN1_D_clk_p => CLOCK(1) +-- > ,CLK_OUT1 => system1000 +-- > ,RESET => not KEY(0) +-- > ,LOCKED => clkwiz50_locked); +-- +-- If you are however generating (System)Verilog you should write: +-- +-- >>> clockWizardDifferential "clkwiz50" "CLOCK[0]" "CLOCK[1]" "~ KEY[0]" +-- ClockSource {c_name = "clkwiz50", c_inp = [("CLK_IN1_D_clk_n","CLOCK[0]"),("CLK_IN1_D_clk_p","CLOCK[1]")], c_outp = [("CLK_OUT1","system1000")], c_reset = Just ("RESET","~ KEY[0]"), c_lock = "LOCKED", c_sync = False} +-- +-- so that the following (System)Verilog is created: +-- +-- > clkwiz50 clkwiz50_inst +-- > (.CLK_IN1_D_clk_n (CLOCK[0]) +-- > ,.CLK_IN1_D_clk_p (CLOCK[1]) +-- > ,.CLK_OUT1 (system1000) +-- > ,.RESET (~ KEY[0]) +-- > ,.LOCKED (clkwiz50_locked)); +clockWizardDifferential :: String -- ^ Name of the component. + -> String -- ^ Clock Pin/Expression of the differential free running clock, negative phase. + -> String -- ^ Clock Pin/Expression of the differential free running clock, positive phase. + -> String -- ^ Reset Pin/Expression controlling the reset of the PLL. + -> ClockSource +clockWizardDifferential pllName clkExpr_n clkExpr_p resExpr = ClockSource + { c_name = pllName + , c_inp = [ ("CLK_IN1_D_clk_n",clkExpr_n) + , ("CLK_IN1_D_clk_p",clkExpr_p) + ] , c_outp = [("CLK_OUT1",show systemClock)] , c_reset = Just ("RESET",resExpr) , c_lock = "LOCKED" diff --git a/src/CLaSH/Class/BitPack.hs b/src/CLaSH/Class/BitPack.hs --- a/src/CLaSH/Class/BitPack.hs +++ b/src/CLaSH/Class/BitPack.hs @@ -17,18 +17,21 @@ module CLaSH.Class.BitPack ( BitPack (..) , bitCoerce + , boolToBV ) where import GHC.TypeLits (KnownNat, Nat, type (+)) import Prelude hiding (map) +import CLaSH.Class.Resize (zeroExtend) import CLaSH.Sized.BitVector (BitVector, (++#), high, low) import CLaSH.Sized.Internal.BitVector (split#) --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +-} -- | Convert to and from a 'BitVector' class BitPack a where @@ -82,3 +85,12 @@ 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) + +-- | Zero-extend a 'Bool'ean value to a 'BitVector' of the appropriate size. +-- +-- >>> boolToBV True :: BitVector 6 +-- 00_0001 +-- >>> boolToBV False :: BitVector 6 +-- 00_0000 +boolToBV :: (KnownNat n, KnownNat (n+1)) => Bool -> BitVector (n + 1) +boolToBV = zeroExtend . pack diff --git a/src/CLaSH/Class/Resize.hs b/src/CLaSH/Class/Resize.hs --- a/src/CLaSH/Class/Resize.hs +++ b/src/CLaSH/Class/Resize.hs @@ -37,4 +37,4 @@ -- | Add extra sign bits in front of the MSB signExtend :: (KnownNat a, KnownNat (b + a)) => f a -> f (b + a) -- | Remove bits from the MSB - truncateB :: KnownNat a => f (b + a) -> f a + truncateB :: KnownNat a => f (a + b) -> f a diff --git a/src/CLaSH/Examples.hs b/src/CLaSH/Examples.hs --- a/src/CLaSH/Examples.hs +++ b/src/CLaSH/Examples.hs @@ -30,252 +30,253 @@ import Control.Monad.Trans.State #endif --- $setup --- >>> :set -XDataKinds -XFlexibleContexts -XBinaryLiterals -XTypeFamilies -XTemplateHaskell -XRecordWildCards --- >>> :set -fplugin GHC.TypeLits.Normalise --- >>> import CLaSH.Prelude --- >>> import Test.QuickCheck --- >>> import Control.Lens --- >>> import Control.Monad.Trans.State --- >>> :{ --- let decoderCase :: Bool -> BitVector 4 -> BitVector 16 --- decoderCase enable binaryIn | enable = --- case binaryIn of --- 0x0 -> 0x0001 --- 0x1 -> 0x0002 --- 0x2 -> 0x0004 --- 0x3 -> 0x0008 --- 0x4 -> 0x0010 --- 0x5 -> 0x0020 --- 0x6 -> 0x0040 --- 0x7 -> 0x0080 --- 0x8 -> 0x0100 --- 0x9 -> 0x0200 --- 0xA -> 0x0400 --- 0xB -> 0x0800 --- 0xC -> 0x1000 --- 0xD -> 0x2000 --- 0xE -> 0x4000 --- 0xF -> 0x8000 --- decoderCase _ _ = 0 --- :} --- --- >>> :{ --- let decoderShift :: Bool -> BitVector 4 -> BitVector 16 --- decoderShift enable binaryIn = --- if enable --- then 1 `shiftL` (fromIntegral binaryIn) --- else 0 --- :} --- --- >>> :{ --- let encoderCase :: Bool -> BitVector 16 -> BitVector 4 --- encoderCase enable binaryIn | enable = --- case binaryIn of --- 0x0001 -> 0x0 --- 0x0002 -> 0x1 --- 0x0004 -> 0x2 --- 0x0008 -> 0x3 --- 0x0010 -> 0x4 --- 0x0020 -> 0x5 --- 0x0040 -> 0x6 --- 0x0080 -> 0x7 --- 0x0100 -> 0x8 --- 0x0200 -> 0x9 --- 0x0400 -> 0xA --- 0x0800 -> 0xB --- 0x1000 -> 0xC --- 0x2000 -> 0xD --- 0x4000 -> 0xE --- 0x8000 -> 0xF --- encoderCase _ _ = 0 --- :} --- --- >>> :{ --- let upCounter :: Signal Bool -> Signal (Unsigned 8) --- upCounter enable = s --- where --- s = regEn 0 enable (s + 1) --- :} --- --- >>> :{ --- let upCounterLdT s (ld,en,dIn) = (s',s) --- where --- s' | ld = dIn --- | en = s + 1 --- | otherwise = s --- :} --- --- >>> :{ --- let upCounterLd :: Signal (Bool,Bool,Unsigned 8) -> Signal (Unsigned 8) --- upCounterLd = mealy upCounterLdT 0 --- :} --- --- >>> :{ --- let upDownCounter :: Signal Bool -> Signal (Unsigned 8) --- upDownCounter upDown = s --- where --- s = register 0 (mux upDown (s + 1) (s - 1)) --- :} --- --- >>> :{ --- let lfsrF' :: BitVector 16 -> BitVector 16 --- lfsrF' s = feedback ++# slice d15 d1 s --- where --- feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0 --- :} --- --- >>> :{ --- let lfsrF :: BitVector 16 -> Signal Bit --- lfsrF seed = msb <$> r --- where r = register seed (lfsrF' <$> r) --- :} --- --- >>> :{ --- let lfsrGP taps regs = zipWith xorM taps (fb +>> regs) --- where --- fb = last regs --- xorM i x | i = x `xor` fb --- | otherwise = x --- :} --- --- >>> :{ --- let lfsrG :: BitVector 16 -> Signal Bit --- lfsrG seed = last (unbundle r) --- where r = register (unpack seed) (lfsrGP (unpack 0b0011010000000000) <$> r) --- :} --- --- >>> :{ --- let grayCounter :: Signal Bool -> Signal (BitVector 8) --- grayCounter en = gray <$> upCounter en --- where gray xs = msb xs ++# xor (slice d7 d1 xs) (slice d6 d0 xs) --- :} --- --- >>> :{ --- let oneHotCounter :: Signal Bool -> Signal (BitVector 8) --- oneHotCounter enable = s --- where --- s = regEn 1 enable (rotateL s 1) --- :} --- --- >>> :{ --- let parity :: Unsigned 8 -> Bit --- parity data_in = reduceXor data_in --- :} --- --- >>> :{ --- let crcT bv dIn = replaceBit 0 dInXor --- $ replaceBit 5 (bv!4 `xor` dInXor) --- $ replaceBit 12 (bv!11 `xor` dInXor) --- rotated --- where --- dInXor = dIn `xor` fb --- rotated = rotateL bv 1 --- fb = msb bv --- :} --- --- >>> :{ --- let crc :: Signal Bool -> Signal Bool -> Signal Bit -> Signal (BitVector 16) --- crc enable ld dIn = s --- where --- s = regEn 0xFFFF enable (mux ld 0xFFFF (crcT <$> s <*> dIn)) --- :} --- --- >>> :{ --- let uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do --- when ld_tx_data $ do --- if not _tx_empty then --- tx_over_run .= False --- else do --- tx_reg .= tx_data --- tx_empty .= False --- when (tx_enable && not _tx_empty) $ do --- tx_cnt += 1 --- when (_tx_cnt == 0) $ --- tx_out .= 0 --- when (_tx_cnt > 0 && _tx_cnt < 9) $ --- tx_out .= _tx_reg ! (_tx_cnt - 1) --- when (_tx_cnt == 9) $ do --- tx_out .= 1 --- tx_cnt .= 0 --- tx_empty .= True --- unless tx_enable $ --- tx_cnt .= 0 --- :} --- --- >>> :{ --- let uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do --- -- Synchronise the async signal --- rx_d1 .= rx_in --- rx_d2 .= _rx_d1 --- -- Uload the rx data --- when uld_rx_data $ do --- rx_data .= _rx_reg --- rx_empty .= True --- -- Receive data only when rx is enabled --- if rx_enable then do --- -- Check if just received start of frame --- when (not _rx_busy && _rx_d2 == 0) $ do --- rx_busy .= True --- rx_sample_cnt .= 1 --- rx_cnt .= 0 --- -- Star of frame detected, Proceed with rest of data --- when _rx_busy $ do --- rx_sample_cnt += 1 --- -- Logic to sample at middle of data --- when (_rx_sample_cnt == 7) $ do --- if _rx_d1 == 1 && _rx_cnt == 0 then --- rx_busy .= False --- else do --- rx_cnt += 1 --- -- start storing the rx data --- when (_rx_cnt > 0 && _rx_cnt < 9) $ do --- rx_reg %= replaceBit (_rx_cnt - 1) _rx_d2 --- when (_rx_cnt == 9) $ do --- rx_busy .= False --- -- Check if End of frame received correctly --- if _rx_d2 == 0 then --- rx_frame_err .= True --- else do --- rx_empty .= False --- rx_frame_err .= False --- -- Check if last rx data was not unloaded --- rx_over_run .= not _rx_empty --- else do --- rx_busy .= False --- :} --- --- >>> :{ --- let uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable = --- ( _tx_out <$> txReg --- , _tx_empty <$> txReg --- , _rx_data <$> rxReg --- , _rx_empty <$> rxReg --- ) --- where --- rxReg = register rxRegInit (uartRX <$> rxReg <*> rx_in <*> uld_rx_data --- <*> rx_enable) --- rxRegInit = RxReg { _rx_reg = 0 --- , _rx_data = 0 --- , _rx_sample_cnt = 0 --- , _rx_cnt = 0 --- , _rx_frame_err = False --- , _rx_over_run = False --- , _rx_empty = True --- , _rx_d1 = 1 --- , _rx_d2 = 1 --- , _rx_busy = False --- } --- txReg = register txRegInit (uartTX <$> txReg <*> ld_tx_data <*> tx_data --- <*> tx_enable) --- txRegInit = TxReg { _tx_reg = 0 --- , _tx_empty = True --- , _tx_over_run = False --- , _tx_out = 1 --- , _tx_cnt = 0 --- } --- :} +{- $setup +>>> :set -XDataKinds -XFlexibleContexts -XBinaryLiterals -XTypeFamilies -XTemplateHaskell -XRecordWildCards +>>> :set -fplugin GHC.TypeLits.Normalise +>>> import CLaSH.Prelude +>>> import Test.QuickCheck +>>> import Control.Lens +>>> import Control.Monad.Trans.State +>>> :{ +let decoderCase :: Bool -> BitVector 4 -> BitVector 16 + decoderCase enable binaryIn | enable = + case binaryIn of + 0x0 -> 0x0001 + 0x1 -> 0x0002 + 0x2 -> 0x0004 + 0x3 -> 0x0008 + 0x4 -> 0x0010 + 0x5 -> 0x0020 + 0x6 -> 0x0040 + 0x7 -> 0x0080 + 0x8 -> 0x0100 + 0x9 -> 0x0200 + 0xA -> 0x0400 + 0xB -> 0x0800 + 0xC -> 0x1000 + 0xD -> 0x2000 + 0xE -> 0x4000 + 0xF -> 0x8000 + decoderCase _ _ = 0 +:} +>>> :{ +let decoderShift :: Bool -> BitVector 4 -> BitVector 16 + decoderShift enable binaryIn = + if enable + then 1 `shiftL` (fromIntegral binaryIn) + else 0 +:} + +>>> :{ +let encoderCase :: Bool -> BitVector 16 -> BitVector 4 + encoderCase enable binaryIn | enable = + case binaryIn of + 0x0001 -> 0x0 + 0x0002 -> 0x1 + 0x0004 -> 0x2 + 0x0008 -> 0x3 + 0x0010 -> 0x4 + 0x0020 -> 0x5 + 0x0040 -> 0x6 + 0x0080 -> 0x7 + 0x0100 -> 0x8 + 0x0200 -> 0x9 + 0x0400 -> 0xA + 0x0800 -> 0xB + 0x1000 -> 0xC + 0x2000 -> 0xD + 0x4000 -> 0xE + 0x8000 -> 0xF + encoderCase _ _ = 0 +:} + +>>> :{ +let upCounter :: Signal Bool -> Signal (Unsigned 8) + upCounter enable = s + where + s = regEn 0 enable (s + 1) +:} + +>>> :{ +let upCounterLdT s (ld,en,dIn) = (s',s) + where + s' | ld = dIn + | en = s + 1 + | otherwise = s +:} + +>>> :{ +let upCounterLd :: Signal (Bool,Bool,Unsigned 8) -> Signal (Unsigned 8) + upCounterLd = mealy upCounterLdT 0 +:} + +>>> :{ +let upDownCounter :: Signal Bool -> Signal (Unsigned 8) + upDownCounter upDown = s + where + s = register 0 (mux upDown (s + 1) (s - 1)) +:} + +>>> :{ +let lfsrF' :: BitVector 16 -> BitVector 16 + lfsrF' s = feedback ++# slice d15 d1 s + where + feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0 +:} + +>>> :{ +let lfsrF :: BitVector 16 -> Signal Bit + lfsrF seed = msb <$> r + where r = register seed (lfsrF' <$> r) +:} + +>>> :{ +let lfsrGP taps regs = zipWith xorM taps (fb +>> regs) + where + fb = last regs + xorM i x | i = x `xor` fb + | otherwise = x +:} + +>>> :{ +let lfsrG :: BitVector 16 -> Signal Bit + lfsrG seed = last (unbundle r) + where r = register (unpack seed) (lfsrGP (unpack 0b0011010000000000) <$> r) +:} + +>>> :{ +let grayCounter :: Signal Bool -> Signal (BitVector 8) + grayCounter en = gray <$> upCounter en + where gray xs = msb xs ++# xor (slice d7 d1 xs) (slice d6 d0 xs) +:} + +>>> :{ +let oneHotCounter :: Signal Bool -> Signal (BitVector 8) + oneHotCounter enable = s + where + s = regEn 1 enable (rotateL s 1) +:} + +>>> :{ +let parity :: Unsigned 8 -> Bit + parity data_in = reduceXor data_in +:} + +>>> :{ +let crcT bv dIn = replaceBit 0 dInXor + $ replaceBit 5 (bv!4 `xor` dInXor) + $ replaceBit 12 (bv!11 `xor` dInXor) + rotated + where + dInXor = dIn `xor` fb + rotated = rotateL bv 1 + fb = msb bv +:} + +>>> :{ +let crc :: Signal Bool -> Signal Bool -> Signal Bit -> Signal (BitVector 16) + crc enable ld dIn = s + where + s = regEn 0xFFFF enable (mux ld 0xFFFF (crcT <$> s <*> dIn)) +:} + +>>> :{ +let uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do + when ld_tx_data $ do + if not _tx_empty then + tx_over_run .= False + else do + tx_reg .= tx_data + tx_empty .= False + when (tx_enable && not _tx_empty) $ do + tx_cnt += 1 + when (_tx_cnt == 0) $ + tx_out .= 0 + when (_tx_cnt > 0 && _tx_cnt < 9) $ + tx_out .= _tx_reg ! (_tx_cnt - 1) + when (_tx_cnt == 9) $ do + tx_out .= 1 + tx_cnt .= 0 + tx_empty .= True + unless tx_enable $ + tx_cnt .= 0 +:} + +>>> :{ +let uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do + -- Synchronise the async signal + rx_d1 .= rx_in + rx_d2 .= _rx_d1 + -- Uload the rx data + when uld_rx_data $ do + rx_data .= _rx_reg + rx_empty .= True + -- Receive data only when rx is enabled + if rx_enable then do + -- Check if just received start of frame + when (not _rx_busy && _rx_d2 == 0) $ do + rx_busy .= True + rx_sample_cnt .= 1 + rx_cnt .= 0 + -- Star of frame detected, Proceed with rest of data + when _rx_busy $ do + rx_sample_cnt += 1 + -- Logic to sample at middle of data + when (_rx_sample_cnt == 7) $ do + if _rx_d1 == 1 && _rx_cnt == 0 then + rx_busy .= False + else do + rx_cnt += 1 + -- start storing the rx data + when (_rx_cnt > 0 && _rx_cnt < 9) $ do + rx_reg %= replaceBit (_rx_cnt - 1) _rx_d2 + when (_rx_cnt == 9) $ do + rx_busy .= False + -- Check if End of frame received correctly + if _rx_d2 == 0 then + rx_frame_err .= True + else do + rx_empty .= False + rx_frame_err .= False + -- Check if last rx data was not unloaded + rx_over_run .= not _rx_empty + else do + rx_busy .= False +:} + +>>> :{ +let uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable = + ( _tx_out <$> txReg + , _tx_empty <$> txReg + , _rx_data <$> rxReg + , _rx_empty <$> rxReg + ) + where + rxReg = register rxRegInit (uartRX <$> rxReg <*> rx_in <*> uld_rx_data + <*> rx_enable) + rxRegInit = RxReg { _rx_reg = 0 + , _rx_data = 0 + , _rx_sample_cnt = 0 + , _rx_cnt = 0 + , _rx_frame_err = False + , _rx_over_run = False + , _rx_empty = True + , _rx_d1 = 1 + , _rx_d2 = 1 + , _rx_busy = False + } + txReg = register txRegInit (uartTX <$> txReg <*> ld_tx_data <*> tx_data + <*> tx_enable) + txRegInit = TxReg { _tx_reg = 0 + , _tx_empty = True + , _tx_over_run = False + , _tx_out = 1 + , _tx_cnt = 0 + } +:} +-} + data RxReg = RxReg { _rx_reg :: BitVector 8 @@ -529,6 +530,7 @@ import CLaSH.Prelude import Control.Lens +import Control.Monad import Control.Monad.Trans.State -- UART RX Logic diff --git a/src/CLaSH/Prelude.hs b/src/CLaSH/Prelude.hs --- a/src/CLaSH/Prelude.hs +++ b/src/CLaSH/Prelude.hs @@ -161,11 +161,12 @@ import CLaSH.Signal.Delayed import CLaSH.Signal.Explicit (systemClock) --- $setup --- >>> :set -XDataKinds --- >>> let window4 = window :: Signal Int -> Vec 4 (Signal Int) --- >>> let windowD3 = windowD :: Signal Int -> Vec 3 (Signal Int) --- >>> let rP = registerB (8,8) +{- $setup +>>> :set -XDataKinds +>>> let window4 = window :: Signal Int -> Vec 4 (Signal Int) +>>> let windowD3 = windowD :: Signal Int -> Vec 3 (Signal Int) +>>> let rP = registerB (8,8) +-} {- $hiding "CLaSH.Prelude" re-exports most of the Haskell "Prelude" with the exception of diff --git a/src/CLaSH/Prelude/BitIndex.hs b/src/CLaSH/Prelude/BitIndex.hs --- a/src/CLaSH/Prelude/BitIndex.hs +++ b/src/CLaSH/Prelude/BitIndex.hs @@ -22,9 +22,10 @@ import CLaSH.Sized.Internal.BitVector (BitVector, Bit, index#, lsb#, msb#, replaceBit#, setSlice#, slice#, split#) --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +-} {-# INLINE (!) #-} -- | Get the bit at the specified bit index. diff --git a/src/CLaSH/Prelude/BitReduction.hs b/src/CLaSH/Prelude/BitReduction.hs --- a/src/CLaSH/Prelude/BitReduction.hs +++ b/src/CLaSH/Prelude/BitReduction.hs @@ -17,9 +17,10 @@ import CLaSH.Class.BitPack (BitPack (..)) import CLaSH.Sized.Internal.BitVector (Bit, reduceAnd#, reduceOr#, reduceXor#) --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +-} {-# INLINE reduceAnd #-} -- | Are all bits set to '1'? diff --git a/src/CLaSH/Prelude/BlockRam.hs b/src/CLaSH/Prelude/BlockRam.hs --- a/src/CLaSH/Prelude/BlockRam.hs +++ b/src/CLaSH/Prelude/BlockRam.hs @@ -330,8 +330,8 @@ Nil @ -When we simulate our system we see that it works. This time however, -we need to drop the first few sample, because the initial output of a +When we simulate our system we see that it works. This time again, +we need to drop the first sample, because the initial output of a 'blockRam' is 'undefined', and consequently, the first output sample is also 'undefined'. diff --git a/src/CLaSH/Prelude/BlockRam/File.hs b/src/CLaSH/Prelude/BlockRam/File.hs --- a/src/CLaSH/Prelude/BlockRam/File.hs +++ b/src/CLaSH/Prelude/BlockRam/File.hs @@ -86,15 +86,15 @@ where -import Control.Monad (when) -import Control.Monad.ST.Lazy (ST,runST) -import Data.Array.MArray (newListArray,readArray,writeArray) -import Data.Array.ST (STArray) -import Data.Char (digitToInt) -import Data.Maybe (listToMaybe) -import GHC.TypeLits (KnownNat, type (^)) -import Numeric (readInt) -import System.IO.Unsafe (unsafePerformIO) +import Control.Monad (when) +import Control.Monad.ST.Lazy (ST,runST) +import Control.Monad.ST.Lazy.Unsafe (unsafeIOToST) +import Data.Array.MArray (newListArray,readArray,writeArray) +import Data.Array.ST (STArray) +import Data.Char (digitToInt) +import Data.Maybe (listToMaybe) +import GHC.TypeLits (KnownNat, type (^)) +import Numeric (readInt) import CLaSH.Promoted.Nat (SNat,snat,snatToInteger) import CLaSH.Sized.BitVector (BitVector) @@ -280,7 +280,8 @@ where szI = fromInteger $ snatToInteger sz dout = runST $ do - arr <- newListArray (0,szI-1) (initMem file) + mem <- unsafeIOToST (initMem file) + arr <- newListArray (0,szI-1) mem traverse (ramT arr) (bundle' clk (wr,rd,en,din)) ramT :: STArray s Int e -> (Int,Int,Bool,e) -> ST s e @@ -291,8 +292,8 @@ {-# NOINLINE initMem #-} -- | __NB:__ Not synthesisable -initMem :: KnownNat n => FilePath -> [BitVector n] -initMem = unsafePerformIO . fmap (map parseBV . lines) . readFile +initMem :: KnownNat n => FilePath -> IO [BitVector n] +initMem = fmap (map parseBV . lines) . readFile where parseBV s = case parseBV' s of Just i -> fromInteger i diff --git a/src/CLaSH/Prelude/DataFlow.hs b/src/CLaSH/Prelude/DataFlow.hs --- a/src/CLaSH/Prelude/DataFlow.hs +++ b/src/CLaSH/Prelude/DataFlow.hs @@ -1,10 +1,14 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE Safe #-} +{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -17,12 +21,13 @@ module CLaSH.Prelude.DataFlow ( -- * Data types DataFlow - , DataFlow' - , df + , DataFlow' (..) -- * Creating DataFlow circuits , liftDF + , pureDF , mealyDF , mooreDF + , fifoDF -- * Composition combinators , idDF , seqDF @@ -31,17 +36,25 @@ , secondDF , parDF , loopDF + , loopDF_nobuf -- * Lock-Step operation - , lockStep - , stepLock + , LockStep (..) ) where -import GHC.TypeLits (KnownNat, KnownSymbol) +import GHC.TypeLits (KnownNat, KnownSymbol, type (+), type (^)) +import Prelude hiding ((++), (!!), length, repeat) -import CLaSH.Signal ((.&&.), regEn, unbundle) -import CLaSH.Signal.Bundle (Bundle (..)) -import CLaSH.Signal.Explicit (Clock (..), Signal', SystemClock, sclock) +import CLaSH.Class.BitPack (boolToBV) +import CLaSH.Class.Resize (truncateB) +import CLaSH.Prelude.BitIndex (msb) +import CLaSH.Prelude.Mealy (mealyB') +import CLaSH.Promoted.Nat (SNat) +import CLaSH.Signal ((.&&.), not1, regEn, unbundle) +import CLaSH.Signal.Bundle (Bundle (..)) +import CLaSH.Signal.Explicit (Clock (..), Signal', SystemClock, sclock) +import CLaSH.Sized.BitVector (BitVector) +import CLaSH.Sized.Vector (Vec, (++), (!!), length, repeat, replace) {- | Dataflow circuit with bidirectional synchronisation channels. @@ -122,6 +135,12 @@ -> DataFlow' clk Bool Bool i o liftDF = DF +-- | Create a 'DataFlow' circuit where the given function @f@ operates on the +-- data, and the synchronisation channels are passed unaltered. +pureDF :: (i -> o) + -> DataFlow' clk Bool Bool i o +pureDF f = DF (\i iV oR -> (fmap f i,iV,oR)) + -- | Create a 'DataFlow' circuit from a Mealy machine description as those of -- "CLaSH.Prelude.Mealy" mealyDF :: (s -> i -> (s,o)) @@ -144,7 +163,58 @@ o = fo <$> s in (o,iV,oR)) +fifoDF_mealy :: forall addrSize a . + (KnownNat addrSize + ,KnownNat (addrSize + 1) + ,KnownNat (2 ^ addrSize)) + => (Vec (2^addrSize) a, BitVector (addrSize + 1), BitVector (addrSize + 1)) + -> (a, Bool, Bool) + -> ((Vec (2^addrSize) a, BitVector (addrSize + 1), BitVector (addrSize + 1)) + ,(a, Bool, Bool)) +fifoDF_mealy (mem,rptr,wptr) (wdata,winc,rinc) = + ((mem',rptr',wptr'), (rdata,empty,full)) + where + raddr = truncateB rptr :: BitVector addrSize + waddr = truncateB wptr :: BitVector addrSize + mem' | winc && not full = replace waddr wdata mem + | otherwise = mem + + rdata = mem !! raddr + + rptr' = rptr + boolToBV (rinc && not empty) + wptr' = wptr + boolToBV (winc && not full) + empty = rptr == wptr + full = msb rptr /= msb wptr && raddr == waddr + +-- | Create a FIFO buffer adhering to the 'DataFlow' protocol. Can be filled +-- with initial content. +-- +-- To create a FIFO of size 4, with two initial values 2 and 3 you would write: +-- +-- @ +-- fifo4 = 'fifoDF' d4 (2 :> 3 :> Nil) +-- @ +fifoDF :: forall addrSize m n a nm rate . + (KnownNat addrSize, + KnownNat n, KnownNat m, + KnownNat (2 ^ addrSize), + KnownNat (addrSize + 1), + (m + n) ~ (2 ^ addrSize), + KnownSymbol nm, KnownNat rate) + => SNat (m + n) -- ^ Depth of the FIFO buffer. Must be a power of two. + -> Vec m a -- ^ Initial content. Can be smaller than the size of the + -- FIFO. Empty spaces are initialised with 'undefined'. + -> DataFlow' ('Clk nm rate) Bool Bool a a +fifoDF _ iS = DF $ \i iV oR -> + let clk = sclock + initRdPtr = 0 + initWrPtr = fromIntegral (length iS) + initMem = iS ++ repeat undefined :: Vec (m + n) a + initS = (initMem,initRdPtr,initWrPtr) + (o,empty,full) = mealyB' clk fifoDF_mealy initS (i,iV,oR) + in (o,not1 empty, not1 full) + -- | Identity circuit -- -- <> @@ -205,33 +275,78 @@ -> 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. +-- | Feed back the second halve of the communication channel. The feedback loop +-- is buffered by a 'fifoDF' circuit. -- --- Given: +-- So given a circuit /h/ with two synchronisation channels: -- -- @ --- f \`@'seqDF'@\` ('loopDF' h) \`@'seqDF'@\` g +-- __h__ :: 'DataFlow' (Bool,Bool) (Bool,Bool) (a,d) (b,d) -- @ -- --- The circuits @f@, @h@, and @g@, will operate in /lock-step/. Which means that --- there it only progress when all three circuits are producing /valid/ data --- and all three circuits are /ready/ to receive new data. The 'loopDF' function --- uses the 'lockStep' and 'stepLock' functions to achieve the /lock-step/ --- operation. +-- Feeding back the /d/ part (including its synchronisation channels) results +-- in: -- +-- @ +-- 'loopDF' d4 Nil h +-- @ +-- -- <> -loopDF :: forall nm rate a b d . (KnownSymbol nm, KnownNat rate) - => DataFlow' ('Clk nm rate) Bool Bool (a,d) (b,d) - -> DataFlow' ('Clk nm rate) Bool Bool a b -loopDF f = loopDF' h - where - h :: DataFlow' ('Clk nm rate) (Bool,Bool) (Bool,Bool) (a,d) (b,d) - h = lockStep `seqDF` f `seqDF` stepLock +-- +-- When you have a circuit @h'@, with only a single synchronisation channel: +-- +-- @ +-- __h'__ :: 'DataFlow' Bool Bool (a,d) (b,d) +-- @ +-- +-- and you want to compose /h'/ in a feedback loop, the following will not work: +-- +-- @ +-- f \`@'seqDF'@\` ('loopDF' d4 Nil h') \`@'seqDF'@\` g +-- @ +-- +-- The circuits @f@, @h@, and @g@, must operate in /lock-step/ because the /h'/ +-- circuit only has a single synchronisation channel. Consequently, there +-- should only be progress when all three circuits are producing /valid/ data +-- and all three circuits are /ready/ to receive new data. We need to compose +-- /h'/ with the 'lockStep' and 'stepLock' functions to achieve the /lock-step/ +-- operation. +-- +-- @ +-- f \`@'seqDF'@\` ('lockStep' \`@'seqDF'@\` 'loopDF' d4 Nil h' \`@'seqDF'@\` 'stepLock') \`@'seqDF'@\` g +-- @ +-- +-- <> +loopDF :: (KnownNat m, KnownNat n, KnownNat rate, KnownNat addrSize + ,KnownNat (2 ^ addrSize), KnownNat (addrSize + 1), KnownSymbol nm + ,(m+n) ~ (2^addrSize)) + => SNat (m + n) -- ^ Depth of the FIFO buffer. Must be a power of two + -> Vec m d -- ^ Initial content of the FIFO buffer. Can be smaller than + -- the size of the FIFO. Empty spaces are initialised with + -- 'undefined'. + -> DataFlow' ('Clk nm rate) (Bool,Bool) (Bool,Bool) (a,d) (b,d) + -> DataFlow' ('Clk nm rate) Bool Bool a b +loopDF sz is (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 + (d_buf,dV_buf,dR_buf) = df (fifoDF sz is) d dV dR - 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 + ad = bundle' clk (a,d_buf) + adV = bundle' clk (aV,dV_buf) + bdR = bundle' clk (bR,dR_buf) + in (b,bV,aR) + ) + +-- | Feed back the second halve of the communication channel. Unlike 'loopDF', +-- the feedback loop is /not/ buffered. +loopDF_nobuf :: (KnownSymbol nm, KnownNat rate) + => DataFlow' ('Clk nm rate) (Bool,Bool) (Bool,Bool) (a,d) (b,d) + -> DataFlow' ('Clk nm rate) Bool Bool a b +loopDF_nobuf (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 @@ -241,7 +356,7 @@ in (b,bV,aR) ) --- | Have parallel compositions operate in lock-step. +-- | Reduce or extend the synchronisation granularity of parallel compositions. class LockStep a b where -- | Reduce the synchronisation granularity to a single 'Bool'ean value. -- @@ -285,9 +400,19 @@ -- -- <> -- - -- Note that 'lockStep' works for arbitrarily nested tuples. That is: + -- __Note 1__: ensure that the components that you are synchronising have + -- buffered/delayed @ready@ and @valid@ signals, or 'lockStep' has the + -- potential to introduce combinational loops. You can do this by placing + -- 'fifoDF's on the parallel channels. Extending the above example, you would + -- write: -- -- @ + -- ((f \`@'seqDF'@\` 'fifoDF' d4 Nil) \`@'parDF'@\` (g \`@'seqDF'@\` 'fifoDF' d4 Nil)) \`@'seqDF'@\` 'lockStep' \`@'seqDF'@\` h + -- @ + -- + -- __Note 2__: 'lockStep' works for arbitrarily nested tuples. That is: + -- + -- @ -- p :: 'DataFlow' Bool Bool ((b,d),d) z -- -- q :: 'DataFlow' ((Bool,Bool),Bool) ((Bool,Bool),Bool) ((a,c),c) ((b,d),d) @@ -342,15 +467,25 @@ -- -- <> -- - -- Note that 'stepLock' works for arbitrarily nested tuples. That is: + -- __Note 1__: ensure that the components that you are synchronising have + -- buffered/delayed @ready@ and @valid@ signals, or 'stepLock' has the + -- potential to introduce combinational loops. You can do this by placing + -- 'fifoDF's on the parallel channels. Extending the above example, you would + -- write: -- -- @ + -- h \`@'seqDF'@\` 'stepLock' \`@'seqDF'@\` ((`fifoDF` d4 Nil \`@'seqDF'@\` f) \`@'parDF'@\` (`fifoDF` d4 Nil \`@'seqDF'@\` g)) + -- @ + -- + -- __Note 2__: 'stepLock' works for arbitrarily nested tuples. That is: + -- + -- @ -- p :: 'DataFlow' Bool Bool z ((a,c),c) -- -- q :: 'DataFlow' ((Bool,Bool),Bool) ((Bool,Bool),Bool) ((a,c),c) ((b,d),d) -- q = f \`@'parDF'@\` g \`@'parDF'@\` g -- - -- r = p \`@'seqDF'@\` 'lockStep' \`@'seqDF'@\` q + -- r = p \`@'seqDF'@\` 'stepLock' \`@'seqDF'@\` q -- @ -- -- Does the right thing. @@ -378,4 +513,3 @@ yV = val .&&. xR xyV = bundle' clk (xV,yV) in (xy,xyV,rdy))) `seqDF` (stepLock `parDF` stepLock) - diff --git a/src/CLaSH/Prelude/Explicit.hs b/src/CLaSH/Prelude/Explicit.hs --- a/src/CLaSH/Prelude/Explicit.hs +++ b/src/CLaSH/Prelude/Explicit.hs @@ -71,12 +71,13 @@ import CLaSH.Signal.Explicit import CLaSH.Sized.Vector (Vec (..), (+>>), asNatProxy, repeat) --- $setup --- >>> :set -XDataKinds --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> let window4 = window' clkA :: Signal' ClkA Int -> Vec 4 (Signal' ClkA Int) --- >>> let windowD3 = windowD' clkA :: Signal' ClkA Int -> Vec 3 (Signal' ClkA Int) +{- $setup +>>> :set -XDataKinds +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> let window4 = window' clkA :: Signal' ClkA Int -> Vec 4 (Signal' ClkA Int) +>>> let windowD3 = windowD' clkA :: Signal' ClkA Int -> Vec 3 (Signal' ClkA Int) +-} {-# INLINABLE window' #-} -- | Give a window over a 'Signal'' diff --git a/src/CLaSH/Prelude/Explicit/Safe.hs b/src/CLaSH/Prelude/Explicit/Safe.hs --- a/src/CLaSH/Prelude/Explicit/Safe.hs +++ b/src/CLaSH/Prelude/Explicit/Safe.hs @@ -61,11 +61,12 @@ asyncFIFOSynchronizer) import CLaSH.Signal.Explicit --- $setup --- >>> :set -XDataKinds --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> let rP = registerB' clkA (8::Int,8::Int) +{- $setup +>>> :set -XDataKinds +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> let rP = registerB' clkA (8::Int,8::Int) +-} {-# INLINE registerB' #-} -- | Create a 'register' function for product-type like signals (e.g. diff --git a/src/CLaSH/Prelude/Mealy.hs b/src/CLaSH/Prelude/Mealy.hs --- a/src/CLaSH/Prelude/Mealy.hs +++ b/src/CLaSH/Prelude/Mealy.hs @@ -26,26 +26,27 @@ import CLaSH.Signal.Explicit (Signal', SClock, register', systemClock) import CLaSH.Signal.Bundle (Bundle (..), Unbundled') --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude --- >>> :{ --- let mac s (x,y) = (s',s) --- where --- s' = x * y + s --- topEntity = mealy mac 0 --- :} --- --- >>> import CLaSH.Prelude.Explicit --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> :{ --- let mac s (x,y) = (s',s) --- where --- s' = x * y + s --- :} --- --- >>> let topEntity = mealy' clkA mac 0 +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +>>> :{ +let mac s (x,y) = (s',s) + where + s' = x * y + s + topEntity = mealy mac 0 +:} + +>>> import CLaSH.Prelude.Explicit +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> :{ +let mac s (x,y) = (s',s) + where + s' = x * y + s +:} + +>>> let topEntity = mealy' clkA mac 0 +-} {-# INLINE mealy #-} -- | Create a synchronous function from a combinational function describing diff --git a/src/CLaSH/Prelude/Moore.hs b/src/CLaSH/Prelude/Moore.hs --- a/src/CLaSH/Prelude/Moore.hs +++ b/src/CLaSH/Prelude/Moore.hs @@ -25,20 +25,21 @@ import CLaSH.Signal.Explicit (Signal', SClock, register', systemClock) import CLaSH.Signal.Bundle (Bundle (..), Unbundled') --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude --- >>> :{ --- let mac s (x,y) = x * y + s --- topEntity = moore mac id 0 --- :} --- --- >>> import CLaSH.Prelude.Explicit --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> let mac s (x,y) = x * y + s --- --- >>> let topEntity = moore' clkA mac id 0 +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +>>> :{ +let mac s (x,y) = x * y + s + topEntity = moore mac id 0 +:} + +>>> import CLaSH.Prelude.Explicit +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> let mac s (x,y) = x * y + s + +>>> let topEntity = moore' clkA mac id 0 +-} {-# INLINE moore #-} -- | Create a synchronous function from a combinational function describing diff --git a/src/CLaSH/Prelude/ROM/File.hs b/src/CLaSH/Prelude/ROM/File.hs --- a/src/CLaSH/Prelude/ROM/File.hs +++ b/src/CLaSH/Prelude/ROM/File.hs @@ -88,6 +88,7 @@ import Data.Array (listArray,(!)) import GHC.TypeLits (KnownNat, type (^)) +import System.IO.Unsafe (unsafePerformIO) import CLaSH.Prelude.BlockRam.File (initMem) import CLaSH.Promoted.Nat (SNat,snat,snatToInteger) @@ -118,13 +119,63 @@ -- to instantiate a ROM with the contents of a data file. -- * See "CLaSH.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. +-- * When you notice that 'asyncRomFile' is significantly slowing down your +-- simulation, give it a /monomorphic/ type signature. So instead of leaving +-- the type to be inferred: +-- +-- @ +-- myRomData = asyncRomFile d512 "memory.bin" +-- @ +-- +-- or giving it a /polymorphic/ type signature: +-- +-- @ +-- myRomData :: Enum addr => addr -> BitVector 16 +-- myRomData = asyncRomFile d512 "memory.bin" +-- @ +-- +-- you __should__ give it a /monomorphic/ type signature: +-- +-- @ +-- myRomData :: Unsigned 9 -> BitVector 16 +-- myRomData = asyncRomFile d512 "memory.bin" +-- @ asyncRomFile :: (KnownNat m, Enum addr) => SNat n -- ^ Size of the ROM -> FilePath -- ^ File describing the content of the ROM -> addr -- ^ Read address @rd@ -> BitVector m -- ^ The value of the ROM at address @rd@ -asyncRomFile sz file rd = asyncRomFile# sz file (fromEnum rd) +asyncRomFile sz file = asyncRomFile# sz file . fromEnum +-- Leave 'asyncRom' eta-reduced, see Note [Eta-reduction and unsafePerformIO initMem] +-- Note [Eta-reduction and unsafePerformIO initMem] +-- +-- The 'initMem' function initializes a @[BitVector n]@ from file. Ideally, +-- we want this IO action to happen only once. When we call 'unsafePerformIO' +-- on @initMem file@, it becomes a thunk in that function, so is hence evaluated +-- only once. However, me must ensure that any code calling using of the +-- @unsafePerformIO (initMem file)@ thunk also becomes a thunk. We do this by +-- eta-reducing function where needed so that a thunk is returned. +-- +-- For example, instead of writing: +-- +-- > asyncRomFile# sz file rd = (content ! rd) +-- > where +-- > mem = unsafePerformIO (initMem file) +-- > content = listArray (0,szI-1) mem +-- > szI = fromInteger (snatToInteger sz) +-- +-- We write: +-- +-- > asyncRomFile# sz file = (content !) +-- > where +-- > mem = unsafePerformIO (initMem file) +-- > content = listArray (0,szI-1) mem +-- > szI = fromInteger (snatToInteger sz) +-- +-- Where instead of returning the BitVector defined by @(content ! rd)@, we +-- return the function (thunk) @(content !)@. + {-# INLINE asyncRomFilePow2 #-} -- | An asynchronous/combinational ROM with space for 2^@n@ elements -- @@ -147,6 +198,20 @@ -- to instantiate a ROM with the contents of a data file. -- * See "CLaSH.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. +-- * When you notice that 'asyncRomFilePow2' is significantly slowing down your +-- simulation, give it a /monomorphic/ type signature. So instead of leaving the +-- type to be inferred: +-- +-- @ +-- myRomData = asyncRomFilePow2 "memory.bin" +-- @ +-- +-- you __should__ give it a /monomorphic/ type signature: +-- +-- @ +-- myRomData :: Unsigned 9 -> BitVector 16 +-- myRomData = asyncRomFilePow2 "memory.bin" +-- @ asyncRomFilePow2 :: forall n m . (KnownNat m, KnownNat n, KnownNat (2^n)) => FilePath -- ^ File describing the content of the ROM -> Unsigned n -- ^ Read address @rd@ @@ -160,9 +225,10 @@ -> FilePath -- ^ File describing the content of the ROM -> Int -- ^ Read address @rd@ -> BitVector m -- ^ The value of the ROM at address @rd@ -asyncRomFile# sz file rd = content ! rd - where - content = listArray (0,szI-1) (initMem file) +asyncRomFile# sz file = (content !) -- Leave "(content !)" eta-reduced, see + where -- Note [Eta-reduction and unsafePerformIO initMem] + mem = unsafePerformIO (initMem file) + content = listArray (0,szI-1) mem szI = fromInteger (snatToInteger sz) {-# INLINE romFile #-} @@ -308,5 +374,6 @@ -- ^ The value of the ROM at address @rd@ from the previous clock cycle romFile# clk sz file rd = register' clk undefined ((content !) <$> rd) where - content = listArray (0,szI-1) (initMem file) + mem = unsafePerformIO (initMem file) + content = listArray (0,szI-1) mem szI = fromInteger (snatToInteger sz) diff --git a/src/CLaSH/Prelude/Safe.hs b/src/CLaSH/Prelude/Safe.hs --- a/src/CLaSH/Prelude/Safe.hs +++ b/src/CLaSH/Prelude/Safe.hs @@ -137,8 +137,9 @@ import CLaSH.Signal.Delayed import CLaSH.Signal.Explicit (systemClock) --- $setup --- >>> let rP = registerB (8,8) +{- $setup +>>> let rP = registerB (8,8) +-} {- $hiding "CLaSH.Prelude" re-exports most of the Haskell "Prelude" with the exception of diff --git a/src/CLaSH/Prelude/Synchronizer.hs b/src/CLaSH/Prelude/Synchronizer.hs --- a/src/CLaSH/Prelude/Synchronizer.hs +++ b/src/CLaSH/Prelude/Synchronizer.hs @@ -25,10 +25,9 @@ where import Data.Bits (complement, shiftR, xor) -import GHC.TypeLits (KnownNat, type (+)) +import GHC.TypeLits (type (+)) -import CLaSH.Class.BitPack (pack) -import CLaSH.Class.Resize (zeroExtend) +import CLaSH.Class.BitPack (boolToBV) import CLaSH.Prelude.BitIndex (slice) import CLaSH.Prelude.Mealy (mealyB') import CLaSH.Prelude.RAM (asyncRam') @@ -93,9 +92,6 @@ waddr raddr (winc .&&. not1 wfull) wdata - -boolToBV :: (KnownNat n, KnownNat (n+1)) => Bool -> BitVector (n + 1) -boolToBV = zeroExtend . pack ptrCompareT :: _ => SNat addrSize diff --git a/src/CLaSH/Prelude/Testbench.hs b/src/CLaSH/Prelude/Testbench.hs --- a/src/CLaSH/Prelude/Testbench.hs +++ b/src/CLaSH/Prelude/Testbench.hs @@ -31,17 +31,18 @@ import CLaSH.Sized.Index (Index) import CLaSH.Sized.Vector (Vec, (!!), maxIndex) --- $setup --- >>> :set -XTemplateHaskell --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude --- >>> let testInput = stimuliGenerator $(v [(1::Int),3..21]) --- >>> let expectedOutput = outputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int])) --- >>> import CLaSH.Prelude.Explicit --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> let testInput' = stimuliGenerator' clkA $(v [(1::Int),3..21]) --- >>> let expectedOutput' = outputVerifier' clkA $(v ([70,99,2,3,4,5,7,8,9,10]::[Int])) +{- $setup +>>> :set -XTemplateHaskell +>>> :set -XDataKinds +>>> import CLaSH.Prelude +>>> let testInput = stimuliGenerator $(v [(1::Int),3..21]) +>>> let expectedOutput = outputVerifier $(v ([70,99,2,3,4,5,7,8,9,10]::[Int])) +>>> import CLaSH.Prelude.Explicit +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> let testInput' = stimuliGenerator' clkA $(v [(1::Int),3..21]) +>>> let expectedOutput' = outputVerifier' clkA $(v ([70,99,2,3,4,5,7,8,9,10]::[Int])) +-} {-# INLINE assert #-} -- | Compares the first two 'Signal's for equality and logs a warning when they diff --git a/src/CLaSH/Promoted/Nat/Literals.hs b/src/CLaSH/Promoted/Nat/Literals.hs --- a/src/CLaSH/Promoted/Nat/Literals.hs +++ b/src/CLaSH/Promoted/Nat/Literals.hs @@ -19,7 +19,7 @@ d1 = snat :: SNat 1 d2 = snat :: SNat 2 ... -d1024 = snat :: SNat 102 +d1024 = snat :: SNat 1024 @ You can generate more 'SNat' literals using 'decLiteralsD' from "CLaSH.Promoted.Nat.TH" diff --git a/src/CLaSH/Promoted/Nat/TH.hs b/src/CLaSH/Promoted/Nat/TH.hs --- a/src/CLaSH/Promoted/Nat/TH.hs +++ b/src/CLaSH/Promoted/Nat/TH.hs @@ -20,12 +20,13 @@ import Language.Haskell.TH import CLaSH.Promoted.Nat --- $setup --- >>> :set -XDataKinds --- >>> let d1111 = snat :: SNat 1111 --- >>> let d1200 = snat :: SNat 1200 --- >>> let d1201 = snat :: SNat 1201 --- >>> let d1202 = snat :: SNat 1202 +{- $setup +>>> :set -XDataKinds +>>> let d1111 = snat :: SNat 1111 +>>> let d1200 = snat :: SNat 1200 +>>> let d1201 = snat :: SNat 1201 +>>> let d1202 = snat :: SNat 1202 +-} -- | Create an 'SNat' literal -- diff --git a/src/CLaSH/Signal.hs b/src/CLaSH/Signal.hs --- a/src/CLaSH/Signal.hs +++ b/src/CLaSH/Signal.hs @@ -73,9 +73,10 @@ import CLaSH.Signal.Explicit (SystemClock, systemClock, simulateB') import CLaSH.Signal.Bundle (Bundle (..), Unbundled') --- $setup --- >>> let oscillate = register False (not1 oscillate) --- >>> let count = regEn 0 oscillate (count + 1) +{- $setup +>>> let oscillate = register False (not1 oscillate) +>>> let count = regEn 0 oscillate (count + 1) +-} -- * Implicitly clocked synchronous signal diff --git a/src/CLaSH/Signal/Delayed.hs b/src/CLaSH/Signal/Delayed.hs --- a/src/CLaSH/Signal/Delayed.hs +++ b/src/CLaSH/Signal/Delayed.hs @@ -1,4 +1,8 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +#if __GLASGOW_HASKELL__ > 710 +{-# LANGUAGE DeriveLift #-} +#endif {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -51,23 +55,24 @@ singleton) import CLaSH.Signal (Signal, fromList, register, bundle, unbundle) --- $setup --- >>> :set -XDataKinds --- >>> :set -XTypeOperators --- >>> import CLaSH.Prelude --- >>> let delay3 = delay (0 :> 0 :> 0 :> Nil) --- >>> let delay2 = delayI :: DSignal n Int -> DSignal (n + 2) Int --- >>> :{ --- let mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int --- mac x y = feedback (mac' x y) --- where --- mac' :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int --- -> (DSignal 0 Int, DSignal 1 Int) --- mac' a b acc = let acc' = a * b + acc --- in (acc, delay (singleton 0) acc') --- :} --- +{- $setup +>>> :set -XDataKinds +>>> :set -XTypeOperators +>>> import CLaSH.Prelude +>>> let delay3 = delay (0 :> 0 :> 0 :> Nil) +>>> let delay2 = delayI :: DSignal n Int -> DSignal (n + 2) Int +>>> :{ +let mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int + mac x y = feedback (mac' x y) + where + mac' :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int + -> (DSignal 0 Int, DSignal 1 Int) + mac' a b acc = let acc' = a * b + acc + in (acc, delay (singleton 0) acc') +:} +-} + -- | A synchronized signal with samples of type @a@, synchronized to \"system\" -- clock (period 1000), that has accumulated @delay@ amount of samples delay -- along its path. @@ -75,9 +80,9 @@ DSignal { -- | Strip a 'DSignal' from its delay information. toSignal :: Signal a } - deriving (Show,Default,Lift,Functor,Applicative,Num,Bounded,Fractional, + deriving (Show,Default,Functor,Applicative,Num,Bounded,Fractional, Real,Integral,SaturatingNum,Eq,Ord,Enum,Bits,FiniteBits,Foldable, - Traversable,Arbitrary,CoArbitrary) + Traversable,Arbitrary,CoArbitrary,Lift) 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) diff --git a/src/CLaSH/Signal/Explicit.hs b/src/CLaSH/Signal/Explicit.hs --- a/src/CLaSH/Signal/Explicit.hs +++ b/src/CLaSH/Signal/Explicit.hs @@ -44,19 +44,20 @@ regEn#, simulate) import CLaSH.Signal.Bundle (Bundle (..), Unbundled') --- $setup --- >>> :set -XDataKinds --- >>> import CLaSH.Prelude --- >>> type Clk2 = Clk "clk2" 2 --- >>> type Clk7 = Clk "clk7" 7 --- >>> let clk2 = sclock :: SClock Clk2 --- >>> let clk7 = sclock :: SClock Clk7 --- >>> let oversampling = register' clk2 99 . unsafeSynchronizer clk7 clk2 . register' clk7 50 --- >>> let almostId = register' clk7 70 . unsafeSynchronizer clk2 clk7 . register' clk2 99 . unsafeSynchronizer clk7 clk2 . register' clk7 50 --- >>> type ClkA = Clk "A" 100 --- >>> let clkA = sclock :: SClock ClkA --- >>> let oscillate = register' clkA False (CLaSH.Signal.not1 oscillate) --- >>> let count = regEn' clkA 0 oscillate (count + 1) +{- $setup +>>> :set -XDataKinds +>>> import CLaSH.Prelude +>>> type Clk2 = Clk "clk2" 2 +>>> type Clk7 = Clk "clk7" 7 +>>> let clk2 = sclock :: SClock Clk2 +>>> let clk7 = sclock :: SClock Clk7 +>>> let oversampling = register' clk2 99 . unsafeSynchronizer clk7 clk2 . register' clk7 50 +>>> let almostId = register' clk7 70 . unsafeSynchronizer clk2 clk7 . register' clk2 99 . unsafeSynchronizer clk7 clk2 . register' clk7 50 +>>> type ClkA = Clk "A" 100 +>>> let clkA = sclock :: SClock ClkA +>>> let oscillate = register' clkA False (CLaSH.Signal.not1 oscillate) +>>> let count = regEn' clkA 0 oscillate (count + 1) +-} {- $relativeclocks #relativeclocks# CλaSH supports explicitly clocked 'CLaSH.Signal's in the form of: diff --git a/src/CLaSH/Signal/Internal.hs b/src/CLaSH/Signal/Internal.hs --- a/src/CLaSH/Signal/Internal.hs +++ b/src/CLaSH/Signal/Internal.hs @@ -94,14 +94,15 @@ import CLaSH.Promoted.Nat (SNat, snatToInteger) import CLaSH.Promoted.Symbol (SSymbol, ssymbolToString) --- $setup --- >>> :set -XDataKinds --- >>> :set -XMagicHash --- >>> import CLaSH.Promoted.Nat --- >>> import CLaSH.Promoted.Symbol --- >>> type SystemClock = Clk "System" 1000 --- >>> type Signal a = Signal' SystemClock a --- >>> let register = register# (SClock ssymbol snat :: SClock SystemClock) +{- $setup +>>> :set -XDataKinds +>>> :set -XMagicHash +>>> import CLaSH.Promoted.Nat +>>> import CLaSH.Promoted.Symbol +>>> type SystemClock = Clk "System" 1000 +>>> type Signal a = Signal' SystemClock a +>>> let register = register# (SClock ssymbol snat :: SClock SystemClock) +-} -- | A clock with a name ('Symbol') and period ('Nat') data Clock = Clk Symbol Nat diff --git a/src/CLaSH/Sized/Fixed.hs b/src/CLaSH/Sized/Fixed.hs --- a/src/CLaSH/Sized/Fixed.hs +++ b/src/CLaSH/Sized/Fixed.hs @@ -66,7 +66,7 @@ where import Control.Arrow ((***), second) -import Data.Bits (Bits (..)) +import Data.Bits (Bits (..), FiniteBits) import Data.Default (Default (..)) import Data.List (find) import Data.Maybe (fromJust) @@ -89,11 +89,12 @@ import CLaSH.Sized.Signed (Signed) import CLaSH.Sized.Unsigned (Unsigned) --- $setup --- >>> :set -XDataKinds --- >>> :set -XTemplateHaskell --- >>> import CLaSH.Prelude --- >>> let n = $$(fLit pi) :: SFixed 4 4 +{- $setup +>>> :set -XDataKinds +>>> :set -XTemplateHaskell +>>> import CLaSH.Prelude +>>> let n = $$(fLit pi) :: SFixed 4 4 +-} -- | 'Fixed'-point number -- @@ -117,6 +118,7 @@ deriving instance Default (rep (int + frac)) => Default (Fixed rep int frac) deriving instance Arbitrary (rep (int + frac)) => Arbitrary (Fixed rep int frac) deriving instance CoArbitrary (rep (int + frac)) => CoArbitrary (Fixed rep int frac) +deriving instance FiniteBits (rep (int + frac)) => FiniteBits (Fixed rep int frac) -- | Instance functions do not saturate. -- Meaning that \"@`'shiftL'` 1 == 'satMult' 'SatWrap' 2'@\"" diff --git a/src/CLaSH/Sized/Internal/BitVector.hs b/src/CLaSH/Sized/Internal/BitVector.hs --- a/src/CLaSH/Sized/Internal/BitVector.hs +++ b/src/CLaSH/Sized/Internal/BitVector.hs @@ -111,9 +111,10 @@ import CLaSH.Promoted.Nat (SNat, snatToInteger) import CLaSH.Promoted.Ord (Max) --- $setup --- >>> :set -XTemplateHaskell --- >>> :set -XBinaryLiterals +{- $setup +>>> :set -XTemplateHaskell +>>> :set -XBinaryLiterals +-} -- * Type definitions diff --git a/src/CLaSH/Sized/Internal/Signed.hs b/src/CLaSH/Sized/Internal/Signed.hs --- a/src/CLaSH/Sized/Internal/Signed.hs +++ b/src/CLaSH/Sized/Internal/Signed.hs @@ -412,7 +412,7 @@ else fromInteger_INLINE i' {-# NOINLINE truncateB# #-} -truncateB# :: KnownNat m => Signed (n + m) -> Signed m +truncateB# :: KnownNat m => Signed (m + n) -> Signed m truncateB# (S n) = fromInteger_INLINE n instance KnownNat n => Default (Signed n) where diff --git a/src/CLaSH/Sized/Vector.hs b/src/CLaSH/Sized/Vector.hs --- a/src/CLaSH/Sized/Vector.hs +++ b/src/CLaSH/Sized/Vector.hs @@ -126,47 +126,48 @@ import CLaSH.Class.BitPack (BitPack (..)) --- $setup --- >>> :set -XDataKinds --- >>> :set -XTypeFamilies --- >>> :set -XTypeOperators --- >>> :set -XTemplateHaskell --- >>> :set -XFlexibleContexts --- >>> :set -fplugin GHC.TypeLits.Normalise --- >>> import CLaSH.Prelude --- >>> let compareSwapL a b = if a < b then (a,b) else (b,a) --- >>> :{ --- let sortV xs = map fst sorted :< (snd (last sorted)) --- where --- lefts = head xs :> map snd (init sorted) --- rights = tail xs --- sorted = zipWith compareSwapL lefts rights --- :} --- --- >>> :{ --- let 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 --- :} --- --- >>> :{ --- let 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 --- :} --- --- >>> import Data.Singletons.Prelude --- >>> data Append (m :: Nat) (a :: *) (f :: TyFun Nat *) :: * --- >>> type instance Apply (Append m a) l = Vec (l + m) a --- >>> let append' xs ys = dfold (Proxy :: Proxy (Append m a)) (const (:>)) ys xs --- >>> let compareSwap a b = if a > b then (a,b) else (b,a) --- >>> let insert y xs = let (y',xs') = mapAccumL compareSwap y xs in xs' :< y' --- >>> let insertionSort = vfold insert +{- $setup +>>> :set -XDataKinds +>>> :set -XTypeFamilies +>>> :set -XTypeOperators +>>> :set -XTemplateHaskell +>>> :set -XFlexibleContexts +>>> :set -fplugin GHC.TypeLits.Normalise +>>> import CLaSH.Prelude +>>> let compareSwapL a b = if a < b then (a,b) else (b,a) +>>> :{ +let sortV xs = map fst sorted :< (snd (last sorted)) + where + lefts = head xs :> map snd (init sorted) + rights = tail xs + sorted = zipWith compareSwapL lefts rights +:} +>>> :{ +let 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 +:} + +>>> :{ +let 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 +:} + +>>> import Data.Singletons.Prelude +>>> data Append (m :: Nat) (a :: *) (f :: TyFun Nat *) :: * +>>> type instance Apply (Append m a) l = Vec (l + m) a +>>> let append' xs ys = dfold (Proxy :: Proxy (Append m a)) (const (:>)) ys xs +>>> let compareSwap a b = if a > b then (a,b) else (b,a) +>>> let insert y xs = let (y',xs') = mapAccumL compareSwap y xs in xs' :< y' +>>> let insertionSort = vfold insert +-} + infixr 5 `Cons` -- | Fixed size vectors. -- @@ -1183,7 +1184,7 @@ replicateI :: KnownNat n => a -> Vec n a replicateI = withSNat replicate {-# INLINE replicateI #-} -{-# WARNING replicateI "Use 'repeat' instead of 'replicateI'" #-} +{-# DEPRECATED replicateI "Use 'repeat' instead of 'replicateI'" #-} -- | \"'repeat' @a@\" creates a vector with as many copies of /a/ as demanded -- by the context. diff --git a/src/CLaSH/Tutorial.hs b/src/CLaSH/Tutorial.hs --- a/src/CLaSH/Tutorial.hs +++ b/src/CLaSH/Tutorial.hs @@ -79,53 +79,55 @@ import GHC.Word import Data.Default --- $setup --- >>> :set -XTemplateHaskell --- >>> :set -XDataKinds --- >>> let ma acc (x,y) = acc + x * y --- >>> :{ --- let macT acc (x,y) = (acc',o) --- where --- acc' = ma acc (x,y) --- o = acc --- :} --- --- >>> :set -XFlexibleContexts --- >>> :set -fplugin GHC.TypeLits.Normalise --- >>> let compareSwapL a b = if a < b then (a,b) else (b,a) --- >>> :{ --- let sortV xs = map fst sorted :< (snd (last sorted)) --- where --- lefts = head xs :> map snd (init sorted) --- rights = tail xs --- sorted = zipWith compareSwapL lefts rights --- :} --- --- >>> :{ --- let 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 --- :} --- --- >>> let mac = mealy macT 0 --- >>> let topEntity = mac :: Signal (Signed 9, Signed 9) -> Signal (Signed 9) --- >>> let testInput = stimuliGenerator $(v [(1,1) :: (Signed 9,Signed 9),(2,2),(3,3),(4,4)]) --- >>> let expectedOutput = outputVerifier $(v [0 :: Signed 9,1,5,14]) --- >>> :{ --- let fibR :: Unsigned 64 -> Unsigned 64 --- fibR 0 = 0 --- fibR 1 = 1 --- fibR n = fibR (n-1) + fibR (n-2) --- :} --- --- >>> :{ --- let fibS :: Signal (Unsigned 64) --- fibS = r --- where r = register 0 r + register 0 (register 1 r) --- :} +{- $setup +>>> :set -XTemplateHaskell +>>> :set -XDataKinds +>>> let ma acc (x,y) = acc + x * y +>>> :{ +let macT acc (x,y) = (acc',o) + where + acc' = ma acc (x,y) + o = acc +:} +>>> :set -XFlexibleContexts +>>> :set -fplugin GHC.TypeLits.Normalise +>>> let compareSwapL a b = if a < b then (a,b) else (b,a) +>>> :{ +let sortV xs = map fst sorted :< (snd (last sorted)) + where + lefts = head xs :> map snd (init sorted) + rights = tail xs + sorted = zipWith compareSwapL lefts rights +:} + +>>> :{ +let 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 +:} + +>>> let mac = mealy macT 0 +>>> let topEntity = mac :: Signal (Signed 9, Signed 9) -> Signal (Signed 9) +>>> let testInput = stimuliGenerator $(v [(1,1) :: (Signed 9,Signed 9),(2,2),(3,3),(4,4)]) +>>> let expectedOutput = outputVerifier $(v [0 :: Signed 9,1,5,14]) +>>> :{ +let fibR :: Unsigned 64 -> Unsigned 64 + fibR 0 = 0 + fibR 1 = 1 + fibR n = fibR (n-1) + fibR (n-2) +:} + +>>> :{ +let fibS :: Signal (Unsigned 64) + fibS = r + where r = register 0 r + register 0 (register 1 r) +:} + +-} + {- $introduction CλaSH (pronounced ‘clash’) is a functional hardware description language that borrows both its syntax and semantics from the functional programming language @@ -1071,7 +1073,7 @@ return d' @ -And for which the /definition/ primitive is: +And for which the /declaration/ primitive is: @ { \"BlackBox\" : @@ -1118,7 +1120,7 @@ a general listing of the available template holes: * @~RESULT@: VHDL signal to which the result of a primitive must be assigned - to. NB: Only used in a /definition/ primitive. + to. NB: Only used in a /declaration/ primitive. * @~ARG[N]@: @(N+1)@'th argument to the function. * @~LIT[N]@: @(N+1)@'th argument to the function An extra condition that must hold is that this @(N+1)@'th argument is an (integer) literal. diff --git a/tests/doctests.hs b/tests/doctests.hs --- a/tests/doctests.hs +++ b/tests/doctests.hs @@ -5,5 +5,4 @@ main :: IO () main = glob "src/**/*.hs" >>= - doctest . (["-optP-include", - "-optPdist/build/autogen/cabal_macros.h"] ++) + doctest