module CLaSH.Signal.Bundle
( Bundle (..)
)
where
import Control.Applicative (liftA2)
import GHC.TypeLits (KnownNat)
import Prelude hiding (head, map, tail)
import CLaSH.Signal.Internal (Clock, Signal' (..), SClock)
import CLaSH.Sized.BitVector (BitVector)
import CLaSH.Sized.Fixed (Fixed)
import CLaSH.Sized.Index (Index)
import CLaSH.Sized.Signed (Signed)
import CLaSH.Sized.Unsigned (Unsigned)
import CLaSH.Sized.Vector (Vec, traverse#)
class Bundle a where
type Unbundled' (clk :: Clock) a
type Unbundled' clk a = Signal' clk a
bundle' :: SClock clk -> Unbundled' clk a -> Signal' clk a
default bundle' :: SClock clk -> Signal' clk a -> Signal' clk a
bundle' _ s = s
unbundle' :: SClock clk -> Signal' clk a -> Unbundled' clk a
default unbundle' :: SClock clk -> Signal' clk a -> Signal' clk a
unbundle' _ s = s
instance Bundle Bool
instance Bundle Integer
instance Bundle Int
instance Bundle Float
instance Bundle Double
instance Bundle ()
instance Bundle (Maybe a)
instance Bundle (Either a b)
instance Bundle (BitVector n)
instance Bundle (Index n)
instance Bundle (Fixed rep int frac)
instance Bundle (Signed n)
instance Bundle (Unsigned n)
instance Bundle (a,b) where
type Unbundled' t (a,b) = (Signal' t a, Signal' t b)
bundle' _ = uncurry (liftA2 (,))
unbundle' _ tup = (fmap fst tup, fmap snd tup)
instance Bundle (a,b,c) where
type Unbundled' t (a,b,c) = (Signal' t a, Signal' t b, Signal' t c)
bundle' _ (a,b,c) = (,,) <$> a <*> b <*> c
unbundle' _ tup = (fmap (\(x,_,_) -> x) tup
,fmap (\(_,x,_) -> x) tup
,fmap (\(_,_,x) -> x) tup
)
instance Bundle (a,b,c,d) where
type Unbundled' t (a,b,c,d) = ( Signal' t a, Signal' t b, Signal' t c
, Signal' t d
)
bundle' _ (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d
unbundle' _ tup = (fmap (\(x,_,_,_) -> x) tup
,fmap (\(_,x,_,_) -> x) tup
,fmap (\(_,_,x,_) -> x) tup
,fmap (\(_,_,_,x) -> x) tup
)
instance Bundle (a,b,c,d,e) where
type Unbundled' t (a,b,c,d,e) = ( Signal' t a, Signal' t b, Signal' t c
, Signal' t d, Signal' t e
)
bundle' _ (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e
unbundle' _ tup = (fmap (\(x,_,_,_,_) -> x) tup
,fmap (\(_,x,_,_,_) -> x) tup
,fmap (\(_,_,x,_,_) -> x) tup
,fmap (\(_,_,_,x,_) -> x) tup
,fmap (\(_,_,_,_,x) -> x) tup
)
instance Bundle (a,b,c,d,e,f) where
type Unbundled' t (a,b,c,d,e,f) = ( Signal' t a, Signal' t b, Signal' t c
, Signal' t d, Signal' t e, Signal' t f
)
bundle' _ (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f
unbundle' _ 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 Bundle (a,b,c,d,e,f,g) where
type Unbundled' t (a,b,c,d,e,f,g) = ( Signal' t a, Signal' t b, Signal' t c
, Signal' t d, Signal' t e, Signal' t f
, Signal' t g
)
bundle' _ (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f
<*> g
unbundle' _ 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 Bundle (a,b,c,d,e,f,g,h) where
type Unbundled' t (a,b,c,d,e,f,g,h) = ( Signal' t a, Signal' t b, Signal' t c
, Signal' t d, Signal' t e, Signal' t f
, Signal' t g, Signal' t h
)
bundle' _ (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f
<*> g <*> h
unbundle' _ 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 KnownNat n => Bundle (Vec n a) where
type Unbundled' t (Vec n a) = Vec n (Signal' t a)
bundle' = vecBundle#
unbundle' _ = sequenceA
vecBundle# :: SClock t -> Vec n (Signal' t a) -> Signal' t (Vec n a)
vecBundle# _ = traverse# id