clash-prelude 0.7.5 → 0.8

raw patch · 37 files changed

+1067/−101 lines, 37 filesdep +QuickCheckdep +lensdep +transformersdep ~doctestdep ~ghc-typelits-natnormalisePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, lens, transformers

Dependency ranges changed: doctest, ghc-typelits-natnormalise

API changes (from Hackage documentation)

Files

• CHANGELOG.md +42/−0
• clash-prelude.cabal +16/−2
• src/CLaSH/Annotations/TopEntity.hs +2/−0
• src/CLaSH/Class/BitPack.hs +7/−5
• src/CLaSH/Class/Num.hs +2/−0
• src/CLaSH/Class/Resize.hs +2/−0
• src/CLaSH/Examples.hs +654/−0
• src/CLaSH/Prelude.hs +3/−0
• src/CLaSH/Prelude/BitIndex.hs +32/−30
• src/CLaSH/Prelude/BitReduction.hs +9/−7
• src/CLaSH/Prelude/BlockRam.hs +3/−1
• src/CLaSH/Prelude/DataFlow.hs +2/−0
• src/CLaSH/Prelude/Explicit.hs +2/−0
• src/CLaSH/Prelude/Mealy.hs +2/−0
• src/CLaSH/Prelude/Moore.hs +2/−0
• src/CLaSH/Prelude/Testbench.hs +2/−0
• src/CLaSH/Promoted/Nat.hs +2/−0
• src/CLaSH/Promoted/Nat/Literals.hs +2/−0
• src/CLaSH/Promoted/Nat/TH.hs +2/−0
• src/CLaSH/Promoted/Ord.hs +2/−0
• src/CLaSH/Promoted/Symbol.hs +2/−0
• src/CLaSH/Signal.hs +5/−1
• src/CLaSH/Signal/Bundle.hs +2/−0
• src/CLaSH/Signal/Delayed.hs +4/−1
• src/CLaSH/Signal/Explicit.hs +2/−0
• src/CLaSH/Signal/Internal.hs +24/−0
• src/CLaSH/Sized/BitVector.hs +2/−0
• src/CLaSH/Sized/Fixed.hs +5/−0
• src/CLaSH/Sized/Index.hs +1/−0
• src/CLaSH/Sized/Internal/BitVector.hs +24/−2
• src/CLaSH/Sized/Internal/Index.hs +12/−0
• src/CLaSH/Sized/Internal/Signed.hs +24/−5
• src/CLaSH/Sized/Internal/Unsigned.hs +24/−5
• src/CLaSH/Sized/Signed.hs +1/−0
• src/CLaSH/Sized/Unsigned.hs +1/−0
• src/CLaSH/Sized/Vector.hs +29/−8
• src/CLaSH/Tutorial.hs +115/−34

@@ -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

@@ -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

@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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

@@ -2,6 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -3,6 +3,8 @@ {-# LANGUAGE KindSignatures   #-} {-# LANGUAGE TypeOperators    #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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+                      }+@+-}

@@ -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

@@ -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) -- <BLANKLINE> -- <interactive>:... --     Couldn't match type ‘7 + i0’ with ‘6’ --     The type variable ‘i0’ is ambiguous --     Expected type: (6 + 1) + i0 --       Actual type: BitSize (Unsigned 6)---     In the expression: slice (7 :: Unsigned 6) d6 d4---     In an equation for ‘it’: it = slice (7 :: Unsigned 6) d6 d4-slice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => a -> SNat m -> SNat n+--     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) -- <BLANKLINE> -- <interactive>:... --     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

@@ -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

@@ -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 

@@ -3,6 +3,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators    #-} +{-# LANGUAGE Unsafe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {-|   Copyright  :  (C) 2013-2015, University of Twente   License    :  BSD2 (see the file LICENSE)

