module CLaSH.Signal.Implicit
(
Signal
, signal
, register
, Pack(..)
, (<^), (^>)
, simulate
, simulateP
, sample
, sampleN
, fromList
)
where
import Control.Applicative (Applicative (..), (<$>), liftA2)
import CLaSH.Bit (Bit)
import CLaSH.Sized.Fixed (Fixed)
import CLaSH.Sized.Signed (Signed)
import CLaSH.Sized.Unsigned (Unsigned)
import CLaSH.Sized.Vector (Vec(..), vmap, vhead, vtail)
import CLaSH.Signal.Types
fromList :: [a] -> Signal a
fromList [] = error "finite list"
fromList (x:xs) = x :- fromList xs
sample :: Signal a -> [a]
sample ~(x :- xs) = x : sample xs
sampleN :: Int -> Signal a -> [a]
sampleN 0 _ = []
sampleN n ~(x :- xs) = x : (sampleN (n1) xs)
register :: a -> Signal a -> Signal a
register i s = i :- s
simulate :: (Signal a -> Signal b) -> [a] -> [b]
simulate f = sample . f . fromList
class Pack a where
type SignalP a
type SignalP a = Signal a
pack :: SignalP a -> Signal a
default pack :: Signal a -> Signal a
pack s = s
unpack :: Signal a -> SignalP a
default unpack :: Signal a -> Signal a
unpack s = s
instance Pack Bit
instance Pack (Signed n)
instance Pack (Unsigned n)
instance Pack (Fixed frac rep size)
instance Pack Bool
instance Pack Integer
instance Pack Int
instance Pack Float
instance Pack Double
instance Pack ()
instance Pack (Maybe a)
instance Pack (Either a b)
instance Pack (a,b) where
type SignalP (a,b) = (Signal a, Signal b)
pack = uncurry (liftA2 (,))
unpack tup = (fmap fst tup, fmap snd tup)
instance Pack (a,b,c) where
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
)
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
)
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
)
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
)
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
)
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
)
instance Pack (Vec n a) where
type SignalP (Vec n a) = Vec n (Signal a)
pack vs = vmap shead vs :- pack (vmap stail vs)
unpack (Nil :- _) = Nil
unpack vs@((_ :> _) :- _) = fmap vhead vs :> (unpack (fmap vtail vs))
simulateP :: (Pack a, Pack b) => (SignalP a -> SignalP b) -> [a] -> [b]
simulateP f = simulate (pack . f . unpack)
(<^) :: Applicative f => f a -> (a -> b -> c) -> f b -> f c
v <^ f = liftA2 f v
(^>) :: Applicative f => (f a -> f b) -> f a -> f b
f ^> v = f v