module CLaSH.Class.BitPack
( BitPack (..)
, bitCoerce
)
where
import GHC.TypeLits (KnownNat, Nat, type (+), type (*))
import Prelude hiding (map)
import CLaSH.Sized.BitVector (BitVector, (++#), high, low)
import CLaSH.Sized.Internal.BitVector (split#)
import CLaSH.Sized.Vector (Vec, concatBitVector#, map,
unconcatBitVector#)
class BitPack a where
type BitSize a :: Nat
pack :: a -> BitVector (BitSize a)
unpack :: BitVector (BitSize a) -> a
bitCoerce :: (BitPack a, BitPack b, BitSize a ~ BitSize b)
=> a
-> b
bitCoerce = unpack . pack
instance BitPack Bool where
type BitSize Bool = 1
pack True = high
pack False = low
unpack bv = if bv == high then True else False
instance BitPack (BitVector n) where
type BitSize (BitVector n) = n
pack v = v
unpack v = v
instance (KnownNat (BitSize a), KnownNat (BitSize b), BitPack a, BitPack b) =>
BitPack (a,b) where
type BitSize (a,b) = BitSize a + BitSize b
pack (a,b) = pack a ++# pack b
unpack ab = let (a,b) = split# ab in (unpack a, unpack b)
instance (KnownNat n, KnownNat (BitSize a), BitPack a) => BitPack (Vec n a) where
type BitSize (Vec n a) = n * (BitSize a)
pack = concatBitVector# . map pack
unpack = map unpack . unconcatBitVector#