packages feed

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