packages feed

clash-prelude 0.2 → 0.3

raw patch · 14 files changed

+438/−110 lines, 14 files

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2013, University of Twente+Copyright (c)2013-2014, University of Twente  All rights reserved.
clash-prelude.cabal view
@@ -1,6 +1,6 @@ Name:                 clash-prelude-Version:              0.2-Synopsis:             CAES Language for Synchronous Hardware+Version:              0.3+Synopsis:             CAES Language for Synchronous Hardware - Prelude library -- Description: Homepage:             http://clash.ewi.utwente.nl/ bug-reports:          http://github.com/christiaanb/clash-prelude/issues@@ -8,7 +8,7 @@ License-file:         LICENSE Author:               Christiaan Baaij Maintainer:           Christiaan Baaij <christiaan.baaij@gmail.com>-Copyright:            Copyright (C) 2013-2014 University of Twente+Copyright:            Copyright © 2013-2014 University of Twente Category:             Hardware Build-type:           Simple @@ -18,7 +18,7 @@  source-repository head   type: git-  location: git://github.com/christiaanb/clash-prelude.git+  location: https://github.com/christiaanb/clash-prelude.git  Library   HS-Source-Dirs:     src@@ -31,6 +31,8 @@                       CLaSH.Prelude                       CLaSH.Promoted.Bool                       CLaSH.Promoted.Nat+                      CLaSH.Promoted.Nat.TH+                      CLaSH.Promoted.Nat.Literals                       CLaSH.Promoted.Ord                       CLaSH.Signal                       CLaSH.Sized.Signed
src/CLaSH/Bit.hs view
@@ -10,7 +10,9 @@ import Data.Default import Language.Haskell.TH.Lift -data Bit = H | L+-- | Two-level logic+data Bit = H -- ^ High+         | L -- ^ Low  instance Eq Bit where   (==) = eqBit
src/CLaSH/Class/BitVector.hs view
@@ -1,13 +1,45 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-} module CLaSH.Class.BitVector where  import CLaSH.Bit import CLaSH.Sized.Vector import GHC.TypeLits +-- | Convert types from and to a vector of @Bit@s class BitVector a where+  -- | Number of 'Bit's needed to represents elements of type @a@   type BitSize a :: Nat+  -- | Convert element of type @a@ to a 'Vec' of 'Bit's   toBV   :: KnownNat (BitSize a) => a -> Vec (BitSize a) Bit+  -- | Convert a 'Vec' of 'Bit's to an element of type @a@   fromBV :: KnownNat (BitSize a) => Vec (BitSize a) Bit -> a++instance BitVector Bit where+  type BitSize Bit = 1+  toBV   = (:> Nil)+  fromBV = vhead++instance BitVector Bool where+  type BitSize Bool = 1+  toBV   = (:> Nil) . toBit+    where+      toBit True  = H+      toBit False = L+  fromBV = fromBit . vhead+    where+      fromBit H = True+      fromBit L = False++instance (KnownNat (BitSize a), KnownNat (BitSize b), BitVector a, BitVector b) => BitVector (a,b) where+  type BitSize (a,b) = (BitSize a) + (BitSize b)+  toBV (a,b) = toBV a <++> toBV b+  fromBV bv  = (fromBV (vtakeI bv), fromBV (vdropI bv))++instance (KnownNat n, KnownNat (BitSize a), BitVector a) => BitVector (Vec n a) where+  type BitSize (Vec n a) = n * (BitSize a)+  toBV   = vconcat . vmap toBV+  fromBV = vmap fromBV . vunconcatI
src/CLaSH/Prelude.hs view
@@ -8,27 +8,44 @@  module CLaSH.Prelude   ( module Exported-  , module CLaSH.Prelude+  , (<^>)+  , registerP+  , Comp (..)+  , registerC+  , simulateC+  , (^^^)+  , blockRam+  , blockRamPow2+  , window+  , windowD   ) where -import Control.Arrow         as Exported-import Control.Applicative   as Exported-import Control.Category      as Category-import Data.Bits             as Exported-import Data.Default          as Exported-import CLaSH.Class.BitVector as Exported-import CLaSH.Promoted.Bool   as Exported-import CLaSH.Promoted.Nat    as Exported-import CLaSH.Promoted.Ord    as Exported-import CLaSH.Sized.Signed    as Exported-import CLaSH.Sized.Unsigned  as Exported-import CLaSH.Sized.Vector    as Exported-import CLaSH.Bit             as Exported-import CLaSH.Signal          as Exported-import GHC.TypeLits          as Exported+import Control.Arrow               as Exported+import Control.Applicative         as Exported+import Control.Category            as Category+import Data.Bits                   as Exported+import Data.Default                as Exported+import CLaSH.Class.BitVector       as Exported+import CLaSH.Promoted.Bool         as Exported+import CLaSH.Promoted.Nat          as Exported+import CLaSH.Promoted.Nat.TH       as Exported+import CLaSH.Promoted.Nat.Literals as Exported+import CLaSH.Promoted.Ord          as Exported+import CLaSH.Sized.Signed          as Exported+import CLaSH.Sized.Unsigned        as Exported+import CLaSH.Sized.Vector          as Exported+import CLaSH.Bit                   as Exported+import CLaSH.Signal                as Exported+import GHC.TypeLits                as Exported  {-# INLINABLE window #-}+-- | Give a window over a 'Signal'+--+-- > window4 :: Signal Int -> Vec 4 (Signal Int)+-- > window4 = window+-- >+-- > simulateP window4 [1,2,3,4,5,... = [<1,0,0,0>,<2,1,0,0>,<3,2,1,0>,<4,3,2,1>,<5,4,3,2>,... window :: (KnownNat (n + 1), Default a)        => Signal a        -> Vec ((n + 1) + 1) (Signal a)@@ -37,36 +54,63 @@     prev = registerP (vcopyI def) next     next = x +>> prev -{-# INLINABLE windowP #-}-windowP :: (KnownNat (n + 1), Default a)+{-# INLINABLE windowD #-}+-- | Give a delayed window over a 'Signal'+--+-- > windowD3 :: Signal Int -> Vec 3 (Signal Int)+-- > windowD3 = windowD+-- >+-- > simulateP windowD3 [1,2,3,4,... = [<0,0,0>,<1,0,0>,<2,1,0>,<3,2,1>,<4,3,2>,...+windowD :: (KnownNat (n + 1), Default a)         => Signal a         -> Vec (n + 1) (Signal a)-windowP x = prev+windowD x = prev   where     prev = registerP (vcopyI def) next     next = x +>> prev  {-# INLINABLE (<^>) #-}+-- | Create a synchronous function from a combinational function describing+-- a mealy machine+--+-- > mac s (x,y) = (s',s)+-- >   where+-- >     s' = x * y + s+-- >+-- > topEntity :: (Signal Int, Signal Int) -> Signal Int+-- > topEntity = mac <^> 0+-- >+-- > simulateP topEntity [(1,1),(2,2),(3,3),(4,4),... = [0,1,5,14,30,... (<^>) :: (Pack i, Pack o)-      => (s -> i -> (s,o))-      -> s-      -> (SignalP i -> SignalP o)+      => (s -> i -> (s,o)) -- ^ Transfer function in mealy machine form+      -> s -- ^ Initial state+      -> (SignalP i -> SignalP o) -- ^ Synchronous function with input and output matching that of the mealy machine f <^> iS = \i -> let (s',o) = unpack $ f <$> s <*> (pack i)                      s      = register iS s'                  in unpack o  {-# INLINABLE registerP #-}+-- | Create a 'register' function for product-type like signals (e.g. '(Signal a, Signal b)')+--+-- > rP :: (Signal Int,Signal Int) -> (Signal Int, Signal Int)+-- > rP = registerP (8,8)+-- >+-- > simulateP rP [(1,1),(2,2),(3,3),... = [(8,8),(1,1),(2,2),(3,3),... registerP :: Pack a => a -> SignalP a -> SignalP a registerP i = unpack Prelude.. register i Prelude.. pack  {-# NOINLINE blockRam #-}+-- | Create a blockRAM with space for @n@ elements+--+-- > bram40 :: Signal (Unsigned 6) -> Signal (Unsigned 6) -> Signal Bool -> Signal a -> Signal a+-- > bram40 = blockRam d50 blockRam :: forall n m a . (KnownNat n, KnownNat m, Pack a)-         => SNat n-         -> Signal (Unsigned m)-         -> Signal (Unsigned m)-         -> Signal Bool-         -> Signal a-         -> Signal a+         => SNat n -- ^ Size @n@ of the blockram+         -> Signal (Unsigned m) -- ^ Write address @w@+         -> Signal (Unsigned m) -- ^ Read address @r@+         -> Signal Bool -- ^ Write enable+         -> Signal a -- ^ Value to write (at address @w@)+         -> Signal a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle blockRam n wr rd en din = pack $ (bram' <^> binit) (wr,rd,en,din)   where     binit :: (Vec n a,a)@@ -81,15 +125,20 @@         o'               = ram ! r  {-# INLINABLE blockRamPow2 #-}-blockRamPow2 :: (KnownNat n, KnownNat (n^2), Pack a)-             => (SNat ((n^2) :: Nat))-             -> Signal (Unsigned n)-             -> Signal (Unsigned n)-             -> Signal Bool-             -> Signal a-             -> Signal a+-- | Create a blockRAM with space for 2^@n@ elements+--+-- > bram32 :: Signal (Unsigned 5) -> Signal (Unsigned 5) -> Signal Bool -> Signal a -> Signal a+-- > bram32 = blockRamPow2 d32+blockRamPow2 :: (KnownNat n, KnownNat (2^n), Pack a)+             => (SNat ((2^n) :: Nat))  -- ^ Size 2^@n@ of the blockram+             -> Signal (Unsigned n) -- ^ Write address @w@+             -> Signal (Unsigned n) -- ^ Read address @r@+             -> Signal Bool -- ^ Write enable+             -> Signal a -- ^ Value to write (at address @w@)+             -> Signal a -- ^ Value of the 'blockRAM' at address @r@ from the previous clock cycle blockRamPow2 = blockRam +-- | 'Arrow' interface to synchronous functions newtype Comp a b = C { asFunction :: Signal a -> Signal b }  instance Category Comp where@@ -110,13 +159,33 @@       simpleLoop g b = let ~(c,d) = g (b,d)                        in c +-- | Create a 'register' 'Comp'onent+--+-- > rC :: Comp (Int,Int) (Int,Int)+-- > rC = registerC (8,8)+-- >+-- > simulateC rP [(1,1),(2,2),(3,3),... = [(8,8),(1,1),(2,2),(3,3),... registerC :: a -> Comp a a registerC = C Prelude.. register +-- | Simulate a 'Comp'onent given a list of samples+--+-- > simulateC (registerC 8) [1, 2, 3, ... = [8, 1, 2, 3, ... simulateC :: Comp a b -> [a] -> [b] simulateC f = simulate (asFunction f)  {-# INLINABLE (^^^) #-}+-- | Create a synchronous 'Comp'onent from a combinational function describing+-- a mealy machine+--+-- > mac s (x,y) = (s',s)+-- >   where+-- >     s' = x * y + s+-- >+-- > topEntity :: Comp (Int,Int) Int+-- > topEntity = mac ^^^ 0+-- >+-- > simulateC topEntity [(1,1),(2,2),(3,3),(4,4),... = [0,1,5,14,30,... (^^^) :: (s -> i -> (s,o)) -> s -> Comp i o f ^^^ sI = C $ \i -> let (s',o) = unpack $ f <$> s <*> i                          s      = register sI s'
src/CLaSH/Promoted/Bool.hs view
@@ -4,7 +4,8 @@ {-# LANGUAGE PolyKinds      #-} module CLaSH.Promoted.Bool where +-- | Type-level if-then-else type family If (x :: Bool) (y :: k) (z :: k) :: k--type instance If True  y z = y-type instance If False y z = z+  where+    If True  y z = y+    If False y z = z
src/CLaSH/Promoted/Nat.hs view
@@ -13,22 +13,28 @@ import GHC.TypeLits import Unsafe.Coerce +-- | Singleton value for a type-level natural number 'n' data SNat (n :: Nat) = KnownNat n => SNat (Proxy n) +-- | Singleton value for a type-level natural number snat :: KnownNat n => SNat n snat = SNat Proxy +-- | Supply a function with a singleton natural 'n' according to the context withSNat :: KnownNat n => (SNat n -> a) -> a withSNat f = f (SNat Proxy) +-- | Unary representation of a type-level natural data UNat :: Nat -> * where   UZero :: UNat 0   USucc :: UNat n -> UNat (n + 1) +-- | Convert a singleton natural number to an integer fromSNat :: SNat n -> Integer fromSNat (SNat p) = natVal p  {-# NOINLINE fromSNat #-}+-- | Convert a singleton natural number to it's unary representation toUNat :: SNat n -> UNat n toUNat (SNat p) = fromI (natVal p)   where@@ -36,16 +42,19 @@     fromI 0 = unsafeCoerce UZero     fromI n = unsafeCoerce (USucc (fromI (n - 1))) +-- | Add two singleton natural numbers addUNat :: UNat n -> UNat m -> UNat (n + m) addUNat UZero     y     = y addUNat x         UZero = x addUNat (USucc x) y     = unsafeCoerce (USucc (addUNat x y)) +-- | Multiply two singleton natural numbers multUNat :: UNat n -> UNat m -> UNat (n * m) multUNat UZero      _     = UZero multUNat _          UZero = UZero multUNat (USucc x) y      = unsafeCoerce (addUNat y (multUNat x y)) +-- | Exponential of two singleton natural numbers powUNat :: UNat n -> UNat m -> UNat (n ^ m) powUNat _ UZero     = USucc UZero powUNat x (USucc y) = unsafeCoerce (multUNat x (powUNat x y))
+ src/CLaSH/Promoted/Nat/Literals.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell, DataKinds #-}+-- | Predefined 'SNat' singleton literals+module CLaSH.Promoted.Nat.Literals where++import CLaSH.Promoted.Nat.TH++$(decLiteralsD "d" 0 1024)
+ src/CLaSH/Promoted/Nat/TH.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+module CLaSH.Promoted.Nat.TH where++import Language.Haskell.TH++import CLaSH.Promoted.Nat++-- | Create an 'SNat' constant+--+-- > $(decLiteralD "d" 1200) == d1200 = snat :: SNat 1200+decLiteralD :: String+            -> Integer+            -> Q [Dec]+decLiteralD valPrefix n =+    do let suffix  = if n < 0 then error ("Can't make negative SNat: " ++ show n) else show n+           valName = mkName $ valPrefix ++ suffix+       sig   <- sigD valName (appT (conT ''SNat) (litT (numTyLit n)))+       val   <- valD (varP valName) (normalB [| snat |]) []+       return [ sig, val ]++-- | Create an 'SNat' constants+--+-- > $(decLiteralsD "d" 1200 1202) == d1200 = snat :: SNat 1200+-- >                                  d1201 = snat :: SNat 1201+-- >                                  d1202 = snat :: SNat 1202+decLiteralsD :: String+             -> Integer+             -> Integer+             -> Q [Dec]+decLiteralsD valPrefix from to =+    fmap concat $ sequence $ [ decLiteralD valPrefix n | n <- [from..to] ]
src/CLaSH/Promoted/Ord.hs view
@@ -8,8 +8,12 @@  import CLaSH.Promoted.Bool +-- | Type-level 'min' function for natural numbers type family Min (x :: Nat) (y :: Nat) :: Nat-type instance Min x y = If (x <=? y) x y+  where+    Min x y = If (x <=? y) x y +-- | Type-level 'max' function for natural numbers type family Max (x :: Nat) (y :: Nat) :: Nat-type instance Max x y = If (x <=? y) y x+  where+    Max x y = If (x <=? y) y x
src/CLaSH/Signal.hs view
@@ -4,9 +4,10 @@  module CLaSH.Signal   ( Signal+  , sample+  , sampleN   , fromList   , signal-  , sample   , register   , simulate   , Pack(..)@@ -30,8 +31,15 @@ {-# NOINLINE appSignal #-}  infixr 5 :-+-- | A synchronized signal with elements of type @a@ data Signal a = a :- Signal a +-- | Create a 'Signal' from a list+--+-- Every element in the list will correspond to a value of the signal for one+-- clock cycle.+--+-- > sampleN 2 (fromList [1,2,3,4,5]) = [1,2] fromList :: [a] -> Signal a fromList []     = error "finite list" fromList (x:xs) = x :- fromList xs@@ -45,10 +53,28 @@ instance Default a => Default (Signal a) where   def = signal def -sample :: Int -> Signal a -> [a]-sample 0 _         = []-sample n ~(x :- xs) = x : (sample (n-1) xs)+-- | Get an infinite list of samples from a 'Signal'+--+-- The elements in the list correspond to the values of the 'Signal' at+-- consecutive clock cycles+--+-- > sample s = [s0, s1, s2, s3, ...+sample :: Signal a -> [a]+sample ~(x :- xs) = x : sample xs +-- | Get a list of @n@ samples from a 'Signal'+--+-- The elements in the list correspond to the values of the 'Signal' at+-- consecutive clock cycles+--+-- > sampleN 3 s = [s0, s1, s2]+sampleN :: Int -> Signal a -> [a]+sampleN 0 _          = []+sampleN n ~(x :- xs) = x : (sampleN (n-1) xs)++-- | Create a constant 'Signal' from a combinational value+--+-- > sample (signal 4) = [4, 4, 4, 4, ... signal :: a -> Signal a signal a = a :- signal a @@ -78,17 +104,37 @@   return    = signal   xs >>= f  = diag (fmap f xs) +-- | 'register' @i s@ delays the values in 'Signal' @s@ for one cycle, and sets+-- the value at time 0 to @i@+--+-- > sampleN 3 (register 8 (fromList [1,2,3,4])) = [8,1,2] register :: a -> Signal a -> Signal a register i s = i :- s +-- | Simulate a ('Signal' -> 'Signal') function given a list of samples+--+-- > simulate (register 8) [1, 2, 3, ... = [8, 1, 2, 3, ... simulate :: (Signal a -> Signal b) -> [a] -> [b]-simulate f as = sample (length as) (f (fromList as))+simulate f = sample . f . fromList +-- | Conversion between a 'Signal' of a product type (e.g. a tuple) and a+-- product type of 'Signal's class Pack a where   type SignalP a+  -- | > pack :: (Signal a, Signal b) -> Signal (a,b)+  -- However:+  --+  -- > pack :: Signal Bit -> Signal Bit   pack   :: SignalP a -> Signal a+  -- | > unpack :: Signal (a,b) -> (Signal a, Signal b)+  -- However:+  --+  -- > unpack :: Signal Bit -> Signal Bit   unpack :: Signal a -> SignalP a +-- | Simulate a ('SignalP' -> 'SignalP') function given a list of samples+--+-- > simulateP (unpack . register (8,8) . pack) [(1,1), (2,2), (3,3), ... = [(8,8), (1,1), (2,2), (3,3), ... simulateP :: (Pack a, Pack b) => (SignalP a -> SignalP b) -> [a] -> [b] simulateP f = simulate (pack . f . unpack) @@ -146,64 +192,64 @@   type SignalP (a,b,c) = (Signal a, Signal b, Signal c)   pack (a,b,c) = (,,) <$> a <*> b <*> c   unpack tup   = (fmap (\(x,_,_) -> x) tup-                ,fmap (\(_,x,_) -> x) tup-                ,fmap (\(_,_,x) -> x) tup-                )+                 ,fmap (\(_,x,_) -> x) tup+                 ,fmap (\(_,_,x) -> x) tup+                 )  instance Pack (a,b,c,d) where   type SignalP (a,b,c,d) = (Signal a, Signal b, Signal c, Signal d)   pack (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d   unpack tup     = (fmap (\(x,_,_,_) -> x) tup-                  ,fmap (\(_,x,_,_) -> x) tup-                  ,fmap (\(_,_,x,_) -> x) tup-                  ,fmap (\(_,_,_,x) -> x) tup-                  )+                   ,fmap (\(_,x,_,_) -> x) tup+                   ,fmap (\(_,_,x,_) -> x) tup+                   ,fmap (\(_,_,_,x) -> x) tup+                   )  instance Pack (a,b,c,d,e) where   type SignalP (a,b,c,d,e) = (Signal a, Signal b, Signal c, Signal d, Signal e)   pack (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e   unpack tup       = (fmap (\(x,_,_,_,_) -> x) tup-                    ,fmap (\(_,x,_,_,_) -> x) tup-                    ,fmap (\(_,_,x,_,_) -> x) tup-                    ,fmap (\(_,_,_,x,_) -> x) tup-                    ,fmap (\(_,_,_,_,x) -> x) tup-                    )+                     ,fmap (\(_,x,_,_,_) -> x) tup+                     ,fmap (\(_,_,x,_,_) -> x) tup+                     ,fmap (\(_,_,_,x,_) -> x) tup+                     ,fmap (\(_,_,_,_,x) -> x) tup+                     )  instance Pack (a,b,c,d,e,f) where   type SignalP (a,b,c,d,e,f) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f)   pack (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f   unpack tup         = (fmap (\(x,_,_,_,_,_) -> x) tup-                      ,fmap (\(_,x,_,_,_,_) -> x) tup-                      ,fmap (\(_,_,x,_,_,_) -> x) tup-                      ,fmap (\(_,_,_,x,_,_) -> x) tup-                      ,fmap (\(_,_,_,_,x,_) -> x) tup-                      ,fmap (\(_,_,_,_,_,x) -> x) tup-                      )+                       ,fmap (\(_,x,_,_,_,_) -> x) tup+                       ,fmap (\(_,_,x,_,_,_) -> x) tup+                       ,fmap (\(_,_,_,x,_,_) -> x) tup+                       ,fmap (\(_,_,_,_,x,_) -> x) tup+                       ,fmap (\(_,_,_,_,_,x) -> x) tup+                       )  instance Pack (a,b,c,d,e,f,g) where   type SignalP (a,b,c,d,e,f,g) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f, Signal g)   pack (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g   unpack tup           = (fmap (\(x,_,_,_,_,_,_) -> x) tup-                        ,fmap (\(_,x,_,_,_,_,_) -> x) tup-                        ,fmap (\(_,_,x,_,_,_,_) -> x) tup-                        ,fmap (\(_,_,_,x,_,_,_) -> x) tup-                        ,fmap (\(_,_,_,_,x,_,_) -> x) tup-                        ,fmap (\(_,_,_,_,_,x,_) -> x) tup-                        ,fmap (\(_,_,_,_,_,_,x) -> x) tup-                        )+                         ,fmap (\(_,x,_,_,_,_,_) -> x) tup+                         ,fmap (\(_,_,x,_,_,_,_) -> x) tup+                         ,fmap (\(_,_,_,x,_,_,_) -> x) tup+                         ,fmap (\(_,_,_,_,x,_,_) -> x) tup+                         ,fmap (\(_,_,_,_,_,x,_) -> x) tup+                         ,fmap (\(_,_,_,_,_,_,x) -> x) tup+                         )  instance Pack (a,b,c,d,e,f,g,h) where   type SignalP (a,b,c,d,e,f,g,h) = (Signal a, Signal b, Signal c, Signal d, Signal e, Signal f, Signal g, Signal h)   pack (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h   unpack tup             = (fmap (\(x,_,_,_,_,_,_,_) -> x) tup-                          ,fmap (\(_,x,_,_,_,_,_,_) -> x) tup-                          ,fmap (\(_,_,x,_,_,_,_,_) -> x) tup-                          ,fmap (\(_,_,_,x,_,_,_,_) -> x) tup-                          ,fmap (\(_,_,_,_,x,_,_,_) -> x) tup-                          ,fmap (\(_,_,_,_,_,x,_,_) -> x) tup-                          ,fmap (\(_,_,_,_,_,_,x,_) -> x) tup-                          ,fmap (\(_,_,_,_,_,_,_,x) -> x) tup-                          )+                           ,fmap (\(_,x,_,_,_,_,_,_) -> x) tup+                           ,fmap (\(_,_,x,_,_,_,_,_) -> x) tup+                           ,fmap (\(_,_,_,x,_,_,_,_) -> x) tup+                           ,fmap (\(_,_,_,_,x,_,_,_) -> x) tup+                           ,fmap (\(_,_,_,_,_,x,_,_) -> x) tup+                           ,fmap (\(_,_,_,_,_,_,x,_) -> x) tup+                           ,fmap (\(_,_,_,_,_,_,_,x) -> x) tup+                           )  instance Pack (Vec n a) where   type SignalP (Vec n a) = Vec n (Signal a)@@ -211,9 +257,22 @@   unpack (Nil :- _)         = Nil   unpack vs@((_ :> _) :- _) = fmap vhead vs :> (unpack (fmap vtail vs)) ++-- | Operator lifting, use in conjunction with '(^>)'+--+-- > add2 :: Signal Int -> Signal Int+-- > add2 x = x <^(+)^> (signal 2)+-- >+-- > simulate add2 [1,2,3, = [3,4,5,... (<^) :: Applicative f => f a -> (a -> b -> c) -> f b -> f c v <^ f = liftA2 f v +-- | Operator lifting, use in conjunction with '(<^)'+--+-- > add2 :: Signal Int -> Signal Int+-- > add2 x = x <^(+)^> (signal 2)+-- >+-- > simulate add2 [1,2,3, = [3,4,5,... (^>) :: Applicative f => (f a -> f b) -> f a -> f b f ^> v = f v
src/CLaSH/Sized/Signed.hs view
@@ -266,4 +266,4 @@ -- Truncating a number of length N to a length L just removes the leftmost N-L bits. -- resizeS_wrap :: KnownNat m => Signed n -> Signed m-resizeS_wrap s@(S n) = fromIntegerS_inlineable n+resizeS_wrap (S n) = fromIntegerS_inlineable n
src/CLaSH/Sized/Unsigned.hs view
@@ -223,5 +223,11 @@                     ]  {-# NOINLINE resizeU #-}+-- | A resize operation that is zero-extends on extension, and wraps on truncation.+--+-- Increasing the size of the number extends with zeros to the left.+-- Truncating a number of length N to a length L just removes the left+-- (most significant) N-L bits.+-- resizeU :: KnownNat m => Unsigned n -> Unsigned m resizeU (U n) = fromIntegerU_inlineable n
src/CLaSH/Sized/Vector.hs view
@@ -18,7 +18,7 @@   , vreverse, vmap, vzipWith   , vfoldr, vfoldl, vfoldr1, vfoldl1   , vzip, vunzip-  , (!), vreplace+  , (!), vreplace, maxIndex   , vtake, vtakeI, vdrop, vdropI, vexact, vselect, vselectI   , vcopy, vcopyI, viterate, viterateI, vgenerate, vgenerateI   , toList, v@@ -67,64 +67,81 @@   fmap = fmapDefault  {-# NOINLINE vhead #-}+-- | Extract the first element of a vector vhead :: Vec (n + 1) a -> a vhead (x :> _) = x  {-# NOINLINE vtail #-}+-- | Extract the elements after the head of a vector vtail :: Vec (n + 1) a -> Vec n a vtail (_ :> xs) = unsafeCoerce xs  {-# NOINLINE vlast #-}+-- | Extract the last element of a vector vlast :: Vec (n + 1) a -> a vlast (x :> Nil)     = x vlast (_ :> y :> ys) = vlast (y :> ys)  {-# NOINLINE vinit #-}+-- | Extract all the elements of a vector except the last element vinit :: Vec (n + 1) a -> Vec n a vinit (_ :> Nil)     = unsafeCoerce Nil vinit (x :> y :> ys) = unsafeCoerce (x :> vinit (y :> ys))  {-# NOINLINE shiftIntoL #-}+-- | Add an element to the head of the vector, and extract all elements of the+-- resulting vector except the last element shiftIntoL :: a -> Vec n a -> Vec n a shiftIntoL _ Nil       = Nil shiftIntoL s (x :> xs) = s :> (vinit (x:>xs))  infixr 4 +>> {-# INLINEABLE (+>>) #-}+-- | Add an element to the head of the vector, and extract all elements of the+-- resulting vector except the last element (+>>) :: a -> Vec n a -> Vec n a s +>> xs = shiftIntoL s xs  {-# NOINLINE snoc #-}+-- | Add an element to the tail of the vector snoc :: a -> Vec n a -> Vec (n + 1) a snoc s Nil       = s :> Nil snoc s (x :> xs) = x :> (snoc s xs)  infixl 5 <: {-# INLINEABLE (<:) #-}+-- | Add an element to the tail of the vector (<:) :: Vec n a -> a -> Vec (n + 1) a xs <: s = snoc s xs  {-# NOINLINE shiftIntoR #-}+-- | Add an element to the tail of the vector, and extract all elements of the+-- resulting vector except the first element shiftIntoR :: a -> Vec n a -> Vec n a shiftIntoR _ Nil     = Nil shiftIntoR s (x:>xs) = snoc s (vtail (x:>xs))  infixl 4 <<+ {-# INLINE (<<+) #-}+-- | Add an element to the tail of the vector, and extract all elements of the+-- resulting vector except the first element (<<+) :: Vec n a -> a -> Vec n a xs <<+ s = shiftIntoR s xs  {-# NOINLINE vappend #-}+-- | Append two vectors vappend :: Vec n a -> Vec m a -> Vec (n + m) a vappend Nil       ys = ys vappend (x :> xs) ys = unsafeCoerce (x :> (vappend xs ys))  infixr 5 <++> {-# INLINE (<++>) #-}+-- | Append two vectors (<++>) :: Vec n a -> Vec m a -> Vec (n + m) a xs <++> ys = vappend xs ys  {-# NOINLINE vsplit #-}+-- | Split a vector into two vectors at the given point vsplit :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a) vsplit n xs = vsplitU (toUNat n) xs @@ -134,72 +151,109 @@                               in  (y :> as, bs)  {-# INLINEABLE vsplitI #-}+-- | Split a vector into two vectors where the length of the two is determined+-- by the context vsplitI :: KnownNat m => Vec (m + n) a -> (Vec m a, Vec n a) vsplitI = withSNat vsplit  {-# NOINLINE vconcat #-}+-- | Concatenate a vector of vectors vconcat :: Vec n (Vec m a) -> Vec (n * m) a vconcat Nil       = Nil vconcat (x :> xs) = unsafeCoerce (vappend x (vconcat xs))  {-# NOINLINE vunconcat #-}-vunconcat :: SNat n -> SNat m -> Vec (n * m) a -> Vec n (Vec m a)-vunconcat n m xs = vunconcatU (toUNat n) (toUNat m) xs+-- | Split a vector of (n * m) elements into a vector of vectors with length m,+-- where m is given+vunconcat :: KnownNat n => SNat m -> Vec (n * m) a -> Vec n (Vec m a)+vunconcat n xs = vunconcatU (withSNat toUNat) (toUNat n) xs  vunconcatU :: UNat n -> UNat m -> Vec (n * m) a -> Vec n (Vec m a)-vunconcatU UZero      _  _  = Nil-vunconcatU (USucc n') m' ys = let (as,bs) = vsplitU m' (unsafeCoerce ys)-                              in  as :> vunconcatU n' m' bs+vunconcatU UZero      _ _  = Nil+vunconcatU (USucc n') m ys = let (as,bs) = vsplitU m (unsafeCoerce ys)+                             in  as :> vunconcatU n' m bs  {-# INLINEABLE vunconcatI #-}+-- | Split a vector of (n * m) elements into a vector of vectors with length m,+-- where m is determined by the context vunconcatI :: (KnownNat n, KnownNat m) => Vec (n * m) a -> Vec n (Vec m a)-vunconcatI = (withSNat . withSNat) vunconcat+vunconcatI = withSNat vunconcat  {-# NOINLINE vmerge #-}+-- | Merge two vectors, alternating their elements, i.e.,+--+-- > vmerge <xn, ..., x2, x1>  <yn, ..., y2, y1> == <xn, yn, ..., x2, y2, x1, y1>+-- vmerge :: Vec n a -> Vec n a -> Vec (n + n) a vmerge Nil       Nil       = Nil vmerge (x :> xs) (y :> ys) = unsafeCoerce (x :> y :> (vmerge xs (unsafeCoerce ys)))  {-# NOINLINE vreverse #-}+-- | Returns the elements in a list in reverse order vreverse :: Vec n a -> Vec n a vreverse Nil        = Nil vreverse (x :> xs)  = vreverse xs <: x  {-# NOINLINE vmap #-}+-- | 'vmap' @f xs@ is the list obtained by applying @f@ to each element+-- of @xs@, i.e.,+--+-- > vmap f <xn, ..., x2, x1> == <f xn, ..., f x2, f x1> vmap :: (a -> b) -> Vec n a -> Vec n b vmap _ Nil       = Nil vmap f (x :> xs) = f x :> vmap f xs  {-# NOINLINE vzipWith #-}+-- | 'vzipWith' generalises 'vzip' by zipping with the function given+-- as the first argument, instead of a tupling function.+-- For example, @'vzipWith' (+)@ is applied to two vectors to produce the+-- vector of corresponding sums. vzipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c vzipWith _ Nil       Nil       = Nil vzipWith f (x :> xs) (y :> ys) = f x y :> (vzipWith f xs (unsafeCoerce ys))  {-# NOINLINE vfoldr #-}+-- | 'vfoldr', applied to a binary operator, a starting value (typically+-- the right-identity of the operator), and a vector, reduces the vector+-- using the binary operator, from right to left:+--+-- > foldr f z <xn, ..., x2, x1> == xn `f` (... (x2 `f` (x1 `f` z))...) vfoldr :: (a -> b -> b) -> b -> Vec n a -> b vfoldr _ z Nil       = z vfoldr f z (x :> xs) = f x (vfoldr f z xs)  {-# NOINLINE vfoldl #-}+-- | 'vfoldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a vector, reduces the vector+-- using the binary operator, from left to right:+--+-- > vfoldl f z <xn, ..., x2, x1> == (...((z `f` xn)... `f` x2) `f` x1 vfoldl :: (b -> a -> b) -> b -> Vec n a -> b vfoldl _ z Nil       = z vfoldl f z (x :> xs) = vfoldl f (f z x) xs  {-# NOINLINE vfoldr1 #-}+-- | 'vfoldr1' is a variant of 'vfoldr' that has no starting value argument,+-- and thus must be applied to non-empty vectors. vfoldr1 :: (a -> a -> a) -> Vec (n + 1) a -> a vfoldr1 _ (x :> Nil)       = x vfoldr1 f (x :> (y :> ys)) = f x (vfoldr1 f (y :> ys))  {-# INLINEABLE vfoldl1 #-}+-- | 'vfoldl1' is a variant of 'vfoldl' that has no starting value argument,+-- and thus must be applied to non-empty vectors. vfoldl1 :: (a -> a -> a) -> Vec (n + 1) a -> a vfoldl1 f xs = vfoldl f (vhead xs) (vtail xs)  {-# NOINLINE vzip #-}+-- | 'vzip' takes two lists and returns a list of corresponding pairs. vzip :: Vec n a -> Vec n b -> Vec n (a,b) vzip Nil       Nil       = Nil vzip (x :> xs) (y :> ys) = (x,y) :> (vzip xs (unsafeCoerce ys))  {-# NOINLINE vunzip #-}+-- | 'vunzip' transforms a list of pairs into a list of first components+-- and a list of second components. vunzip :: Vec n (a,b) -> (Vec n a, Vec n b) vunzip Nil = (Nil,Nil) vunzip ((a,b) :> xs) = let (as,bs) = vunzip xs@@ -218,10 +272,17 @@     Nothing -> error "index out of bounds"  {-# INLINEABLE (!) #-}+-- | Vector index (subscript) operator, descending from 'maxIndex', where the+-- last element has subscript 0.+--+-- > <1,2,3,4,5> ! 4 == 1+-- > <1,2,3,4,5> ! maxIndex == 1+-- > <1,2,3,4,5> ! 1 == 4 (!) :: (KnownNat n, Integral i) => Vec n a -> i -> a xs ! i = vindex_integer xs (toInteger i)  {-# NOINLINE maxIndex #-}+-- | Index (subscript) of the head of the vector maxIndex :: forall n a . KnownNat n => Vec n a -> Integer maxIndex _ = fromSNat (snat :: SNat n) - 1 @@ -240,37 +301,62 @@   Nothing -> error "index out of bounds"  {-# INLINEABLE vreplace #-}+-- | Replace an element of a vector at the given index (subscript), NB: vector+-- elements have a descending subscript starting from 'maxIndex' and ending at 0+--+-- > vreplace <1,2,3,4,5> 3 7 == <1,7,3,4,5> vreplace :: (KnownNat n, Integral i) => Vec n a -> i -> a -> Vec n a vreplace xs i y = vreplace_integer xs (toInteger i) y  {-# NOINLINE vtake #-}+-- | 'vtake' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@+--+-- > vtake (snat :: SNat 3) <1,2,3,4,5> == <1,2,3>+-- > vtake d3 <1,2,3,4,5> == <1,2,3>+-- > vtake (snat :: SNat 0) <1,2> == <>+-- > vtake (snat :: SNat 4) <1,2> == TYPE ERROR vtake :: SNat m -> Vec (m + n) a -> Vec m a vtake n = fst . vsplit n  {-# INLINEABLE vtakeI #-}+-- | 'vtakeI' @xs@, returns the prefix of @xs@ as demanded by the context vtakeI :: KnownNat m => Vec (m + n) a -> Vec m a vtakeI = withSNat vtake  {-# NOINLINE vdrop #-}+-- | 'vdrop' @n xs@ returns the suffix of @xs@ after the first @n@ elements+--+-- > vdrop (snat :: SNat 3) <1,2,3,4,5> == <4,5>+-- > vdrop d3 <1,2,3,4,5> == <4,5>+-- > vdrop (snat :: SNat 0) <1,2> == <1,2>+-- > vdrop (snat :: SNat 4) <1,2> == TYPE ERROR vdrop :: SNat m -> Vec (m + n) a -> Vec n a vdrop n = snd . vsplit n  {-# INLINEABLE vdropI #-}+-- | 'vdropI' @xs@, returns the suffix of @xs@ as demanded by the context vdropI :: KnownNat m => Vec (m + n) a -> Vec n a vdropI = withSNat vdrop  {-# NOINLINE vexact #-}+-- | 'vexact' @n xs@ returns @n@'th element of @xs@, NB: vector elements+-- have a descending subscript starting from 'maxIndex' and ending at 0+--+-- > vexact (snat :: SNat 1) <1,2,3,4,5> == 4 vexact :: SNat m -> Vec (m + (n + 1)) a -> a-vexact n xs = vhead $ snd $ vsplit n xs+vexact n xs = vhead $ snd $ vsplit n (vreverse xs)  {-# NOINLINE vselect #-}-vselect ::-  ((f + (s * n) + 1) <= i)-  => SNat f-  -> SNat s-  -> SNat (n + 1)-  -> Vec i a-  -> Vec (n + 1) a+-- | 'vselect' @f s n xs@ selects @n@ elements with stepsize @s@ and+-- offset @f@ from @xs@+--+-- vselect (snat :: SNat 1) (snat :: SNat 2) (snat :: SNat 3) <1,2,3,4,5,6,7,8> == <2,4,6>+vselect :: ((f + (s * n) + 1) <= i)+        => SNat f+        -> SNat s+        -> SNat (n + 1)+        -> Vec i a+        -> Vec (n + 1) a vselect f s n xs = vselect' (toUNat n) $ vdrop f (unsafeCoerce xs)   where     vselect' :: UNat n -> Vec m a -> Vec n a@@ -278,15 +364,17 @@     vselect' (USucc n') vs@(x :> _) = x :> vselect' n' (vdrop s (unsafeCoerce vs))  {-# NOINLINE vselectI #-}-vselectI ::-  ((f + (s * n) + 1) <= i, KnownNat (n + 1))-  => SNat f-  -> SNat s-  -> Vec i a-  -> Vec (n + 1) a+-- | 'vselectI' @f s xs@ selects as many elements as demanded by the context+-- with stepsize @s@ and offset @f@ from @xs@+vselectI :: ((f + (s * n) + 1) <= i, KnownNat (n + 1))+         => SNat f+         -> SNat s+         -> Vec i a+         -> Vec (n + 1) a vselectI f s xs = withSNat (\n -> vselect f s n xs)  {-# NOINLINE vcopy #-}+-- | 'vcopy' @n a@ returns a vector that has @n@ copies of @a@ vcopy :: SNat n -> a -> Vec n a vcopy n a = vreplicateU (toUNat n) a @@ -295,10 +383,16 @@ vreplicateU (USucc s) x = x :> vreplicateU s x  {-# INLINEABLE vcopyI #-}+-- | 'vcopy' @a@ creates a vector with as many copies of @a@ as demanded by the+-- context vcopyI :: KnownNat n => a -> Vec n a vcopyI = withSNat vcopy  {-# NOINLINE viterate #-}+-- | 'viterate' @n f x@ returns a vector starting with @x@ followed by @n@+-- repeated applications of @f@ to @x@+--+-- > viterate (snat :: SNat 4) f x = <x, f x, f (f x), f (f (f x))> viterate :: SNat n -> (a -> a) -> a -> Vec n a viterate n f a = viterateU (toUNat n) f a @@ -307,21 +401,33 @@ viterateU (USucc s) g x = x :> viterateU s g (g x)  {-# INLINEABLE viterateI #-}+-- | 'viterate' @f x@ returns a vector starting with @x@ followed by @n@+-- repeated applications of @f@ to @x@, where @n@ is determined by the context viterateI :: KnownNat n => (a -> a) -> a -> Vec n a viterateI = withSNat viterate  {-# INLINEABLE vgenerate #-}+-- | 'vgenerate' @n f x@ returns a vector with @n@ repeated applications of @f@+-- to @x@+--+-- > vgenerate (snat :: SNat 4) f x = <f x, f (f x), f (f (f x)), f (f (f (f x)))> vgenerate :: SNat n -> (a -> a) -> a -> Vec n a vgenerate n f a = viterate n f (f a)  {-# INLINEABLE vgenerateI #-}+-- | 'vgenerate' @f x@ returns a vector with @n@ repeated applications of @f@+-- to @x@, where @n@ is determined by the context vgenerateI :: KnownNat n => (a -> a) -> a -> Vec n a vgenerateI = withSNat vgenerate -{-# NOINLINE toList #-}+{-# INLINEABLE toList #-}+-- | Convert a vector to a list toList :: Vec n a -> [a] toList = vfoldr (:) [] +-- | Create a vector literal from a list literal+--+-- > $(v [1::Signed 8,2,3,4,5]) == <1,2,3,4,5> :: Vec 5 (Signed 8) v :: Lift a => [a] -> ExpQ v []     = [| Nil |] v (x:xs) = [| x :> $(v xs) |]