clash-prelude 0.11 → 0.11.1
raw patch · 14 files changed
+184/−124 lines, 14 filesdep +halfdep +vectorPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: half, vector
API changes (from Hackage documentation)
+ CLaSH.Annotations.Primitive: Primitive :: HDL -> FilePath -> Primitive
+ CLaSH.Annotations.Primitive: SystemVerilog :: HDL
+ CLaSH.Annotations.Primitive: VHDL :: HDL
+ CLaSH.Annotations.Primitive: Verilog :: HDL
+ CLaSH.Annotations.Primitive: data HDL
+ CLaSH.Annotations.Primitive: data Primitive
+ CLaSH.Annotations.Primitive: instance Data.Data.Data CLaSH.Annotations.Primitive.HDL
+ CLaSH.Annotations.Primitive: instance Data.Data.Data CLaSH.Annotations.Primitive.Primitive
+ CLaSH.Annotations.Primitive: instance GHC.Classes.Eq CLaSH.Annotations.Primitive.HDL
+ CLaSH.Annotations.Primitive: instance GHC.Read.Read CLaSH.Annotations.Primitive.HDL
+ CLaSH.Annotations.Primitive: instance GHC.Read.Read CLaSH.Annotations.Primitive.Primitive
+ CLaSH.Annotations.Primitive: instance GHC.Show.Show CLaSH.Annotations.Primitive.HDL
+ CLaSH.Annotations.Primitive: instance GHC.Show.Show CLaSH.Annotations.Primitive.Primitive
+ CLaSH.Class.BitPack: instance (CLaSH.Class.BitPack.BitPack a, GHC.TypeLits.KnownNat (CLaSH.Class.BitPack.BitSize a)) => CLaSH.Class.BitPack.BitPack (GHC.Base.Maybe a)
+ CLaSH.Class.BitPack: instance CLaSH.Class.BitPack.BitPack Foreign.C.Types.CUShort
+ CLaSH.Class.BitPack: instance CLaSH.Class.BitPack.BitPack Numeric.Half.Half
+ CLaSH.XException: infixr 0 `seqX`
+ CLaSH.XException: seqX :: a -> b -> b
- CLaSH.Prelude: blockRam :: (KnownNat n, Enum addr) => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
+ CLaSH.Prelude: blockRam :: Enum addr => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
- CLaSH.Prelude.BlockRam: blockRam :: (KnownNat n, Enum addr) => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
+ CLaSH.Prelude.BlockRam: blockRam :: Enum addr => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
- CLaSH.Prelude.BlockRam: blockRam# :: KnownNat n => SClock clk -> Vec n a -> Signal' clk Int -> Signal' clk Bool -> Signal' clk Int -> Signal' clk a -> Signal' clk a
+ CLaSH.Prelude.BlockRam: blockRam# :: SClock clk -> Vec n a -> Signal' clk Int -> Signal' clk Bool -> Signal' clk Int -> Signal' clk a -> Signal' clk a
- CLaSH.Prelude.BlockRam: blockRam' :: (KnownNat n, Enum addr) => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
+ CLaSH.Prelude.BlockRam: blockRam' :: Enum addr => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
- CLaSH.Prelude.Explicit: blockRam' :: (KnownNat n, Enum addr) => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
+ CLaSH.Prelude.Explicit: blockRam' :: Enum addr => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
- CLaSH.Prelude.Explicit.Safe: blockRam' :: (KnownNat n, Enum addr) => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
+ CLaSH.Prelude.Explicit.Safe: blockRam' :: Enum addr => SClock clk -> Vec n a -> Signal' clk addr -> Signal' clk (Maybe (addr, a)) -> Signal' clk a
- CLaSH.Prelude.Safe: blockRam :: (KnownNat n, Enum addr) => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
+ CLaSH.Prelude.Safe: blockRam :: Enum addr => Vec n a -> Signal addr -> Signal (Maybe (addr, a)) -> Signal a
Files
- CHANGELOG.md +6/−0
- clash-prelude.cabal +5/−2
- src/CLaSH/Annotations/Primitive.hs +25/−0
- src/CLaSH/Class/BitPack.hs +23/−0
- src/CLaSH/Class/Num.hs +1/−1
- src/CLaSH/Prelude/BlockRam.hs +31/−42
- src/CLaSH/Prelude/BlockRam/File.hs +28/−34
- src/CLaSH/Prelude/RAM.hs +21/−31
- src/CLaSH/Signal/Bundle.hs +12/−1
- src/CLaSH/Signal/Internal.hs +4/−4
- src/CLaSH/Sized/Internal/BitVector.hs +2/−0
- src/CLaSH/Sized/Vector.hs +1/−1
- src/CLaSH/Tutorial.hs +6/−6
- src/CLaSH/XException.hs +19/−2
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.11.1 *April 10th 2017*+* Changes:+ * Bundle instance for `()` behaves like a product-type instance [#96](https://github.com/clash-lang/clash-prelude/issues/96)+* Fixes bugs:+ * Ensure that `fold` gets correctly type-applied in `Vec.==` [#202](https://github.com/clash-lang/clash-compiler/issues/202)+ ## 0.11 *January 16th 2017* * New features: * `CLaSH.XException`: a module defining an exception representing uninitialised values. Additionally adds the `ShowX` class which has methods that print values as "X" where they would normally raise an `XException` exception.
clash-prelude.cabal view
@@ -1,5 +1,5 @@ Name: clash-prelude-Version: 0.11+Version: 0.11.1 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -86,6 +86,7 @@ ghc-options: -Wall -fexpose-all-unfoldings Exposed-modules: CLaSH.Annotations.TopEntity+ CLaSH.Annotations.Primitive CLaSH.Class.BitPack CLaSH.Class.Num@@ -180,11 +181,13 @@ ghc-typelits-extra >= 0.2.1 && < 0.3, ghc-typelits-knownnat >= 0.2.2 && < 0.3, ghc-typelits-natnormalise >= 0.4.2 && < 0.6,+ half >= 0.2.2.3 && < 1.0, lens >= 4.9 && < 4.16, QuickCheck >= 2.7 && < 2.10, reflection >= 2 && < 2.2, singletons >= 1.0 && < 3.0,- template-haskell >= 2.9.0.0 && < 2.12+ template-haskell >= 2.9.0.0 && < 2.12,+ vector >= 0.11 && < 1.0 if flag(doclinks) CPP-Options: -DDOCLINKS
+ src/CLaSH/Annotations/Primitive.hs view
@@ -0,0 +1,25 @@+{-|+Copyright : (C) 2017, QBayLogic+License : BSD2 (see the file LICENSE)+Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}++{-# LANGUAGE DeriveDataTypeable #-}++{-# LANGUAGE Safe #-}++{-# OPTIONS_HADDOCK show-extensions #-}++module CLaSH.Annotations.Primitive where++import Data.Data++data HDL+ = SystemVerilog+ | Verilog+ | VHDL+ deriving (Eq, Show, Read, Data)++data Primitive+ = Primitive HDL FilePath+ deriving (Show, Read, Data)
src/CLaSH/Class/BitPack.hs view
@@ -30,7 +30,9 @@ wordToFloat) import Data.Int import Data.Word+import Foreign.C.Types (CUShort) import GHC.TypeLits (KnownNat, Nat, type (+))+import Numeric.Half (Half (..)) import Prelude hiding (map) import CLaSH.Class.Resize (zeroExtend)@@ -169,6 +171,16 @@ unpackDouble# = wordToDouble . fromInteger . unsafeToInteger {-# NOINLINE unpackDouble# #-} +instance BitPack CUShort where+ type BitSize CUShort = 16+ pack = fromIntegral+ unpack = fromIntegral++instance BitPack Half where+ type BitSize Half = 16+ pack (Half x) = pack x+ unpack x = Half (unpack x)+ instance BitPack () where type BitSize () = 0 pack _ = minBound@@ -215,6 +227,17 @@ type BitSize (a,b,c,d,e,f,g,h) = BitSize (a,b,c,d,e,f,g) + BitSize h pack (a,b,c,d,e,f,g,h) = pack (a,b,c,d,e,f,g) ++# pack h unpack (unpack -> ((a,b,c,d,e,f,g), h)) = (a,b,c,d,e,f,g,h)++instance (BitPack a, KnownNat (BitSize a)) => BitPack (Maybe a) where+ type BitSize (Maybe a) = 1 + BitSize a+ pack Nothing = low ++# 0+ -- We cannot do `low ++# undefined`, because `BitVector`s underlying+ -- representation is `Integer`, so `low ++# undefined` would make the+ -- entire `BitVector` undefined.+ pack (Just x) = high ++# pack x+ unpack x = case split# x of+ (c,rest) | c == low -> Nothing+ | otherwise -> Just (unpack rest) -- | Zero-extend a 'Bool'ean value to a 'BitVector' of the appropriate size. --
src/CLaSH/Class/Num.hs view
@@ -50,7 +50,7 @@ = SatWrap -- ^ Wrap around on overflow and underflow | SatBound -- ^ Become 'maxBound' on overflow, and 'minBound' on underflow | SatZero -- ^ Become @0@ on overflow and underflow- | SatSymmetric -- ^ Become 'maxBound' on overflow, and (@'minBound' - 1@) on+ | SatSymmetric -- ^ Become 'maxBound' on overflow, and (@'minBound' + 1@) on -- underflow for signed numbers, and 'minBound' for unsigned -- numbers. deriving Eq
src/CLaSH/Prelude/BlockRam.hs view
@@ -201,9 +201,10 @@ @ Again, we can simulate our system and see that it works. This time however,-we need to drop the first few output samples, because the initial content of an+we need to disregard the first few output samples, because the initial content of an 'CLaSH.Prelude.RAM.asyncRam' is 'undefined', and consequently, the first few-output samples are also 'undefined'.+output samples are also 'undefined'. We use the utility function 'printX' to conveniently+filter out the undefinedness and replace it with the string "X" in the few leading outputs. @ >>> printX $ sampleN 31 $ system2 prog@@ -321,9 +322,9 @@ @ When we simulate our system we see that it works. This time again,-we need to drop the first sample, because the initial output of a-'blockRam' is 'undefined', and consequently, the first output sample is-also 'undefined'.+we need to disregard the first sample, because the initial output of a+'blockRam' is 'undefined'. We use the utility function 'printX' to conveniently+filter out the undefinedness and replace it with the string "X". @ >>> printX $ sampleN 33 $ system3 prog2@@ -335,6 +336,7 @@ -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -345,6 +347,10 @@ {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} +-- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c+-- as to why we need this.+{-# OPTIONS_GHC -fno-cpr-anal #-}+ module CLaSH.Prelude.BlockRam ( -- * BlockRAM synchronised to the system clock blockRam@@ -360,22 +366,18 @@ ) where -import Control.Exception (catch, evaluate, throw)-import Control.Monad (when)-import Control.Monad.ST.Lazy (ST,runST)-import Control.Monad.ST.Lazy.Unsafe (unsafeIOToST)-import Data.Array.MArray.Safe (newListArray,readArray,writeArray)-import Data.Array.ST.Safe (STArray) import Data.Maybe (fromJust, isJust)+import qualified Data.Vector as V import GHC.TypeLits (KnownNat, type (^)) import Prelude hiding (length) import CLaSH.Signal (Signal, mux)-import CLaSH.Signal.Explicit (Signal', SClock, register', systemClock)-import CLaSH.Signal.Bundle (bundle, unbundle)+import CLaSH.Signal.Explicit (SClock, register', systemClock)+import CLaSH.Signal.Internal (Signal' (..))+import CLaSH.Signal.Bundle (unbundle) import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.Sized.Vector (Vec, length, toList)-import CLaSH.XException (XException, errorX)+import CLaSH.Sized.Vector (Vec, toList)+import CLaSH.XException (errorX) {- $setup >>> import CLaSH.Prelude as C@@ -635,7 +637,7 @@ -- * See "CLaSH.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew' for obtaining write-before-read semantics like this: @readNew (blockRam inits) rd wrM@.-blockRam :: (KnownNat n, Enum addr)+blockRam :: Enum addr => Vec n a -- ^ Initial content of the BRAM, also -- determines the size, @n@, of the BRAM. --@@ -702,7 +704,7 @@ -- * See "CLaSH.Prelude.BlockRam#usingrams" for more information on how to use a -- Block RAM. -- * Use the adapter 'readNew'' for obtaining write-before-read semantics like this: @readNew' clk (blockRam' clk inits) rd wrM@.-blockRam' :: (KnownNat n, Enum addr)+blockRam' :: Enum addr => SClock clk -- ^ 'Clock' to synchronize to -> Vec n a -- ^ Initial content of the BRAM, also -- determines the size, @n@, of the BRAM.@@ -715,11 +717,9 @@ -- ^ Value of the @blockRAM@ at address @r@ from the previous clock -- cycle blockRam' clk content rd wrM =- blockRam# clk content- (fromEnum <$> rd)- (isJust <$> wrM)- ((fromEnum . fst . fromJust) <$> wrM)- ((snd . fromJust) <$> wrM)+ let en = isJust <$> wrM+ (wr,din) = unbundle (fromJust <$> wrM)+ in blockRam# clk content (fromEnum <$> rd) en (fromEnum <$> wr) din {-# INLINE blockRamPow2' #-} -- | Create a blockRAM with space for 2^@n@ elements@@ -760,8 +760,7 @@ blockRamPow2' = blockRam' -- | blockRAM primitive-blockRam# :: KnownNat n- => SClock clk -- ^ 'Clock' to synchronize to+blockRam# :: SClock clk -- ^ 'Clock' to synchronize to -> Vec n a -- ^ Initial content of the BRAM, also -- determines the size, @n@, of the BRAM. --@@ -773,26 +772,16 @@ -> Signal' clk a -- ^ Value of the @blockRAM@ at address @r@ from the previous clock -- cycle-blockRam# clk content rd en wr din =- register' clk (errorX "blockRam#: intial value undefined") dout+blockRam# _clk content =+ go (V.fromList (toList content)) (errorX "blockRam#: intial value undefined") where- szI = length content- dout = runST $ do- arr <- newListArray (0,szI-1) (toList content)- traverse (ramT arr) (bundle (rd,en,wr,din))+ go !ram o (r :- rs) (e :- en) (w :- wr) (d :- din) =+ let ram' = upd ram e w d+ o' = ram V.! r+ in o :- go ram' o' rs en wr din - ramT :: STArray s Int e -> (Int,Bool,Int,e) -> ST s e- ramT ram (r,e,w,d) = do- -- reading from address using an 'X' exception results in an 'X' result- r' <- unsafeIOToST $- catch (evaluate r >>= (return . Right))- (\(err :: XException) -> return (Left (throw err)))- d' <- case r' of- Right r2 -> readArray ram r2- Left err -> return err- -- writing to an address using an 'X' exception makes everything 'X'- when e (writeArray ram w d)- return d'+ upd ram True addr d = ram V.// [(addr,d)]+ upd ram False _ _ = ram {-# NOINLINE blockRam# #-} -- | Create read-after-write blockRAM from a read-before-write one (synchronised to specified clock)
src/CLaSH/Prelude/BlockRam/File.hs view
@@ -63,6 +63,7 @@ -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -74,6 +75,10 @@ {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_HADDOCK show-extensions #-} +-- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c+-- as to why we need this.+{-# OPTIONS_GHC -fno-cpr-anal #-}+ module CLaSH.Prelude.BlockRam.File ( -- * BlockRAM synchronised to the system clock blockRamFile@@ -87,24 +92,21 @@ ) where -import Control.Exception (catch, evaluate, throw)-import Control.Monad (when)-import Control.Monad.ST.Lazy (ST,runST)-import Control.Monad.ST.Lazy.Unsafe (unsafeIOToST)-import Data.Array.MArray (newListArray,readArray,writeArray)-import Data.Array.ST (STArray) import Data.Char (digitToInt) import Data.Maybe (fromJust, isJust, listToMaybe)+import qualified Data.Vector as V import GHC.TypeLits (KnownNat) import Numeric (readInt)+import System.IO.Unsafe (unsafePerformIO) -import CLaSH.Promoted.Nat (SNat (..), pow2SNat, snatToNum)+import CLaSH.Promoted.Nat (SNat (..), pow2SNat) import CLaSH.Sized.BitVector (BitVector) import CLaSH.Signal (Signal)-import CLaSH.Signal.Explicit (Signal', SClock, register', systemClock)-import CLaSH.Signal.Bundle (bundle)+import CLaSH.Signal.Explicit (SClock, systemClock)+import CLaSH.Signal.Internal (Signal' (..))+import CLaSH.Signal.Bundle (unbundle) import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.XException (XException, errorX)+import CLaSH.XException (errorX) {-# INLINE blockRamFile #-} -- | Create a blockRAM with space for @n@ elements@@ -177,7 +179,7 @@ -- content of the blockRAM -> Signal (Unsigned n) -- ^ Read address @r@ -> Signal (Maybe (Unsigned n, BitVector m))- -- ^ (write address @w@, value to write)@)+ -- ^ (write address @w@, value to write) -> Signal (BitVector m) -- ^ Value of the @blockRAM@ at address @r@ from the previous -- clock cycle@@ -261,13 +263,10 @@ -- ^ Value of the @blockRAM@ at address @r@ from the previous -- clock cycle blockRamFile' clk sz file rd wrM =- blockRamFile# clk sz file- (fromEnum <$> rd)- (isJust <$> wrM)- ((fromEnum . fst . fromJust) <$> wrM)- ((snd . fromJust) <$> wrM)+ let en = isJust <$> wrM+ (wr,din) = unbundle (fromJust <$> wrM)+ in blockRamFile# clk sz file (fromEnum <$> rd) en (fromEnum <$> wr) din -{-# NOINLINE blockRamFile# #-} -- | blockRamFile primitive blockRamFile# :: KnownNat m => SClock clk -- ^ 'Clock' to synchronize to@@ -281,25 +280,20 @@ -> Signal' clk (BitVector m) -- ^ Value of the @blockRAM@ at address @r@ from the previous -- clock cycle-blockRamFile# clk sz file rd en wr din = register' clk (errorX "blockRamFile#: intial value undefined") dout+blockRamFile# _clk _sz file =+ go ramI (errorX "blockRamFile#: intial value undefined") where- szI = snatToNum sz- dout = runST $ do- mem <- unsafeIOToST (initMem file)- arr <- newListArray (0,szI-1) mem- traverse (ramT arr) (bundle (rd,en,wr,din))+ go !ram o (r :- rs) (e :- en) (w :- wr) (d :- din) =+ let ram' = upd ram e w d+ o' = ram V.! r+ in o :- go ram' o' rs en wr din - ramT :: STArray s Int e -> (Int,Bool,Int,e) -> ST s e- ramT ram (r,e,w,d) = do- -- reading from address using an 'X' exception results in an 'X' result- r' <- unsafeIOToST (catch (evaluate r >>= (return . Right))- (\(err :: XException) -> return (Left (throw err))))- d' <- case r' of- Right r2 -> readArray ram r2- Left err -> return err- -- writing to an address using an 'X' exception makes everything 'X'- when e (writeArray ram w d)- return d'+ upd ram True addr d = ram V.// [(addr,d)]+ upd ram False _ _ = ram++ content = unsafePerformIO (initMem file)+ ramI = V.fromList content+{-# NOINLINE blockRamFile# #-} {-# NOINLINE initMem #-} -- | __NB:__ Not synthesisable
src/CLaSH/Prelude/RAM.hs view
@@ -6,6 +6,7 @@ RAM primitives with a combinational read port. -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -35,21 +36,17 @@ ) where -import Control.Exception (catch, evaluate, throw)-import Control.Monad (when)-import Control.Monad.ST.Lazy (ST,runST)-import Control.Monad.ST.Lazy.Unsafe (unsafeIOToST)-import Data.Array.MArray.Safe (newListArray,readArray,writeArray)-import Data.Array.ST.Safe (STArray) import Data.Maybe (fromJust, isJust) import GHC.TypeLits (KnownNat)+import qualified Data.Vector as V import CLaSH.Promoted.Nat (SNat (..), snatToNum, pow2SNat) import CLaSH.Signal (Signal)-import CLaSH.Signal.Bundle (bundle)-import CLaSH.Signal.Explicit (Signal', SClock, systemClock, unsafeSynchronizer)+import CLaSH.Signal.Bundle (unbundle)+import CLaSH.Signal.Explicit (SClock, systemClock, unsafeSynchronizer)+import CLaSH.Signal.Internal (Signal' (..)) import CLaSH.Sized.Unsigned (Unsigned)-import CLaSH.XException (XException, errorX)+import CLaSH.XException (errorX) {-# INLINE asyncRam #-} -- | Create a RAM with space for @n@ elements.@@ -127,14 +124,10 @@ -- ^ (write address @w@, value to write) -> Signal' rclk a -- ^ Value of the @RAM@ at address @r@ asyncRam' wclk rclk sz rd wrM =- asyncRam# wclk rclk sz- (fromEnum <$> rd)- (isJust <$> wrM)- ((fromEnum . fst . fromJust) <$> wrM)- ((snd . fromJust) <$> wrM)-+ let en = isJust <$> wrM+ (wr,din) = unbundle (fromJust <$> wrM)+ in asyncRam# wclk rclk sz (fromEnum <$> rd) en (fromEnum <$> wr) din -{-# NOINLINE asyncRam# #-} -- | RAM primitive asyncRam# :: SClock wclk -- ^ 'Clock' to which to synchronise the write -- port of the RAM@@ -148,20 +141,17 @@ -> Signal' rclk a -- ^ Value of the @RAM@ at address @r@ asyncRam# wclk rclk sz rd en wr din = unsafeSynchronizer wclk rclk dout where- szI = snatToNum sz rd' = unsafeSynchronizer rclk wclk rd- dout = runST $ do- arr <- newListArray (0,szI-1) (replicate szI (errorX "asyncRam#: initial value undefined"))- traverse (ramT arr) (bundle (rd',en,wr,din))+ ramI = V.replicate (snatToNum sz) (errorX "asyncRam#: initial value undefined")+ dout = go ramI rd' en wr din - ramT :: STArray s Int e -> (Int,Bool,Int,e) -> ST s e- ramT ram (r,e,w,d) = do- -- reading from address using an 'X' exception results in an 'X' result- r' <- unsafeIOToST (catch (evaluate r >>= (return . Right))- (\(err :: XException) -> return (Left (throw err))))- d' <- case r' of- Right r2 -> readArray ram r2- Left err -> return err- -- writing to an address using an 'X' exception makes everything 'X'- when e (writeArray ram w d)- return d'+ go :: V.Vector a -> Signal' wclk Int -> Signal' wclk Bool+ -> Signal' wclk Int -> Signal' wclk a -> Signal' wclk a+ go !ram (r :- rs) (e :- es) (w :- ws) (d :- ds) =+ let ram' = upd ram e w d+ o = ram V.! r+ in o :- go ram' rs es ws ds++ upd ram True addr d = ram V.// [(addr,d)]+ upd ram False _ _ = ram+{-# NOINLINE asyncRam# #-}
src/CLaSH/Signal/Bundle.hs view
@@ -12,6 +12,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE Trustworthy #-} @@ -26,6 +27,7 @@ import GHC.TypeLits (KnownNat) import Prelude hiding (head, map, tail) +import CLaSH.NamedTypes ((:::)) import CLaSH.Signal.Internal (Clock, Signal' (..)) import CLaSH.Sized.BitVector (BitVector) import CLaSH.Sized.Fixed (Fixed)@@ -106,7 +108,6 @@ instance Bundle Int instance Bundle Float instance Bundle Double-instance Bundle () instance Bundle (Maybe a) instance Bundle (Either a b) @@ -115,6 +116,16 @@ instance Bundle (Fixed rep int frac) instance Bundle (Signed n) instance Bundle (Unsigned n)++-- | Note that:+--+-- > bundle :: () -> Signal' clk ()+-- > unbundle :: Signal' clk () -> ()+instance Bundle () where+ type Unbundled' t () = t ::: ()+ -- ^ This is just to satisfy the injectivity annotation+ bundle u = pure u+ unbundle _ = () instance Bundle (a,b) where type Unbundled' t (a,b) = (Signal' t a, Signal' t b)
src/CLaSH/Signal/Internal.hs view
@@ -100,7 +100,7 @@ import CLaSH.Promoted.Nat (SNat, snatToInteger) import CLaSH.Promoted.Symbol (SSymbol, ssymbolToString)-import CLaSH.XException (XException, errorX)+import CLaSH.XException (XException, errorX, seqX) {- $setup >>> :set -XDataKinds@@ -267,10 +267,10 @@ {-# NOINLINE regEn# #-} regEn# :: SClock clk -> a -> Signal' clk Bool -> Signal' clk a -> Signal' clk a-regEn# clk i b s = r+regEn# _ = go where- r = register# clk i s'- s' = mux b s r+ go o (e :- es) as@(~(x :- xs)) =+ o `seqX` o :- (as `seq` if e then go x es xs else go o es xs) {-# INLINE mux #-} -- | The above type is a generalisation for:
src/CLaSH/Sized/Internal/BitVector.hs view
@@ -575,6 +575,8 @@ instance Resize BitVector where resize = resize# zeroExtend = extend+ signExtend = \ bv -> (case msb# bv of 0 -> id+ 1 -> complement) 0 ++# bv truncateB = resize# {-# NOINLINE resize# #-}
src/CLaSH/Sized/Vector.hs view
@@ -246,7 +246,7 @@ instance (KnownNat n, Eq a) => Eq (Vec n a) where (==) v1 v2 | length v1 == 0 = True- | otherwise = fold (&&) (unsafeCoerce (zipWith (==) v1 v2))+ | otherwise = fold @Bool @n (&&) (unsafeCoerce (zipWith (==) v1 v2)) -- FIXME: the `unsafeCoerce` is a hack because the CLaSH compiler cannot deal -- with the existential length of the 'xs' in "Cons x xs". --
src/CLaSH/Tutorial.hs view
@@ -1391,9 +1391,9 @@ @ We see that we give it @2^addrSize@ elements, where @addrSize@ is the bit-size-of the address. Also, we only write new values to the ram when a new write is-requested, indicated by @winc@, and the buffer is not full, indicated by-@wfull@.+of the address. Also, we only write new values to the RAM when a new write is+requested, indicated by @wdataM@ having a $Just$ value, and the buffer is not+full, indicated by @wfull@. The next part of the design calculates the read and write address for the asynchronous RAM, and creates the flags indicating whether the FIFO is full@@ -1427,7 +1427,7 @@ isEmpty = (==) rptrEmptyInit = (0,0,True) --- FIFO full: when next pntr == synchonized {~wptr[addrSize:addrSize-1],wptr[addrSize-1:0]}+-- FIFO full: when next pntr == synchronized {~wptr[addrSize:addrSize-1],wptr[addrSize-2:0]} isFull addrSize ptr s_ptr = ptr == 'complement' ('slice' addrSize (addrSize ``subSNat`` d1) s_ptr) '++#' 'slice' (addrSize ``subSNat`` d2) d0 s_ptr@@ -1515,14 +1515,14 @@ isEmpty = (==) rptrEmptyInit = (0,0,True) --- FIFO full: when next pntr == synchonized {~wptr[addrSize:addrSize-1],wptr[addrSize-1:0]}+-- FIFO full: when next pntr == synchronized {~wptr[addrSize:addrSize-1],wptr[addrSize-2:0]} isFull addrSize ptr s_ptr = ptr == 'complement' ('slice' addrSize (addrSize ``subSNat`` d1) s_ptr) '++#' 'slice' (addrSize ``subSNat`` d2) d0 s_ptr wptrFullInit = (0,0,False) --- Dual flip-flip synchroniser+-- Dual flip-flop synchroniser ptrSync clk1 clk2 = 'register'' clk2 0 . 'register'' clk2 0 . 'unsafeSynchronizer' clk1 clk2
src/CLaSH/XException.hs view
@@ -1,5 +1,5 @@ {-|-Copyright : (C) 2016, University of Twente+Copyright : (C) 2016, University of Twente, 2017, QBayLogic License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com> @@ -30,7 +30,10 @@ ( -- * 'X': An exception for uninitialized values XException, errorX -- * Printing 'X' exceptions as \"X\"- , ShowX (..), showsX, printX, showsPrecXWith)+ , ShowX (..), showsX, printX, showsPrecXWith+ -- * Strict evaluation+ , seqX+ ) where import Control.Exception (Exception, catch, evaluate, throw)@@ -58,6 +61,20 @@ -- out with an exception. errorX :: HasCallStack => String -> a errorX msg = throw (XException ("X: " ++ msg ++ "\n" ++ prettyCallStack callStack))++-- | Like 'seq', however, whereas 'seq' will always do:+--+-- > seq _|_ b = _|_+--+-- 'seqX' will do:+--+-- > seqX (XException msg) b = b+-- > seqX _|_ b = _|_+seqX :: a -> b -> b+seqX a b = unsafeDupablePerformIO+ (catch (evaluate a >> return b) (\(XException _) -> return b))+{-# NOINLINE seqX #-}+infixr 0 `seqX` showXWith :: (a -> ShowS) -> a -> ShowS showXWith f x =