Copyright | (C) 2013-2016 University of Twente 2019 Gergő Érdi 2016-2019 Myrtle Software Ltd |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | Christiaan Baaij <christiaan.baaij@gmail.com> |
Safe Haskell | Unsafe |
Language | Haskell2010 |
Extensions |
|
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
- 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 :: forall n. KnownNat n => String -> Q (TExp (BitVector n))
- 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
- 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
Bit
Bit
Bit | The constructor, |
|
Instances
Construction
Type classes
Eq
Ord
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.
BitVector has the type role
>>>
:i BitVector
type role BitVector nominal ...
as it is not safe to coerce between different size BitVector. To change the
size, use the functions in the Resize
class.
BV | The constructor, |
|
Instances
Accessors
Construction
bLit :: forall n. KnownNat n => String -> Q (TExp (BitVector n)) Source #
Create a binary literal
>>>
$$(bLit "1001") :: BitVector 4
1001>>>
$$(bLit "1001") :: BitVector 3
001
NB: You can also just write:
>>>
0b1001 :: BitVector 4
1001
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')) :: BitVector 4
1111
Also bLit
can handle don't care bits:
>>>
$$(bLit "1.0.") :: BitVector 4
1.0.
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 like another. NFDataX bits in the second argument are interpreted as don't care bits.
>>>
let expected = $$(bLit "1.") :: BitVector 2
>>>
let checked = $$(bLit "11") :: BitVector 2
>>>
checked `isLike` expected
True>>>
expected `isLike` checked
False
NB: Not synthesizable
Ord
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 funtions
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