Copyright | (C) 2013-2016 University of Twente 2019 Gergő Érdi 2016-2019 Myrtle Software Ltd 2021-2024 QBayLogic B.V. 2023 Nadia Chambers |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | QBayLogic B.V. <devops@qbaylogic.com> |
Safe Haskell | Unsafe |
Language | Haskell2010 |
Extensions |
|
Clash.Sized.Internal.BitVector
Description
Synopsis
- data Bit = Bit {
- unsafeMask# :: !Word
- unsafeToInteger# :: !Word
- high :: Bit
- low :: Bit
- eq## :: Bit -> Bit -> Bool
- neq## :: Bit -> Bit -> Bool
- lt## :: Bit -> Bit -> Bool
- ge## :: Bit -> Bit -> Bool
- gt## :: Bit -> Bit -> Bool
- le## :: Bit -> Bit -> Bool
- toEnum## :: Int -> Bit
- fromInteger## :: Word# -> Integer -> Bit
- and## :: Bit -> Bit -> Bit
- or## :: Bit -> Bit -> Bit
- xor## :: Bit -> Bit -> Bit
- complement## :: Bit -> Bit
- pack# :: Bit -> BitVector 1
- unpack# :: BitVector 1 -> Bit
- data BitVector (n :: Nat) = BV {
- unsafeMask :: !Natural
- unsafeToNatural :: !Natural
- size# :: KnownNat n => BitVector n -> Int
- maxIndex# :: KnownNat n => BitVector n -> Int
- bLit :: String -> ExpQ
- hLit :: String -> ExpQ
- oLit :: String -> ExpQ
- undefined# :: forall n. KnownNat n => BitVector n
- (++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)
- reduceAnd# :: KnownNat n => BitVector n -> Bit
- reduceOr# :: KnownNat n => BitVector n -> Bit
- reduceXor# :: KnownNat n => BitVector n -> Bit
- index# :: KnownNat n => BitVector n -> Int -> Bit
- replaceBit# :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n
- setSlice# :: forall m i n. SNat ((m + 1) + i) -> BitVector ((m + 1) + i) -> SNat m -> SNat n -> BitVector ((m + 1) - n) -> BitVector ((m + 1) + i)
- slice# :: BitVector ((m + 1) + i) -> SNat m -> SNat n -> BitVector ((m + 1) - n)
- split# :: forall n m. KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)
- msb# :: forall n. KnownNat n => BitVector n -> Bit
- lsb# :: BitVector n -> Bit
- eq# :: KnownNat n => BitVector n -> BitVector n -> Bool
- neq# :: KnownNat n => BitVector n -> BitVector n -> Bool
- isLike# :: forall n. KnownNat n => BitVector n -> BitVector n -> Bool
- lt# :: KnownNat n => BitVector n -> BitVector n -> Bool
- ge# :: KnownNat n => BitVector n -> BitVector n -> Bool
- gt# :: KnownNat n => BitVector n -> BitVector n -> Bool
- le# :: KnownNat n => BitVector n -> BitVector n -> Bool
- toEnum# :: forall n. KnownNat n => Int -> BitVector n
- fromEnum# :: forall n. KnownNat n => BitVector n -> Int
- enumFrom# :: forall n. KnownNat n => BitVector n -> [BitVector n]
- enumFromThen# :: forall n. KnownNat n => BitVector n -> BitVector n -> [BitVector n]
- enumFromTo# :: forall n. KnownNat n => BitVector n -> BitVector n -> [BitVector n]
- enumFromThenTo# :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n -> [BitVector n]
- minBound# :: BitVector n
- maxBound# :: forall n. KnownNat n => BitVector n
- (+#) :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- (-#) :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- (*#) :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- negate# :: forall n. KnownNat n => BitVector n -> BitVector n
- fromInteger# :: KnownNat n => Natural -> Integer -> BitVector n
- plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
- minus# :: forall m n. (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
- times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n)
- quot# :: KnownNat n => BitVector n -> BitVector n -> BitVector n
- rem# :: KnownNat n => BitVector n -> BitVector n -> BitVector n
- toInteger# :: KnownNat n => BitVector n -> Integer
- and# :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- or# :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- xor# :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n
- complement# :: forall n. KnownNat n => BitVector n -> BitVector n
- shiftL# :: forall n. KnownNat n => BitVector n -> Int -> BitVector n
- shiftR# :: forall n. KnownNat n => BitVector n -> Int -> BitVector n
- rotateL# :: forall n. KnownNat n => BitVector n -> Int -> BitVector n
- rotateR# :: forall n. KnownNat n => BitVector n -> Int -> BitVector n
- popCountBV :: forall n. KnownNat n => BitVector (n + 1) -> Index (n + 2)
- countLeadingZerosBV :: KnownNat n => BitVector n -> Index (n + 1)
- countTrailingZerosBV :: KnownNat n => BitVector n -> Index (n + 1)
- truncateB# :: forall a b. KnownNat a => BitVector (a + b) -> BitVector a
- shrinkSizedUnsigned :: (KnownNat n, Integral (p n)) => p n -> [p n]
- undefError :: KnownNat n => String -> [BitVector n] -> a
- checkUnpackUndef :: (KnownNat n, Typeable a) => (BitVector n -> a) -> BitVector n -> a
- bitPattern :: String -> Q Pat
- xToBV :: KnownNat n => BitVector n -> BitVector n
Bit
A single bit
NB: The usual Haskell method of converting an integral numeric type to
another, fromIntegral
, is not well suited for Clash as it will go through
Integer
which is arbitrarily bounded in HDL. Instead use
bitCoerce
and the Resize
class.
Constructors
Bit | The constructor, |
Fields
|
Instances
Construction
Type classes
Eq
Ord
Enum
Num
Bits
complement## :: Bit -> Bit Source #
BitPack
BitVector
data BitVector (n :: Nat) Source #
A vector of bits
- Bit indices are descending
Num
instance performs unsigned arithmetic.
NB: The usual Haskell method of converting an integral numeric type to
another, fromIntegral
, is not well suited for Clash as it will go through
Integer
which is arbitrarily bounded in HDL. Instead use
bitCoerce
and the Resize
class.
BitVector has the type role
>>>
:i BitVector
type role BitVector nominal ...
as it is not safe to coerce between different sizes of BitVector. To change
the size, use the functions in the Resize
class.
Constructors
BV | The constructor, |
Fields
|
Instances
Accessors
Construction
bLit :: String -> ExpQ Source #
Create a binary literal
>>>
$(bLit "1001")
0b1001
NB: You can also just write:
>>>
0b1001 :: BitVector 4
0b1001
The advantage of bLit
is that you can use computations to create the
string literal:
>>>
import qualified Data.List as List
>>>
$(bLit (List.replicate 4 '1'))
0b1111
Also bLit
can handle don't care bits:
>>>
$(bLit "1.0.")
0b1.0.
NB: From Clash 1.6 an onwards bLit
will deduce the size of the
BitVector from the given string and annotate the splice it produces
accordingly.
hLit :: String -> ExpQ Source #
Create a hexadecimal literal
>>>
$(hLit "dead")
0b1101_1110_1010_1101
Don't care digits set 4 bits:
>>>
$(hLit "de..")
0b1101_1110_...._....
oLit :: String -> ExpQ Source #
Create an octal literal
>>>
$(oLit "5234")
0b1010_1001_1100
Don't care digits set 3 bits:
>>>
$(oLit "52..")
0b1010_10.._....
undefined# :: forall n. KnownNat n => BitVector n Source #
Create a BitVector with all its bits undefined
Concatenation
(++#) :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m) Source #
Concatenate two BitVector
s
Reduction
Indexing
setSlice# :: forall m i n. SNat ((m + 1) + i) -> BitVector ((m + 1) + i) -> SNat m -> SNat n -> BitVector ((m + 1) - n) -> BitVector ((m + 1) + i) Source #
Type classes
Eq
isLike# :: forall n. KnownNat n => BitVector n -> BitVector n -> Bool Source #
Check if one BitVector is similar to another, interpreting undefined bits
in the second argument as being "don't care" bits. This is a more lenient
version of (==)
, similar to std_match
in VHDL or casez
in Verilog.
>>>
let expected = $(bLit "1.")
>>>
let checked = $(bLit "11")
>>>
checked `isLike#` expected
True>>>
expected `isLike#` checked
False
NB: Not synthesizable
Ord
Enum
Enum (not synthesizable)
enumFromThenTo# :: forall n. KnownNat n => BitVector n -> BitVector n -> BitVector n -> [BitVector n] Source #
Bounded
Num
ExtendingNum
minus# :: forall m n. (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1) Source #
Integral
Bits
FiniteBits
Resize
QuickCheck
shrinkSizedUnsigned :: (KnownNat n, Integral (p n)) => p n -> [p n] Source #
shrink
for sized unsigned types
Other
Implement BitVector undefinedness checking for unpack functions
bitPattern :: String -> Q Pat Source #
Template Haskell macro for generating a pattern matching on some bits of a value.
This macro compiles to an efficient view pattern that matches the
bits of a given value against the bits specified in the
pattern. The scrutinee can be any type that is an instance of the
Num
, Bits
and Eq
typeclasses.
The bit pattern is specified by a string which contains:
'0'
or'1'
for matching a bit'.'
for bits which are not matched (wildcard)'_'
can be used as a separator similar to the NumericUnderscores language extension- lowercase alphabetical characters can be used to bind some bits to variables.
For example
"0aab11bb"
will bind two variablesaa :: BitVector 2
andbbb :: BitVector 3
with their values set by the corresponding bits
The following example matches a byte against two bit patterns where
some bits are relevant and others are not while binding two variables aa
and bb
:
decode :: Unsigned 8 -> Maybe Bool decode $(bitPattern "00.._.110") = Just True decode $(bitPattern "10.._0001") = Just False decode $(bitPattern "aa.._b0b1") = Just (aa + bb > 1) decode _ = Nothing