Copyright | (C) 2018 Google Inc. |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | Christiaan Baaij <[email protected]> |
Safe Haskell | None |
Language | Haskell2010 |
Clash.Annotations.BitRepresentation
Description
Using ANN pragma's you can tell the Clash compiler to use a custom
bit representation for a data type. See DataReprAnn
for documentation.
Synopsis
- data DataReprAnn = DataReprAnn Type Size [ConstrRepr]
- data ConstrRepr = ConstrRepr Name BitMask Value [FieldAnn]
- type BitMask = Integer
- type Value = Integer
- type Size = Int
- type FieldAnn = BitMask
- liftQ :: Lift a => Q a -> Q Exp
Data structures to express a custom bit representation
data DataReprAnn Source #
Annotation for custom bit representations of data types
Using ANN pragma's you can tell the Clash compiler to use a custom bit-representation for a data type.
For example:
data Color = R | G | B {-# ANN module (DataReprAnn
$(liftQ
[t|Color|]) 2 [ConstrRepr
'R 0b11 0b00 [] ,ConstrRepr
'G 0b11 0b01 [] ,ConstrRepr
'B 0b11 0b10 [] ]) #-}
This specifies that R
should be encoded as 0b00, G
as 0b01, and
B
as 0b10. The first binary value in every ConstrRepr
in this example
is a mask, indicating which bits in the data type are relevant. In this case
all of the bits are.
Or if we want to annotate Maybe Color
:
{-# ANN module (DataReprAnn
$(liftQ
[t|Maybe Color|]) 2 [ConstrRepr
'Nothing 0b11 0b11 [] ,ConstrRepr
'Just 0b00 0b00 [0b11] ] ) #-}
By default, Maybe Color
is a data type which consumes 3 bits. A single bit
to indicate the constructor (either Just
or Nothing
), and two bits to encode
the first field of Just
. Notice that we saved a single bit by exploiting
the fact that Color
only uses three values (0, 1, 2), but takes two bits
to encode it. We can therefore use the last - unused - value (3), to encode
one of the constructors of Maybe
. We indicate which bits encode the
underlying Color
field of Just
by passing [0b11] to ConstrRepr. This
indicates that the first field is encoded in the first and second bit of the
whole datatype (0b11).
NB: BitPack for a custom encoding can be derived using
deriveBitPack
.
Constructors
DataReprAnn Type Size [ConstrRepr] |
Instances
data ConstrRepr Source #
Annotation for constructors. Indicates how to match this constructor based off of the whole datatype.
Constructors
ConstrRepr Name BitMask Value [FieldAnn] |
Instances
Data ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ConstrRepr -> c ConstrRepr # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ConstrRepr # toConstr :: ConstrRepr -> Constr # dataTypeOf :: ConstrRepr -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ConstrRepr) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ConstrRepr) # gmapT :: (forall b. Data b => b -> b) -> ConstrRepr -> ConstrRepr # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ConstrRepr -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ConstrRepr -> r # gmapQ :: (forall d. Data d => d -> u) -> ConstrRepr -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ConstrRepr -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ConstrRepr -> m ConstrRepr # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ConstrRepr -> m ConstrRepr # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ConstrRepr -> m ConstrRepr # | |||||
Generic ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation Associated Types
| |||||
Show ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation Methods showsPrec :: Int -> ConstrRepr -> ShowS # show :: ConstrRepr -> String # showList :: [ConstrRepr] -> ShowS # | |||||
Eq ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation | |||||
Lift ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation Methods lift :: Quote m => ConstrRepr -> m Exp # liftTyped :: forall (m :: Type -> Type). Quote m => ConstrRepr -> Code m ConstrRepr # | |||||
type Rep ConstrRepr Source # | |||||
Defined in Clash.Annotations.BitRepresentation type Rep ConstrRepr = D1 ('MetaData "ConstrRepr" "Clash.Annotations.BitRepresentation" "clash-prelude-1.8.2-5TjnxEb2Rn58GfkYf0UYjY" 'False) (C1 ('MetaCons "ConstrRepr" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BitMask)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [FieldAnn])))) |