{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Clash.Signal.Bundle
( Bundle (..)
)
where
import Control.Applicative (liftA2)
import GHC.TypeLits (KnownNat)
import Prelude hiding (head, map, tail)
import Clash.NamedTypes ((:::))
import Clash.Signal.Bundle.Internal (deriveBundleTuples)
import Clash.Signal.Internal (Domain, Signal (..))
import Clash.Sized.BitVector (Bit, 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#, lazyV)
import Clash.Sized.RTree (RTree, lazyT)
class Bundle a where
type Unbundled (domain :: Domain) a = res | res -> domain a
type Unbundled domain a = Signal domain a
bundle :: Unbundled domain a -> Signal domain a
{-# INLINE bundle #-}
default bundle :: (Signal domain a ~ Unbundled domain a)
=> Unbundled domain a -> Signal domain a
bundle s = s
unbundle :: Signal domain a -> Unbundled domain a
{-# INLINE unbundle #-}
default unbundle :: (Unbundled domain a ~ Signal domain a)
=> Signal domain a -> Unbundled domain a
unbundle s = s
instance Bundle Bool
instance Bundle Integer
instance Bundle Int
instance Bundle Float
instance Bundle Double
instance Bundle (Maybe a)
instance Bundle (Either a b)
instance Bundle Bit
instance Bundle (BitVector n)
instance Bundle (Index n)
instance Bundle (Fixed rep int frac)
instance Bundle (Signed n)
instance Bundle (Unsigned n)
instance Bundle () where
type Unbundled t () = t ::: ()
bundle u = pure u
unbundle _ = ()
deriveBundleTuples ''Bundle ''Unbundled 'bundle 'unbundle
instance KnownNat n => Bundle (Vec n a) where
type Unbundled t (Vec n a) = Vec n (Signal t a)
bundle = vecBundle#
unbundle = sequenceA . fmap lazyV
{-# NOINLINE vecBundle# #-}
vecBundle# :: Vec n (Signal t a) -> Signal t (Vec n a)
vecBundle# = traverse# id
instance KnownNat d => Bundle (RTree d a) where
type Unbundled t (RTree d a) = RTree d (Signal t a)
bundle = sequenceA
unbundle = sequenceA . fmap lazyT