@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {-|   Copyright  :  (C) 2013-2015, University of Twente   License    :  BSD2 (see the file LICENSE)

@@ -1,5 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Unsafe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -4,6 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators       #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_HADDOCK show-extensions #-} 

@@ -1,6 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds       #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -3,6 +3,8 @@ {-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -2,6 +2,8 @@ {-# LANGUAGE GADTs          #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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') 

@@ -4,6 +4,8 @@ {-# LANGUAGE MagicHash         #-} {-# LANGUAGE TypeFamilies      #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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)

@@ -2,6 +2,8 @@ {-# LANGUAGE GADTs     #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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) 

@@ -1,5 +1,7 @@ {-# LANGUAGE MagicHash #-} +{-# LANGUAGE Trustworthy #-}+ {-# OPTIONS_HADDOCK show-extensions #-}  {-|

@@ -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'@\""

@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} {-| Copyright  :  (C) 2013-2015, University of Twente License    :  BSD2 (see the file LICENSE)

@@ -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)

@@ -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

@@ -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)

@@ -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)

@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} {-| Copyright  :  (C) 2013-2015, University of Twente License    :  BSD2 (see the file LICENSE)

@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} {-| Copyright  :  (C) 2013-2015, University of Twente License    :  BSD2 (see the file LICENSE)

@@ -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)

@@ -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 <http://www.haskell.org/ghc/download>++      * 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: <https://ghcformacosx.github.io/ Haskell for Max OS X>+          * Run: @cabal update@+          * Skip step 2.++      * Windows:++          * Follow the instructions on: <https://github.com/fpco/minghc MinGHC>+          * 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 <http://hackage.haskell.org/package/cabal-install cabal-install>           * 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 <https://raw.github.com/clash-lang/clash-compiler/master/examples/FIR.hs Fir.hs> 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 \<FILENAME\>@ command. Now, depending on your choice in editor,-the following @edit-load-run@ cycle probably work best for you:+For those familiar with Haskell/GHC, this is indeed just @GHCi@, with three+added command (@:vhdl@, @:verilog@, and @:systemverilog@). You can load files+into the interpreter using the @:l \<FILENAME\>@ command. Now, depending on your+choice in editor, the following @edit-load-run@ cycle probably work best for you:    * __Commandline (e.g. emacs, vim):__ @@ -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 <https://github.com/clash-lang/clash-compiler/tree/master/clash-vhdl/primitives>-(or <https://github.com/clash-lang/clash-compiler/tree/master/clash-systemverilog/primitives>+(or <https://github.com/clash-lang/clash-compiler/tree/master/clash-verilog/primitives>+for the Verilog primitives or <https://github.com/clash-lang/clash-compiler/tree/master/clash-systemverilog/primitives> for the SystemVerilog primitives) if you want to know which functions are defined as \"regular\" primitives. The compiler looks for primitives in two locations:  * The official install location: e.g.-  @$CABAL_DIR\/share\/\<GHC_VERSION\>\/clash-ghc\-<VERSION\>\/primitives@+  * @$CABAL_DIR\/share\/\<GHC_VERSION\>\/clash-vhdl\-<VERSION\>\/primitives@+  * @$CABAL_DIR\/share\/\<GHC_VERSION\>\/clash-verilog\-<VERSION\>\/primitives@+  * @$CABAL_DIR\/share\/\<GHC_VERSION\>\/clash-systemverilog\-<VERSION\>\/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[\<HOLE\>]@: The element type of the vector type represented by @\<HOLE\>@.   The content of @\<HOLE\>@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.-+* @~COMPNAME@: The name of the component in which the primitive is instantiated.+* @~LENGHT[\<HOLE\>]@: The vector length of the type represented by @\<HOLE\>@.+  The content of @\<HOLE\>@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.+* @~SIZE[\<HOLE\>]@: The number of bits needed to encode the type represented by @\<HOLE\>@.+  The content of @\<HOLE\>@ must either be: @TYPM[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.  Some final remarks to end this section: VHDL primitives are there to instruct the CλaSH compiler to use the given VHDL template, instead of trying to do normal@@ -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',     @<http://hackage.haskell.org/package/ghc-prim/docs/GHC-Prim.html#t:Int-35- Int#>@,     and 'Integer' are also incorrect: they are translated to the VHDL @integer@-    type, 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.@]