module CLaSH.Signal.Bundle
( Bundle (..)
)
where
import Control.Applicative ((<$>), (<*>), liftA2)
import Data.Traversable (sequenceA)
import GHC.TypeLits (KnownNat)
import Prelude hiding (head, map, tail)
import CLaSH.Signal.Internal (Clock, CSignal (..), 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)
class Bundle a where
type Unbundled (clk :: Clock) a
type Unbundled clk a = CSignal clk a
bundle :: SClock clk -> Unbundled clk a -> CSignal clk a
default bundle :: SClock clk -> CSignal clk a -> CSignal clk a
bundle _ s = s
unbundle :: SClock clk -> CSignal clk a -> Unbundled clk a
default unbundle :: SClock clk -> CSignal clk a -> CSignal 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) = (CSignal t a, CSignal 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) = (CSignal t a, CSignal t b, CSignal 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) = ( CSignal t a, CSignal t b, CSignal t c
, CSignal 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) = ( CSignal t a, CSignal t b, CSignal t c
, CSignal t d, CSignal 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) = ( CSignal t a, CSignal t b, CSignal t c
, CSignal t d, CSignal t e, CSignal 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) = ( CSignal t a, CSignal t b, CSignal t c
, CSignal t d, CSignal t e, CSignal t f
, CSignal 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) = ( CSignal t a, CSignal t b, CSignal t c
, CSignal t d, CSignal t e, CSignal t f
, CSignal t g, CSignal 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 (CSignal t a)
bundle = vecBundle#
unbundle _ = sequenceA
vecBundle# :: SClock t -> Vec n (CSignal t a) -> CSignal t (Vec n a)
vecBundle# _ = sequenceA