diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,47 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.8 *June 3rd 2015* +* New features: + * Make the (Bit)Vector argument the _last_ argument for the following functions: `slice`, `setSlice`, `replaceBit`, `replace`. The signatures for the above functions are now: + + ``` + slice :: BitPack a => SNat m -> SNat n -> a -> BitVector (m + 1 - n) + setSlice :: BitPack a => SNat m -> SNat n -> BitVector (m + 1 - n) -> a -> a + replaceBit :: Integral i => i -> Bit -> a -> a + replace :: Integral i => i -> a -> Vec n a -> Vec n a + ``` + + This allows for easier chaining, e.g.: + + ``` + replaceBit 0 1 $ + repleceBit 4 0 $ + replaceBit 6 1 bv + ``` + * Until version 0.7.5, given `x :: Vec 8 Bit` and `y :: BitVector 8`, it used to be `last x == msb y`. + This is quite confusing when printing converted values. + Until version 0.7.5 we would get: + + ``` + > 0x0F :: BitVector 8 + 0000_1111 + > unpack 0x0F :: Vec 8 Bit + <1,1,1,1,0,0,0,0> + ``` + + As of version 0.8, we have `head x == msb y`: + + ``` + > 0x0F :: BitVector 8 + 0000_1111 + > unpack 0x0F :: Vec 8 Bit + <0,0,0,0,1,1,1,1> + ``` + + So converting for `Vec`tors of `Bit`s to `BitVector`s is no longer _index_-preserving, but it is _order_-preserving. + * Add [QuickCheck](http://hackage.haskell.org/package/QuickCheck) `Arbitary` and `CoArbitary` instances for all data types + * Add [lens](http://hackage.haskell.org/package/lens) `Ixed` instances for `BitVector`, `Signed`, `Unsigned`, and `Vec` + ## 0.7.5 **May 7th 2015** * New features: * Moore machine combinators 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.7.5 +Version: 0.8 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -22,6 +22,7 @@ . A preliminary version of a tutorial can be found in "CLaSH.Tutorial", for a general overview of the library you should however check out "CLaSH.Prelude". + Some circuit examples can be found in "CLaSH.Examples". Homepage: http://www.clash-lang.org/ bug-reports: http://github.com/clash-lang/clash-prelude/issues License: BSD2 @@ -50,6 +51,12 @@ default: True manual: True +flag doclinks + description: + Create hyperlinks to non-dependent packages using `-fdoclinks`. + default: False + manual: True + Library HS-Source-Dirs: src @@ -97,6 +104,7 @@ CLaSH.Sized.Internal.Unsigned CLaSH.Tutorial + CLaSH.Examples other-extensions: BangPatterns DataKinds @@ -122,10 +130,16 @@ data-default >= 0.5.3, integer-gmp >= 0.5.1.0, ghc-prim >= 0.3.1.0, - ghc-typelits-natnormalise >= 0.2.1, + ghc-typelits-natnormalise >= 0.3, + lens >= 4.9, + QuickCheck >= 2.7 && <2.9, singletons >= 1.0, template-haskell >= 2.9.0.0, th-lift >= 0.5.6 + + if flag(doclinks) + CPP-Options: -DDOCLINKS + build-depends: transformers >= 0.4.2.0 test-suite doctests type: exitcode-stdio-1.0 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 @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -5,6 +5,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -36,28 +38,28 @@ -- | Convert element of type @a@ to a 'BitVector' -- -- >>> pack (-5 :: Signed 6) - -- 111011 + -- 11_1011 pack :: a -> BitVector (BitSize a) -- | Convert a 'BitVector' to an element of type @a@ -- -- >>> pack (-5 :: Signed 6) - -- 111011 + -- 11_1011 -- >>> let x = pack (-5 :: Signed 6) -- >>> unpack x :: Unsigned 6 -- 59 -- >>> pack (59 :: Unsigned 6) - -- 111011 + -- 11_1011 unpack :: BitVector (BitSize a) -> a {-# INLINE bitCoerce #-} -- | Coerce a value from one type to another through its bit representation. -- -- >>> pack (-5 :: Signed 6) --- 111011 +-- 11_1011 -- >>> bitCoerce (-5 :: Signed 6) :: Unsigned 6 -- 59 -- >>> pack (59 :: Unsigned 6) --- 111011 +-- 11_1011 bitCoerce :: (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b diff --git a/src/CLaSH/Class/Num.hs b/src/CLaSH/Class/Num.hs --- a/src/CLaSH/Class/Num.hs +++ b/src/CLaSH/Class/Num.hs @@ -2,6 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -3,6 +3,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| diff --git a/src/CLaSH/Examples.hs b/src/CLaSH/Examples.hs new file mode 100644 --- /dev/null +++ b/src/CLaSH/Examples.hs @@ -0,0 +1,654 @@ +{-# LANGUAGE NoImplicitPrelude, CPP, TemplateHaskell, DataKinds #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} + +{-| +Copyright : © Christiaan Baaij, 2015 +Licence : Creative Commons 4.0 (CC BY 4.0) (http://creativecommons.org/licenses/by/4.0/) +-} +module CLaSH.Examples ( + -- * Decoders and Encoders + -- $decoders_and_encoders + + -- * Counters + -- $counters + + -- * Parity and CRC + -- $parity_and_crc + + -- * UART model + -- $uart + ) +where + +import CLaSH.Prelude +import Control.Lens +import Control.Monad +import Test.QuickCheck + +#ifdef DOCLINKS +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 +-- -- Recieve 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 + , _rx_data :: BitVector 8 + , _rx_sample_cnt :: Unsigned 4 + , _rx_cnt :: Unsigned 4 + , _rx_frame_err :: Bool + , _rx_over_run :: Bool + , _rx_empty :: Bool + , _rx_d1 :: Bit + , _rx_d2 :: Bit + , _rx_busy :: Bool + } + +makeLenses ''RxReg + +data TxReg + = TxReg + { _tx_reg :: BitVector 8 + , _tx_empty :: Bool + , _tx_over_run :: Bool + , _tx_out :: Bit + , _tx_cnt :: Unsigned 4 + } + +makeLenses ''TxReg + +{- $decoders_and_encoders += Decoder + +Using a @case@ statement: + +@ +decoderCase :: Bool -> BitVector 4 -> BitVector 16 +decoderCase enable binaryIn | enable = + case binaryIn of + 0x0 -> 0x0001 + 0x1 -> 0x0002 + 0x2 -> 0x0004 + 0x3 -> 0x0008 + 0x4 -> 0x0010 + 0x5 -> 0x0020 + 0x6 -> 0x0040 + 0x7 -> 0x0080 + 0x8 -> 0x0100 + 0x9 -> 0x0200 + 0xA -> 0x0400 + 0xB -> 0x0800 + 0xC -> 0x1000 + 0xD -> 0x2000 + 0xE -> 0x4000 + 0xF -> 0x8000 +decoderCase _ _ = 0 +@ + +Using the `shiftL` function: + +@ +decoderShift :: Bool -> BitVector 4 -> BitVector 16 +decoderShift enable binaryIn = + if enable + then 1 ``shiftL`` ('fromIntegral' binaryIn) + else 0 +@ + +Examples: + +>>> decoderCase True 3 +0000_0000_0000_1000 +>>> decoderShift True 7 +0000_0000_1000_0000 + +The following property holds: + +prop> decoderShift enable binaryIn === decoderCase enable binaryIn + += Encoder + +Using a @case@ statement: + +@ +encoderCase :: Bool -> BitVector 16 -> BitVector 4 +encoderCase enable binaryIn | enable = + case binaryIn of + 0x0001 -> 0x0 + 0x0002 -> 0x1 + 0x0004 -> 0x2 + 0x0008 -> 0x3 + 0x0010 -> 0x4 + 0x0020 -> 0x5 + 0x0040 -> 0x6 + 0x0080 -> 0x7 + 0x0100 -> 0x8 + 0x0200 -> 0x9 + 0x0400 -> 0xA + 0x0800 -> 0xB + 0x1000 -> 0xC + 0x2000 -> 0xD + 0x4000 -> 0xE + 0x8000 -> 0xF +encoderCase _ _ = 0 +@ + +The following property holds: + +prop> en ==> (encoderCase en (decoderCase en decIn) === decIn) +-} + +{- $counters += 8-bit Simple Up Counter + +Using `regEn`: + +@ +upCounter :: Signal Bool -> Signal (Unsigned 8) +upCounter enable = s + where + s = `regEn` 0 enable (s + 1) +@ + += 8-bit Up Counter With Load + +Using `mealy`: + +@ +upCounterLd :: Signal (Bool,Bool,Unsigned 8) -> Unsigned 8 +upCounterLd = `mealy` upCounterLdT 0 + +upCounterLdT s (ld,en,dIn) = (s',s) + where + s' | ld = dIn + | en = s + 1 + | otherwise = s +@ + += 8-bit Up-Down counter + +Using `register` and `mux`: + +@ +upDownCounter :: Signal Bool -> Signal (Unsigned 8) +upDownCounter upDown = s + where + s = `register` 0 (`mux` upDown (s + 1) (s - 1)) +@ + +The following property holds: + +prop> en ==> testFor 1000 (upCounter (signal en) .==. upDownCounter (signal en)) + += LFSR + +External/Fibonacci LFSR, for @n=16@ and using the primitive polynominal @1 + x^11 + x^13 + x^14 + x^16@ + +@ +lfsrF' :: BitVector 16 -> BitVector 16 +lfsrF' s = feedback '++#' 'slice' d15 d1 s + where + feedback = s'!'5 ``xor`` s'!'3 ``xor`` s'!'2 ``xor`` s'!'0 + +lfsrF :: BitVector 16 -> Signal Bit +lfsrF seed = 'msb' '<$>' r + where r = 'register' seed (lfsrF' '<$>' r) +@ + +We can also build a internal/Galois LFSR which has better timing characteristics. +We first define a Galois LFSR parametrizable in its filter taps: + +@ +lfsrGP taps regs = 'zipWith' xorM taps (fb '+>>' regs) + where + fb = 'last' regs + xorM i x | i = x ``xor`` fb + | otherwise = x +@ + +Then we can instance a 16-bit LFSR as follows: + +@ +lfsrG :: BitVector 16 -> Signal Bit +lfsrG seed = 'last' ('unbundle' r) + where r = 'register' ('unpack' seed) (lfsrGP ('unpack' 0b0011010000000000) '<$>' r) +@ + +The following property holds: + +prop> testFor 100 (lfsrF 0xACE1 .==. lfsrG 0x4645) + += Gray counter + +Using the previously defined @upCounter@: + +@ +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) +@ + += One-hot counter + +Basically a barrel-shifter: + +@ +oneHotCounter :: Signal Bool -> Signal (BitVector 8) +oneHotCounter enable = s + where + s = 'regEn' 1 enable ('rotateL' s 1) +@ +-} + +{- $parity_and_crc += Parity + +Just 'reduceXor': + +@ +parity :: Unsigned 8 -> Bit +parity data_in = `reduceXor` data_in +@ + += Serial CRC + +* Width = 16 bits +* Truncated polynomial = 0x1021 +* Initial value = 0xFFFF +* Input date is NOT reflected +* Output CRC is NOT reflected +* No XOR is performed on the output CRC + +@ +crcT bv dIn = 'replaceBit' 0 dInXor + $ 'replaceBit' 5 (bv'!'4 ``xor`` dInXor) + $ 'replaceBit' 12 (bv'!'11 ``xor`` dInXor) + rotated + where + dInXor = dIn ``xor`` fb + rotated = 'rotateL' bv 1 + fb = 'msb' bv + +crc :: 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)) +@ +-} + +{- $uart +@ +{\-\# LANGUAGE RecordWildCards \#-\} +module UART (uart) where + +import CLaSH.Prelude +import Control.Lens +import Control.Monad.Trans.State + +-- UART RX Logic +data RxReg + = RxReg + { _rx_reg :: BitVector 8 + , _rx_data :: BitVector 8 + , _rx_sample_cnt :: Unsigned 4 + , _rx_cnt :: Unsigned 4 + , _rx_frame_err :: Bool + , _rx_over_run :: Bool + , _rx_empty :: Bool + , _rx_d1 :: Bit + , _rx_d2 :: Bit + , _rx_busy :: Bool + } + +makeLenses ''RxReg + +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 + -- Recieve data only when rx is enabled + if rx_enable then do + -- Check if just received start of frame + 'when' (not _rx_busy && _rx_d2 == 0) $ do + rx_busy '.=' True + rx_sample_cnt '.=' 1 + rx_cnt '.=' 0 + -- Star of frame detected, Proceed with rest of data + 'when' _rx_busy $ do + rx_sample_cnt '+=' 1 + -- Logic to sample at middle of data + 'when' (_rx_sample_cnt == 7) $ do + if _rx_d1 == 1 && _rx_cnt == 0 then + rx_busy '.=' False + else do + rx_cnt '+=' 1 + -- start storing the rx data + 'when' (_rx_cnt > 0 && _rx_cnt < 9) $ do + rx_reg '%=' 'replaceBit' (_rx_cnt - 1) _rx_d2 + 'when' (_rx_cnt == 9) $ do + rx_busy .= False + -- Check if End of frame received correctly + if _rx_d2 == 0 then + rx_frame_err '.=' True + else do + rx_empty '.=' False + rx_frame_err '.=' False + -- Check if last rx data was not unloaded + rx_over_run '.=' not _rx_empty + else do + rx_busy .= False + +-- UART TX Logic +data TxReg + = TxReg + { _tx_reg :: BitVector 8 + , _tx_empty :: Bool + , _tx_over_run :: Bool + , _tx_out :: Bit + , _tx_cnt :: Unsigned 4 + } + +makeLenses ''TxReg + +uartTX t\@(TxReg {..}) ld_tx_data tx_data tx_enable = 'flip' 'execState' t $ do + 'when' ld_tx_data $ do + if not _tx_empty then + tx_over_run '.=' False + else do + tx_reg '.=' tx_data + tx_empty '.=' False + 'when' (tx_enable && not _tx_empty) $ do + tx_cnt '+=' 1 + 'when' (_tx_cnt == 0) $ + tx_out '.=' 0 + 'when' (_tx_cnt > 0 && _tx_cnt < 9) $ + tx_out '.=' _tx_reg '!' (_tx_cnt - 1) + 'when' (_tx_cnt == 9) $ do + tx_out '.=' 1 + tx_cnt '.=' 0 + tx_empty '.=' True + 'unless' tx_enable $ + tx_cnt '.=' 0 + +-- Combine RX and TX logic +uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable = + ( _tx_out '<$>' txReg + , _tx_empty '<$>' txReg + , _rx_data '<$>' rxReg + , _rx_empty '<$>' rxReg + ) + where + rxReg = register rxRegInit (uartRX '<$>' rxReg '<*>' rx_in '<*>' uld_rx_data + '<*>' rx_enable) + rxRegInit = RxReg { _rx_reg = 0 + , _rx_data = 0 + , _rx_sample_cnt = 0 + , _rx_cnt = 0 + , _rx_frame_err = False + , _rx_over_run = False + , _rx_empty = True + , _rx_d1 = 1 + , _rx_d2 = 1 + , _rx_busy = False + } + + txReg = register txRegInit (uartTX '<$>' txReg '<*>' ld_tx_data '<*>' tx_data + '<*>' tx_enable) + txRegInit = TxReg { _tx_reg = 0 + , _tx_empty = True + , _tx_over_run = False + , _tx_out = 1 + , _tx_cnt = 0 + } +@ +-} diff --git a/src/CLaSH/Prelude.hs b/src/CLaSH/Prelude.hs --- a/src/CLaSH/Prelude.hs +++ b/src/CLaSH/Prelude.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -28,6 +30,7 @@ For now, "CLaSH.Prelude" is also the best starting point for exploring the library. A preliminary version of a tutorial can be found in "CLaSH.Tutorial". + Some circuit examples can be found in "CLaSH.Examples". -} module CLaSH.Prelude ( -- * Creating synchronous sequential circuits 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 @@ -4,6 +4,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -30,7 +32,7 @@ -- __NB:__ Bit indices are __DESCENDING__. -- -- >>> pack (7 :: Unsigned 6) --- 000111 +-- 00_0111 -- >>> (7 :: Unsigned 6) ! 1 -- 1 -- >>> (7 :: Unsigned 6) ! 5 @@ -46,28 +48,28 @@ -- __NB:__ Bit indices are __DESCENDING__. -- -- >>> pack (7 :: Unsigned 6) --- 000111 --- >>> slice (7 :: Unsigned 6) d4 d2 +-- 00_0111 +-- >>> slice d4 d2 (7 :: Unsigned 6) -- 001 --- >>> slice (7 :: Unsigned 6) d6 d4 +-- >>> slice d6 d4 (7 :: Unsigned 6) -- -- :... -- Couldn't match type ‘7 + i0’ with ‘6’ -- The type variable ‘i0’ is ambiguous -- Expected type: (6 + 1) + i0 -- Actual type: BitSize (Unsigned 6) --- In the expression: slice (7 :: Unsigned 6) d6 d4 --- In an equation for ‘it’: it = slice (7 :: Unsigned 6) d6 d4 -slice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => a -> SNat m -> SNat n +-- In the expression: slice d6 d4 (7 :: Unsigned 6) +-- In an equation for ‘it’: it = slice d6 d4 (7 :: Unsigned 6) +slice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => SNat m -> SNat n -> a -> BitVector (m + 1 - n) -slice v m n = slice# (pack v) m n +slice m n v = slice# (pack v) m n {-# INLINE split #-} -- | Split a value of a bit size @m + n@ into a tuple of values with size @m@ -- and size @n@. -- -- >>> pack (7 :: Unsigned 6) --- 000111 +-- 00_0111 -- >>> split (7 :: Unsigned 6) :: (BitVector 2, BitVector 4) -- (00,0111) split :: (BitPack a, BitSize a ~ (m + n), KnownNat n) => a @@ -80,20 +82,20 @@ -- __NB:__ Bit indices are __DESCENDING__. -- -- >>> pack (-5 :: Signed 6) --- 111011 --- >>> replaceBit (-5 :: Signed 6) 4 0 +-- 11_1011 +-- >>> replaceBit 4 0 (-5 :: Signed 6) -- -21 -- >>> pack (-21 :: Signed 6) --- 101011 --- >>> replaceBit (-5 :: Signed 6) 5 0 +-- 10_1011 +-- >>> replaceBit 5 0 (-5 :: Signed 6) -- 27 -- >>> pack (27 :: Signed 6) --- 011011 --- >>> replaceBit (-5 :: Signed 6) 6 0 +-- 01_1011 +-- >>> replaceBit 6 0 (-5 :: Signed 6) -- *** Exception: replaceBit: 6 is out of range [5..0] -replaceBit :: (BitPack a, KnownNat (BitSize a), Integral i) => a -> i -> Bit +replaceBit :: (BitPack a, KnownNat (BitSize a), Integral i) => i -> Bit -> a -> a -replaceBit v i b = unpack (replaceBit# (pack v) (fromIntegral i) b) +replaceBit i b v = unpack (replaceBit# (pack v) (fromIntegral i) b) {-# INLINE setSlice #-} -- | Set the bits between bit index @m@ and bit index @n@. @@ -101,33 +103,33 @@ -- __NB:__ Bit indices are __DESCENDING__. -- -- >>> pack (-5 :: Signed 6) --- 111011 --- >>> setSlice (-5 :: Signed 6) d4 d3 0 +-- 11_1011 +-- >>> setSlice d4 d3 0 (-5 :: Signed 6) -- -29 -- >>> pack (-29 :: Signed 6) --- 100011 --- >>> setSlice (-5 :: Signed 6) d6 d5 0 +-- 10_0011 +-- >>> setSlice d6 d5 0 (-5 :: Signed 6) -- -- :... -- Couldn't match type ‘7 + i0’ with ‘6’ -- The type variable ‘i0’ is ambiguous -- Expected type: (6 + 1) + i0 -- Actual type: BitSize (Signed 6) --- In the expression: setSlice (- 5 :: Signed 6) d6 d5 0 --- In an equation for ‘it’: it = setSlice (- 5 :: Signed 6) d6 d5 0 -setSlice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => a -> SNat m -> SNat n - -> BitVector (m + 1 - n) -> a -setSlice v m n w = unpack (setSlice# (pack v) m n w) +-- In the expression: setSlice d6 d5 0 (- 5 :: Signed 6) +-- In an equation for ‘it’: it = setSlice d6 d5 0 (- 5 :: Signed 6) +setSlice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => SNat m -> SNat n + -> BitVector (m + 1 - n) -> a -> a +setSlice m n w v = unpack (setSlice# (pack v) m n w) {-# INLINE msb #-} -- | Get the most significant bit. -- -- >>> pack (-4 :: Signed 6) --- 111100 +-- 11_1100 -- >>> msb (-4 :: Signed 6) -- 1 -- >>> pack (4 :: Signed 6) --- 000100 +-- 00_0100 -- >>> msb (4 :: Signed 6) -- 0 msb :: (BitPack a, KnownNat (BitSize a)) => a -> Bit @@ -137,11 +139,11 @@ -- | Get the least significant bit. -- -- >>> pack (-9 :: Signed 6) --- 110111 +-- 11_0111 -- >>> lsb (-9 :: Signed 6) -- 1 -- >>> pack (-8 :: Signed 6) --- 111000 +-- 11_1000 -- >>> lsb (-8 :: Signed 6) -- 0 lsb :: BitPack a => a -> Bit 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 @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -23,11 +25,11 @@ -- | Are all bits set to '1'? -- -- >>> pack (-2 :: Signed 6) --- 111110 +-- 11_1110 -- >>> reduceAnd (-2 :: Signed 6) -- 0 -- >>> pack (-1 :: Signed 6) --- 111111 +-- 11_1111 -- >>> reduceAnd (-1 :: Signed 6) -- 1 reduceAnd :: (BitPack a, KnownNat (BitSize a)) => a -> Bit @@ -37,11 +39,11 @@ -- | Is there at least one bit set to '1'? -- -- >>> pack (5 :: Signed 6) --- 000101 +-- 00_0101 -- >>> reduceOr (5 :: Signed 6) -- 1 -- >>> pack (0 :: Signed 6) --- 000000 +-- 00_0000 -- >>> reduceOr (0 :: Signed 6) -- 0 reduceOr :: BitPack a => a -> Bit @@ -51,15 +53,15 @@ -- | Is the number of bits set to '1' uneven? -- -- >>> pack (5 :: Signed 6) --- 000101 +-- 00_0101 -- >>> reduceXor (5 :: Signed 6) -- 0 -- >>> pack (28 :: Signed 6) --- 011100 +-- 01_1100 -- >>> reduceXor (28 :: Signed 6) -- 1 -- >>> pack (-5 :: Signed 6) --- 111011 +-- 11_1011 -- >>> reduceXor (-5 :: Signed 6) -- 1 reduceXor :: BitPack a => a -> Bit 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 @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Safe #-} + {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) @@ -103,7 +105,7 @@ where bram' (ram,_) (w,r,e,d) = (ram',o') where - ram' | e = replace ram w d + ram' | e = replace w d ram | otherwise = ram o' = ram !! r 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 @@ -3,6 +3,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) 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 @@ -1,5 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| diff --git a/src/CLaSH/Promoted/Nat.hs b/src/CLaSH/Promoted/Nat.hs --- a/src/CLaSH/Promoted/Nat.hs +++ b/src/CLaSH/Promoted/Nat.hs @@ -4,6 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} 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 @@ -1,6 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| diff --git a/src/CLaSH/Promoted/Ord.hs b/src/CLaSH/Promoted/Ord.hs --- a/src/CLaSH/Promoted/Ord.hs +++ b/src/CLaSH/Promoted/Ord.hs @@ -3,6 +3,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| diff --git a/src/CLaSH/Promoted/Symbol.hs b/src/CLaSH/Promoted/Symbol.hs --- a/src/CLaSH/Promoted/Symbol.hs +++ b/src/CLaSH/Promoted/Symbol.hs @@ -2,6 +2,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| diff --git a/src/CLaSH/Signal.hs b/src/CLaSH/Signal.hs --- a/src/CLaSH/Signal.hs +++ b/src/CLaSH/Signal.hs @@ -1,5 +1,7 @@ {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK show-extensions #-} @@ -30,6 +32,8 @@ , sample , sampleN , fromList + -- * QuickCheck combinators + , testFor -- * Type classes -- ** 'Eq'-like , (.==.), (./=.) @@ -65,7 +69,7 @@ shift1, rotate1, setBit1, clearBit1, shiftL1, unsafeShiftL1, shiftR1, unsafeShiftR1, rotateL1, rotateR1, (.||.), (.&&.), not1, mux, sample, - sampleN, fromList, simulate, signal) + sampleN, fromList, simulate, signal, testFor) import CLaSH.Signal.Explicit (SystemClock, systemClock, simulateB') import CLaSH.Signal.Bundle (Bundle (..), Unbundled') diff --git a/src/CLaSH/Signal/Bundle.hs b/src/CLaSH/Signal/Bundle.hs --- a/src/CLaSH/Signal/Bundle.hs +++ b/src/CLaSH/Signal/Bundle.hs @@ -4,6 +4,8 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -9,6 +9,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} @@ -41,6 +43,7 @@ import GHC.TypeLits (KnownNat, Nat, type (-)) import Language.Haskell.TH.Syntax (Lift) import Prelude hiding (head, length, repeat) +import Test.QuickCheck (Arbitrary, CoArbitrary) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum) import CLaSH.Promoted.Nat (SNat) @@ -74,7 +77,7 @@ } deriving (Show,Default,Lift,Functor,Applicative,Num,Bounded,Fractional, Real,Integral,SaturatingNum,Eq,Ord,Enum,Bits,FiniteBits,Foldable, - Traversable) + Traversable,Arbitrary,CoArbitrary) 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 @@ -2,6 +2,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -8,6 +8,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -33,6 +35,8 @@ , sample , sampleN , fromList + -- * QuickCheck combinators + , testFor -- * Type classes -- ** 'Eq'-like , (.==.), (./=.) @@ -74,6 +78,8 @@ import Data.Default (Default (..)) import GHC.TypeLits (Nat, Symbol) import Language.Haskell.TH.Syntax (Lift (..)) +import Test.QuickCheck (Arbitrary (..), CoArbitrary(..), Property, + property) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..)) import CLaSH.Promoted.Nat (SNat, snatToInteger) @@ -550,6 +556,24 @@ (/) = liftA2 (/) recip = fmap recip fromRational = signal# . fromRational + +instance Arbitrary a => Arbitrary (Signal' clk a) where + arbitrary = liftA2 (:-) arbitrary arbitrary + +instance CoArbitrary a => CoArbitrary (Signal' clk a) where + coarbitrary xs gen = do + n <- arbitrary + coarbitrary (take (abs n) (sample xs)) gen + +-- | The above type is a generalisation for: +-- +-- @ +-- __testFor__ :: 'Int' -> 'CLaSH.Signal.Signal' Bool -> 'Property' +-- @ +-- +-- @testFor n s@ tests the signal @s@ for @n@ cycles. +testFor :: Foldable f => Int -> f Bool -> Property +testFor n = property . and . take n . sample -- * List \<-\> Signal conversion (not synthesisable) diff --git a/src/CLaSH/Sized/BitVector.hs b/src/CLaSH/Sized/BitVector.hs --- a/src/CLaSH/Sized/BitVector.hs +++ b/src/CLaSH/Sized/BitVector.hs @@ -1,5 +1,7 @@ {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| 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 @@ -11,6 +11,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -73,6 +75,7 @@ import Language.Haskell.TH (Q, TExp, TypeQ, appT, conT, litT, mkName, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..)) +import Test.QuickCheck (Arbitrary, CoArbitrary) import CLaSH.Class.BitPack (BitPack (..)) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..), @@ -110,6 +113,8 @@ deriving instance Enum (rep (int + frac)) => Enum (Fixed rep int frac) deriving instance Bounded (rep (int + frac)) => Bounded (Fixed rep int frac) deriving instance Default (rep (int + frac)) => Default (Fixed rep int frac) +deriving instance Arbitrary (rep (int + frac)) => Arbitrary (Fixed rep int frac) +deriving instance CoArbitrary (rep (int + frac)) => CoArbitrary (Fixed rep int frac) -- | Instance functions do not saturate. -- Meaning that \"@`'shiftL'` 1 == 'satMult' 'SatWrap' 2'@\"" diff --git a/src/CLaSH/Sized/Index.hs b/src/CLaSH/Sized/Index.hs --- a/src/CLaSH/Sized/Index.hs +++ b/src/CLaSH/Sized/Index.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Trustworthy #-} {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) 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 @@ -8,6 +8,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -89,6 +91,7 @@ ) where +import Control.Lens (Index, Ixed (..), IxValue) import Data.Bits (Bits (..), FiniteBits (..)) import Data.Char (digitToInt) import Data.Default (Default (..)) @@ -99,6 +102,9 @@ import Language.Haskell.TH (Q, TExp, TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..)) import Numeric (readInt) +import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), + arbitrarySizedBoundedIntegral, + coarbitraryIntegral, shrinkIntegral) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..), SaturationMode (..)) @@ -126,7 +132,7 @@ -- * Instances instance KnownNat n => Show (BitVector n) where - show bv@(BV i) = showBV (natVal bv) i [] + show bv@(BV i) = reverse . underScore . reverse $ showBV (natVal bv) i [] where showBV 0 _ s = s showBV n v s = let (a,b) = divMod v 2 @@ -134,6 +140,10 @@ 1 -> showBV (n - 1) a ('1':s) _ -> showBV (n - 1) a ('0':s) + underScore xs = case splitAt 5 xs of + ([a,b,c,d,e],rest) -> [a,b,c,d,'_'] ++ underScore (e:rest) + (rest,_) -> rest + -- | Create a binary literal -- -- >>> $$(bLit "1001") :: BitVector 4 @@ -156,7 +166,7 @@ bLit s = [|| fromInteger# i' ||] where i :: Maybe Integer - i = fmap fst . listToMaybe $ (readInt 2 (`elem` "01") digitToInt) s + i = fmap fst . listToMaybe . (readInt 2 (`elem` "01") digitToInt) $ filter (/= '_') s i' :: Integer i' = case i of @@ -551,3 +561,15 @@ where r = times# a b (rL,rR) = split# r + +instance KnownNat n => Arbitrary (BitVector n) where + arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral + +instance KnownNat n => CoArbitrary (BitVector n) where + coarbitrary = coarbitraryIntegral + +type instance Index (BitVector n) = Int +type instance IxValue (BitVector n) = Bit +instance KnownNat n => Ixed (BitVector n) where + ix i f bv = replaceBit# bv i <$> f (index# bv i) diff --git a/src/CLaSH/Sized/Internal/Index.hs b/src/CLaSH/Sized/Internal/Index.hs --- a/src/CLaSH/Sized/Internal/Index.hs +++ b/src/CLaSH/Sized/Internal/Index.hs @@ -4,6 +4,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -47,6 +49,9 @@ import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..)) import GHC.TypeLits (KnownNat, Nat, natVal) +import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), + arbitrarySizedBoundedIntegral, + coarbitraryIntegral, shrinkIntegral) -- | Arbitrary-bounded unsigned integer represented by @ceil(log_2(n))@ bits. -- @@ -198,3 +203,10 @@ instance KnownNat n => Default (Index n) where def = fromInteger# 0 + +instance KnownNat n => Arbitrary (Index n) where + arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral + +instance KnownNat n => CoArbitrary (Index n) where + coarbitrary = coarbitraryIntegral 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 @@ -8,6 +8,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -76,11 +78,15 @@ ) where +import Control.Lens (Index, Ixed (..), IxValue) import Data.Bits (Bits (..), FiniteBits (..)) import Data.Default (Default (..)) import GHC.TypeLits (KnownNat, Nat, type (+), natVal) import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..)) +import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), + arbitrarySizedBoundedIntegral, + coarbitraryIntegral, shrinkIntegral) import CLaSH.Class.BitPack (BitPack (..)) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..), @@ -89,7 +95,7 @@ import CLaSH.Prelude.BitIndex ((!), msb, replaceBit, split) import CLaSH.Prelude.BitReduction (reduceAnd, reduceOr) import CLaSH.Promoted.Ord (Max) -import CLaSH.Sized.Internal.BitVector (BitVector (..), (++#), high, low) +import CLaSH.Sized.Internal.BitVector (BitVector (..), Bit, (++#), high, low) import qualified CLaSH.Sized.Internal.BitVector as BV -- | Arbitrary-width signed integer represented by @n@ bits, including the sign @@ -314,10 +320,10 @@ xor = xor# complement = complement# zeroBits = 0 - bit i = replaceBit 0 i high - setBit v i = replaceBit v i high - clearBit v i = replaceBit v i low - complementBit v i = replaceBit v i (BV.complement# (v ! i)) + bit i = replaceBit i high 0 + setBit v i = replaceBit i high v + clearBit v i = replaceBit i low v + complementBit v i = replaceBit i (BV.complement# (v ! i)) v testBit v i = v ! i == 1 bitSizeMaybe v = Just (size# v) bitSize = size# @@ -470,3 +476,16 @@ minBoundSym# :: KnownNat n => Signed n minBoundSym# = minBound# +# fromInteger# 1 + +instance KnownNat n => Arbitrary (Signed n) where + arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral + +instance KnownNat n => CoArbitrary (Signed n) where + coarbitrary = coarbitraryIntegral + +type instance Index (Signed n) = Int +type instance IxValue (Signed n) = Bit +instance KnownNat n => Ixed (Signed n) where + ix i f s = unpack# <$> BV.replaceBit# (pack# s) i + <$> f (BV.index# (pack# s) i) diff --git a/src/CLaSH/Sized/Internal/Unsigned.hs b/src/CLaSH/Sized/Internal/Unsigned.hs --- a/src/CLaSH/Sized/Internal/Unsigned.hs +++ b/src/CLaSH/Sized/Internal/Unsigned.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Unsafe #-} + {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -70,11 +72,15 @@ ) where +import Control.Lens (Index, Ixed (..), IxValue) import Data.Bits (Bits (..), FiniteBits (..)) import Data.Default (Default (..)) import GHC.TypeLits (KnownNat, Nat, type (+), natVal) import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..)) +import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..), + arbitrarySizedBoundedIntegral, + coarbitraryIntegral, shrinkIntegral) import CLaSH.Class.BitPack (BitPack (..)) import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..), @@ -83,7 +89,7 @@ import CLaSH.Prelude.BitIndex ((!), msb, replaceBit, split) import CLaSH.Prelude.BitReduction (reduceOr) import CLaSH.Promoted.Ord (Max) -import CLaSH.Sized.Internal.BitVector (BitVector (..), high, low) +import CLaSH.Sized.Internal.BitVector (BitVector (..), Bit, high, low) import qualified CLaSH.Sized.Internal.BitVector as BV -- | Arbitrary-width unsigned integer represented by @n@ bits @@ -289,10 +295,10 @@ xor = xor# complement = complement# zeroBits = 0 - bit i = replaceBit 0 i high - setBit v i = replaceBit v i high - clearBit v i = replaceBit v i low - complementBit v i = replaceBit v i (BV.complement# (v ! i)) + bit i = replaceBit i high 0 + setBit v i = replaceBit i high v + clearBit v i = replaceBit i low v + complementBit v i = replaceBit i (BV.complement# (v ! i)) v testBit v i = v ! i == high bitSizeMaybe v = Just (size# v) bitSize = size# @@ -408,3 +414,16 @@ where r = times# a b (rL,rR) = split r + +instance KnownNat n => Arbitrary (Unsigned n) where + arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral + +instance KnownNat n => CoArbitrary (Unsigned n) where + coarbitrary = coarbitraryIntegral + +type instance Index (Unsigned n) = Int +type instance IxValue (Unsigned n) = Bit +instance KnownNat n => Ixed (Unsigned n) where + ix i f s = unpack# <$> BV.replaceBit# (pack# s) i + <$> f (BV.index# (pack# s) i) diff --git a/src/CLaSH/Sized/Signed.hs b/src/CLaSH/Sized/Signed.hs --- a/src/CLaSH/Sized/Signed.hs +++ b/src/CLaSH/Sized/Signed.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Trustworthy #-} {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) diff --git a/src/CLaSH/Sized/Unsigned.hs b/src/CLaSH/Sized/Unsigned.hs --- a/src/CLaSH/Sized/Unsigned.hs +++ b/src/CLaSH/Sized/Unsigned.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Trustworthy #-} {-| Copyright : (C) 2013-2015, University of Twente License : BSD2 (see the file LICENSE) 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 @@ -12,6 +12,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} + {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_HADDOCK show-extensions #-} @@ -52,6 +54,7 @@ ) where +import Control.Lens (Index, Ixed (..), IxValue) import Data.Default (Default (..)) import qualified Data.Foldable as F import Data.Proxy (Proxy (..)) @@ -69,6 +72,7 @@ splitAt, tail, take, unzip, unzip3, zip, zip3, zipWith, zipWith3) import qualified Prelude as P +import Test.QuickCheck (Arbitrary (..), CoArbitrary (..)) import Unsafe.Coerce (unsafeCoerce) import CLaSH.Promoted.Nat (SNat (..), UNat (..), withSNat, toUNat) @@ -827,14 +831,14 @@ -- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex'. -- --- >>> replace (1:>2:>3:>4:>5:>Nil) 3 7 +-- >>> replace 3 7 (1:>2:>3:>4:>5:>Nil) -- <1,2,3,7,5> --- >>> replace (1:>2:>3:>4:>5:>Nil) 0 7 +-- >>> replace 0 7 (1:>2:>3:>4:>5:>Nil) -- <7,2,3,4,5> --- >>> replace (1:>2:>3:>4:>5:>Nil) 9 7 +-- >>> replace 9 7 (1:>2:>3:>4:>5:>Nil) -- <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_int xs (fromIntegral i) y +replace :: (KnownNat n, Integral i) => i -> a -> Vec n a -> Vec n a +replace i y xs = replace_int xs (fromIntegral i) y {-# INLINABLE take #-} -- | 'take' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@ @@ -1225,8 +1229,13 @@ concatBitVector# :: KnownNat m => Vec n (BitVector m) -> BitVector (n * m) -concatBitVector# Nil = 0 -concatBitVector# (x :> xs) = concatBitVector# xs ++# x +concatBitVector# = concatBitVector' . reverse + where + concatBitVector' :: KnownNat m + => Vec n (BitVector m) + -> BitVector (n * m) + concatBitVector' Nil = 0 + concatBitVector' (x :> xs) = concatBitVector' xs ++# x {-# NOINLINE unconcatBitVector# #-} unconcatBitVector# :: (KnownNat n, KnownNat m) @@ -1239,8 +1248,20 @@ => UNat n -> BitVector (n * m) -> Vec n (BitVector m) ucBV UZero _ = Nil ucBV (USucc n) bv = let (bv',x :: BitVector m) = split# bv - in x :> ucBV n bv' + in ucBV n bv' <: x instance Lift a => Lift (Vec n a) where lift Nil = [| Nil |] lift (x:>xs) = [| x :> $(lift xs) |] + +instance (KnownNat n, Arbitrary a) => Arbitrary (Vec n a) where + arbitrary = sequence $ repeat arbitrary + shrink = sequence . fmap shrink + +instance CoArbitrary a => CoArbitrary (Vec n a) where + coarbitrary = coarbitrary . toList + +type instance Index (Vec n a) = Int +type instance IxValue (Vec n a) = a +instance KnownNat n => Ixed (Vec n a) where + ix i f xs = replace_int xs i <$> f (index_int xs i) diff --git a/src/CLaSH/Tutorial.hs b/src/CLaSH/Tutorial.hs --- a/src/CLaSH/Tutorial.hs +++ b/src/CLaSH/Tutorial.hs @@ -3,7 +3,7 @@ {-| Copyright : © Christiaan Baaij, 2014-2015 -Licence : Creative Commons 4.0 (CC BY-NC 4.0) (http://creativecommons.org/licenses/by-nc/4.0/) +Licence : Creative Commons 4.0 (CC BY 4.0) (http://creativecommons.org/licenses/by/4.0/) -} module CLaSH.Tutorial ( -- * Introduction @@ -39,12 +39,15 @@ -- * Composition of sequential circuits -- $composition_sequential - -- * TopEntity annotations: controlling the VHDL/Verilog generation. + -- * TopEntity annotations: controlling the VHDL\/Verilog\/SystemVerilog generation. -- $annotations -- * Advanced: Primitives -- $primitives + -- *** Verilog primitives + -- $vprimitives + -- *** SystemVerilog primitives -- $svprimitives @@ -110,8 +113,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 or -SystemVerilog. +transforms these high-level descriptions to low-level synthesizable VHDL, +Verilog, 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 @@ -159,6 +162,29 @@ * Make sure that the @bin@ directory of __GHC__ is in your @PATH@. + The following are alternative options, if the cannot find what you are looking for on + + * Ubuntu: + + * Run: @sudo add-apt-repository -y ppa:hvr/ghc@ + * Run: @sudo apt-get update@ + * Run: @sudo apt-get install cabal-install-1.22 ghc-7.10.1 libtinfo-dev@ + * Update your @PATH@ with: @\/opt\/ghc\/7.10.1\/bin@, @\/opt\/cabal\/1.22/bin@, and @\$HOME\/.cabal\/bin@ + * Run: @cabal update@ + * Skip step 2. + + * OS X: + + * Follow the instructions on: + * Run: @cabal update@ + * Skip step 2. + + * Windows: + + * Follow the instructions on: + * Run: @cabal update@ + * Skip step 2. + (2) Install __Cabal (version 1.22.* or higher)__ * Binary, when available: @@ -174,24 +200,26 @@ * Download the sources for * Unpack (@tar xf@) the archive and @cd@ to the directory - * Run @sh bootstrap.sh@ + * Run: @sh bootstrap.sh@ * Follow the instructions to add @cabal@ to your @PATH@ * Run @cabal update@ (2) Install __CλaSH__ - * Run @cabal install clash-ghc --enable-documentation --enable-profiling@ + * Run @cabal install clash-ghc --enable-documentation@ * /This is going to take awhile, so have a refreshment/ (4) Verify that everything is working by: * Downloading the example - * Run @clash --interactive FIR.hs@ + * Run: @clash --interactive FIR.hs@ * Execute, in the interpreter, the @:vhdl@ command + * Execute, in the interpreter, the @:verilog@ command * Execute, in the interpreter, the @:systemverilog@ command * Exit the interpreter using @:q@ * Examine the VHDL code in the @vhdl@ directory + * Examine the Verilog code in the @verilog@ directory * Examine the SystemVerilog code in the @systemverilog@ directory -} @@ -205,10 +233,10 @@ clash --interactive @ -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 \@ 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 three +added command (@:vhdl@, @:verilog@, and @:systemverilog@). You can load files +into the interpreter using the @:l \@ command. Now, depending on your +choice in editor, the following @edit-load-run@ cycle probably work best for you: * __Commandline (e.g. emacs, vim):__ @@ -433,7 +461,7 @@ 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 -into your favourite VHDL synthesis tool, marking @topEntity_0.vhdl@ as the file +into your favourite VHDL synthesis tool, marking @MAC_topEntity.vhdl@ as the file containing the top level entity. -} @@ -447,7 +475,7 @@ * Verify that the VHDL output of the CλaSH compiler has the same behaviour as the Haskell / CλaSH specification. -For these purposes, you can have CλaSH compiler generate a @testbench.vhdl@ +For these purposes, you can have CλaSH compiler generate a @MAC_testbench.vhdl@ file which contains a stimulus generator and an expected output verifier. The CλaSH compiler looks for the following functions to generate these to aspects: @@ -521,12 +549,14 @@ -} {- $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@. +Aside from being to generate VHDL, the CλaSH compiler can also generate Verilog +and SystemVerilog. You can repeat the previous two parts of the tutorial, but +instead of executing the @:vhdl@ command, you execute the @:verilog@ or +@:sytemverilog@ command in the interpreter. This will create a directory called +@verilog@, respectively @systemverilog@, which contains a directory called @MAC@, +which ultimately contains all the generated Verilog and SystemVerilog files. +Verilog files end in the file extension @v@, while SystemVerilog files end in +the file 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 @@ -778,7 +808,7 @@ | otherwise = leds @ -The CλaSH compiler will normally generate the following @topEntity.vhdl@ file: +The CλaSH compiler will normally generate the following @Blinker_topEntity.vhdl@ file: @ -- Automatically generated VHDL @@ -787,9 +817,9 @@ use IEEE.NUMERIC_STD.ALL; use IEEE.MATH_REAL.ALL; use work.all; -use work.types.all; +use work.Blinker_types.all; -entity topEntity is +entity Blinker_topEntity is port(input_0 : in std_logic_vector(0 downto 0); -- clock system1000 : in std_logic; @@ -798,9 +828,9 @@ output_0 : out std_logic_vector(7 downto 0)); end; -architecture structural of topEntity is +architecture structural of Blinker_topEntity is begin - topEntity_0_inst : entity topEntity_0 + Blinker_topEntity_0_inst : entity Blinker_topEntity_0 port map (key1_i1 => input_0 ,system1000 => system1000 @@ -833,7 +863,7 @@ use IEEE.NUMERIC_STD.ALL; use IEEE.MATH_REAL.ALL; use work.all; -use work.types.all; +use work.Blinker_types.all; entity blinker is port(KEY1 : in std_logic_vector(0 downto 0); @@ -873,7 +903,7 @@ system1000_rstn <= n_2; end block; - topEntity_0_inst : entity topEntity_0 + Blinker_topEntity_0_inst : entity Blinker_topEntity_0 port map (key1_i1 => KEY1 ,system1000 => system1000 @@ -908,12 +938,15 @@ 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 -(or +(or +for the Verilog primitives or 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\/\\/clash-ghc\-\/primitives@ + * @$CABAL_DIR\/share\/\\/clash-vhdl\-\/primitives@ + * @$CABAL_DIR\/share\/\\/clash-verilog\-\/primitives@ + * @$CABAL_DIR\/share\/\\/clash-systemverilog\-\/primitives@ * The current directory (the location given by @pwd@) Where redefined primitives in the current directory will overwrite those in @@ -1014,7 +1047,7 @@ { \"BlackBox\" : { "name" : "CLaSH.Prelude.BlockRam.blockRam'" , "templateD" : -"blockram_~SYM[0] : block +"blockRam_~COMPNAME_~SYM[0] : block signal ~SYM[1] : ~TYP[3] := ~LIT[3]; -- ram signal ~SYM[2] : ~TYP[7]; -- inp signal ~SYM[3] : ~TYP[7]; -- outp @@ -1070,7 +1103,11 @@ of the signal, and the type of the result. * @~TYPELEM[\]@: The element type of the vector type represented by @\@. The content of @\@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\]@. - +* @~COMPNAME@: The name of the component in which the primitive is instantiated. +* @~LENGHT[\]@: The vector length of the type represented by @\@. + The content of @\@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\]@. +* @~SIZE[\]@: The number of bits needed to encode the type represented by @\@. + The content of @\@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\]@. 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 @@ -1086,8 +1123,51 @@ worlds, using e.g. VHDL's foreign function interface VHPI. -} +{- $vprimitives +For those who are interested, the equivalent Verilog primitives are: + +@ +{ \"BlackBox\" : + { "name" : "CLaSH.Sized.Internal.Signed.*#" + , "templateE" : "~ARG[1] * ~ARG[2]" + } +} +@ + +and + +@ +{ \"BlackBox\" : + { "name" : "CLaSH.Prelude.BlockRam.blockRam'" + , "templateD" : +"// blockRam +reg ~TYPO ~SYM[0] [0:~LIT[0]-1]; +reg ~SIGD[~SYM[1]][7]; + +reg ~TYP[3] ~SYM[2]; +integer ~SYM[3]; +initial begin + ~SYM[2] = ~ARG[3]; + for (~SYM[3]=0; ~SYM[3] < ~LIT[0]; ~SYM[3] = ~SYM[3] + 1) begin + ~SYM[0][~LIT[0]-1-~SYM[3]] = ~SYM[2][~SYM[3]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + end +end + +always @(posedge ~CLK[2]) begin : blockRam_~COMPNAME_~SYM[4] + if (~ARG[6]) begin + ~SYM[0][~ARG[4]] <= ~ARG[7]; + end + ~SYM[1] <= ~SYM[0][~ARG[5]]; +end + +assign ~RESULT = ~SYM[1];" + } + } +@ +-} + {- $svprimitives -For those who are interested, the equivalent SystemVerilog primitives are: +And the equivalent SystemVerilog primitives are: @ { \"BlackBox\" : @@ -1290,7 +1370,7 @@ {- $unsupported #unsupported# Here is a list of Haskell features which the CλaSH compiler cannot synthesize -to VHDL/SystemVerilog (for now): +to VHDL/Verilog/SystemVerilog (for now): [@Recursive functions@] @@ -1355,8 +1435,9 @@ The translations of 'Int', @@, and 'Integer' are also incorrect: they are translated to the VHDL @integer@ - type, or the SystemVerilog @signed logic [31:0]@ type, which can only - represent 32-bit integer values. Use these types with due diligence. + type, the Verilog @signed [31:0], 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', 'Control.Monad.ST.ST', etc.@]