module ForSyDe.Shallow.Utility.BitVector(
BitVector, Parity(..),
intToBitVector, bitVectorToInt,
addEvenParityBit, addOddParityBit, addParityBit,
removeParityBit,
isEvenParity, isOddParity,
isBitVector
)
where
import ForSyDe.Shallow.Core.Vector
type BitVector = Vector Integer
isBitVector :: (Num t, Eq t) =>
Vector t
-> Bool
isBitVector :: Vector t -> Bool
isBitVector Vector t
NullV = Bool
True
isBitVector (t
x:>Vector t
xs) = (t
x t -> [t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [t
0, t
1]) Bool -> Bool -> Bool
&& Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
isBitVector Vector t
xs
intToBitVector :: Int
-> Integer
-> BitVector
intToBitVector :: Int -> Integer -> BitVector
intToBitVector Int
bits Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
= Int -> Integer -> BitVector
forall a a1 t.
(Num a, Ord a1, Num a1, Integral t) =>
t -> a1 -> Vector a
intToBitVector' Int
bits Integer
n
intToBitVector Int
bits Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Integer -> Integer
forall a. Num a => a -> a
abs Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
= Int -> Integer -> BitVector
forall a a1 t.
(Num a, Ord a1, Num a1, Integral t) =>
t -> a1 -> Vector a
intToBitVector' Int
bits (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
bits)
intToBitVector Int
_ Integer
_ | Bool
otherwise =
[Char] -> BitVector
forall a. HasCallStack => [Char] -> a
error [Char]
"intToBitvector : Number out of range!"
intToBitVector' :: (Num a, Ord a1, Num a1, Integral t) =>
t -> a1 -> Vector a
intToBitVector' :: t -> a1 -> Vector a
intToBitVector' t
0 a1
_ = Vector a
forall a. Vector a
NullV
intToBitVector' t
bits a1
n = if a1
n a1 -> a1 -> Bool
forall a. Ord a => a -> a -> Bool
>= a1
2a1 -> t -> a1
forall a b. (Num a, Integral b) => a -> b -> a
^(t
bitst -> t -> t
forall a. Num a => a -> a -> a
-t
1) then
a
1 a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> t -> a1 -> Vector a
forall a a1 t.
(Num a, Ord a1, Num a1, Integral t) =>
t -> a1 -> Vector a
intToBitVector' (t
bitst -> t -> t
forall a. Num a => a -> a -> a
-t
1) (a1
n a1 -> a1 -> a1
forall a. Num a => a -> a -> a
- a1
2a1 -> t -> a1
forall a b. (Num a, Integral b) => a -> b -> a
^(t
bitst -> t -> t
forall a. Num a => a -> a -> a
-t
1))
else
a
0 a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> t -> a1 -> Vector a
forall a a1 t.
(Num a, Ord a1, Num a1, Integral t) =>
t -> a1 -> Vector a
intToBitVector' (t
bitst -> t -> t
forall a. Num a => a -> a -> a
-t
1) a1
n
bitVectorToInt :: BitVector -> Integer
bitVectorToInt :: BitVector -> Integer
bitVectorToInt (Integer
1:>BitVector
xv) | BitVector -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
isBitVector BitVector
xv
= BitVector -> Int -> Integer
forall a t. (Integral a, Num t) => Vector t -> a -> t
bitVectorToInt' BitVector
xv (BitVector -> Int
forall a. Vector a -> Int
lengthV BitVector
xv) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ BitVector -> Int
forall a. Vector a -> Int
lengthV BitVector
xv
bitVectorToInt (Integer
0:>BitVector
xv) | BitVector -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
isBitVector BitVector
xv
= BitVector -> Int -> Integer
forall a t. (Integral a, Num t) => Vector t -> a -> t
bitVectorToInt' BitVector
xv (BitVector -> Int
forall a. Vector a -> Int
lengthV BitVector
xv)
bitVectorToInt BitVector
_ = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"bitVectorToInt: Vector is not a BitVector!"
bitVectorToInt' :: (Integral a, Num t) => Vector t -> a -> t
bitVectorToInt' :: Vector t -> a -> t
bitVectorToInt' Vector t
NullV a
_ = t
0
bitVectorToInt' (t
x:>Vector t
xv) a
bit = t
x t -> t -> t
forall a. Num a => a -> a -> a
* t
2t -> a -> t
forall a b. (Num a, Integral b) => a -> b -> a
^(a
bita -> a -> a
forall a. Num a => a -> a -> a
-a
1) t -> t -> t
forall a. Num a => a -> a -> a
+ Vector t -> a -> t
forall a t. (Integral a, Num t) => Vector t -> a -> t
bitVectorToInt' Vector t
xv (a
bita -> a -> a
forall a. Num a => a -> a -> a
-a
1)
data Parity = Even | Odd deriving (Int -> Parity -> ShowS
[Parity] -> ShowS
Parity -> [Char]
(Int -> Parity -> ShowS)
-> (Parity -> [Char]) -> ([Parity] -> ShowS) -> Show Parity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Parity] -> ShowS
$cshowList :: [Parity] -> ShowS
show :: Parity -> [Char]
$cshow :: Parity -> [Char]
showsPrec :: Int -> Parity -> ShowS
$cshowsPrec :: Int -> Parity -> ShowS
Show, Parity -> Parity -> Bool
(Parity -> Parity -> Bool)
-> (Parity -> Parity -> Bool) -> Eq Parity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parity -> Parity -> Bool
$c/= :: Parity -> Parity -> Bool
== :: Parity -> Parity -> Bool
$c== :: Parity -> Parity -> Bool
Eq)
addEvenParityBit :: (Num a, Eq a) => Vector a -> Vector a
addEvenParityBit :: Vector a -> Vector a
addEvenParityBit = Parity -> Vector a -> Vector a
forall a. (Num a, Eq a) => Parity -> Vector a -> Vector a
addParityBit Parity
Even
addOddParityBit :: (Num a, Eq a) => Vector a -> Vector a
addOddParityBit :: Vector a -> Vector a
addOddParityBit = Parity -> Vector a -> Vector a
forall a. (Num a, Eq a) => Parity -> Vector a -> Vector a
addParityBit Parity
Odd
addParityBit :: (Num a, Eq a) => Parity -> Vector a -> Vector a
addParityBit :: Parity -> Vector a -> Vector a
addParityBit Parity
p Vector a
v
| Vector a -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
isBitVector Vector a
v = case Parity
p of
Parity
Even -> Bool -> Vector a
resZero Bool
even
Parity
Odd -> Bool -> Vector a
resZero (Bool -> Bool
not Bool
even)
| Bool
otherwise = [Char] -> Vector a
forall a. HasCallStack => [Char] -> a
error [Char]
"addParity: Vector is not a BitVector"
where even :: Bool
even = Vector a -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
evenNumber Vector a
v
resZero :: Bool -> Vector a
resZero Bool
b = Vector a
v Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<+> a -> Vector a
forall a. a -> Vector a
unitV (if Bool
b then a
0 else a
1)
removeParityBit :: (Num t, Eq t) => Vector t -> Vector t
removeParityBit :: Vector t -> Vector t
removeParityBit Vector t
v
| Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
isBitVector Vector t
v = Int -> Vector t -> Vector t
forall a b. (Num a, Ord a) => a -> Vector b -> Vector b
takeV (Vector t -> Int
forall a. Vector a -> Int
lengthV Vector t
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector t
v
| Bool
otherwise = [Char] -> Vector t
forall a. HasCallStack => [Char] -> a
error [Char]
"removeParityBit: Vector is not a BitVector "
isEvenParity :: (Num t, Eq t) => Vector t -> Bool
isEvenParity :: Vector t -> Bool
isEvenParity = Parity -> Vector t -> Bool
forall t. (Num t, Eq t) => Parity -> Vector t -> Bool
isParityCorrect Parity
Even
isOddParity :: (Num t, Eq t) => Vector t -> Bool
isOddParity :: Vector t -> Bool
isOddParity = Parity -> Vector t -> Bool
forall t. (Num t, Eq t) => Parity -> Vector t -> Bool
isParityCorrect Parity
Odd
isParityCorrect :: (Num t, Eq t) => Parity -> Vector t -> Bool
isParityCorrect :: Parity -> Vector t -> Bool
isParityCorrect Parity
Even Vector t
xv = Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
evenNumber Vector t
xv
isParityCorrect Parity
Odd Vector t
xv = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
evenNumber Vector t
xv
evenNumber :: (Num t, Eq t) => Vector t -> Bool
evenNumber :: Vector t -> Bool
evenNumber Vector t
NullV = Bool
True
evenNumber (t
0:>Vector t
xv) = Bool -> Bool -> Bool
xor Bool
False (Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
evenNumber Vector t
xv)
evenNumber (t
1:>Vector t
xv) = Bool -> Bool -> Bool
xor Bool
True (Vector t -> Bool
forall t. (Num t, Eq t) => Vector t -> Bool
evenNumber Vector t
xv)
evenNumber (t
_:>Vector t
_) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"evenNumber: Vector is not a BitVector "
xor :: Bool -> Bool -> Bool
xor :: Bool -> Bool -> Bool
xor Bool
True Bool
False = Bool
True
xor Bool
False Bool
True = Bool
True
xor Bool
_ Bool
_ = Bool
False