{-# LANGUAGE ConstrainedClassMethods #-}

module ReWire.BitWord where

import Prelude hiding ((+),(*),(-),(||),(&&))
import qualified Prelude
import Data.Bits
import qualified Data.Vector.Sized as V

type Vec n a = V.Vector n a
type Bit = Bool

zero :: Bit
zero :: Bool
zero = Bool
False

one :: Bit
one :: Bool
one = Bool
True


toInt :: Bit -> Int
toInt :: Bool -> Int
toInt Bool
True = Int
1
toInt Bool
False = Int
0

notBit :: Bit -> Bit
notBit :: Bool -> Bool
notBit = Bool -> Bool
not

-- | AND
(>&&<) :: Bit -> Bit -> Bit
Bool
True >&&< :: Bool -> Bool -> Bool
>&&< Bool
True = Bool
True
Bool
_ >&&< Bool
_ = Bool
False

-- | OR
(>||<) :: Bit -> Bit -> Bit
Bool
False >||< :: Bool -> Bool -> Bool
>||< Bool
False = Bool
False
Bool
_ >||< Bool
_ = Bool
True

-- | XOR
(>^<) :: Bit -> Bit -> Bit
Bool
False >^< :: Bool -> Bool -> Bool
>^< Bool
True = Bool
True
Bool
True >^< Bool
False = Bool
True
Bool
_ >^< Bool
_ = Bool
False

-- | Eq
(>==<) :: Bit -> Bit -> Bit
Bool
False >==< :: Bool -> Bool -> Bool
>==< Bool
False = Bool
True
Bool
True >==< Bool
True = Bool
True
Bool
_ >==< Bool
_ = Bool
False

-- | NAND
(>~&<) :: Bit -> Bit -> Bit
Bool
True >~&< :: Bool -> Bool -> Bool
>~&< Bool
True = Bool
False
Bool
_ >~&< Bool
_ = Bool
True

-- | NOR
(>~|<) :: Bit -> Bit -> Bit
Bool
False >~|< :: Bool -> Bool -> Bool
>~|< Bool
False = Bool
True
Bool
_ >~|< Bool
_ = Bool
False

-- | XNOR
(>~^<) :: Bit -> Bit -> Bit
Bool
False >~^< :: Bool -> Bool -> Bool
>~^< Bool
True = Bool
False
Bool
True >~^< Bool
False = Bool
False
Bool
_ >~^< Bool
_ = Bool
True


-- | a b c ~> (a+b+c,carry_out)
rca :: Bit -> Bit -> Bit -> (Bit,Bit)
rca :: Bool -> Bool -> Bool -> (Bool, Bool)
rca Bool
False Bool
False Bool
False = (Bool
False,Bool
False)
rca Bool
False Bool
False Bool
True = (Bool
True,Bool
False)
rca Bool
False Bool
True Bool
False = (Bool
True,Bool
False)
rca Bool
False Bool
True Bool
True = (Bool
False,Bool
True)
rca Bool
True Bool
False Bool
False = (Bool
True,Bool
False)
rca Bool
True Bool
False Bool
True = (Bool
False,Bool
True)
rca Bool
True Bool
True Bool
False = (Bool
False,Bool
True)
rca Bool
True Bool
True Bool
True = (Bool
True,Bool
True)



int2bin :: Int -> [Bit]
int2bin :: Int -> [Bool]
int2bin Int
i | Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0      = []
          | Bool
otherwise = Bool
b Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Int -> [Bool]
int2bin (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
              where b :: Bool
b = case Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 of
                      Int
0 -> Bool
False
                      Int
1 -> Bool
True
                      Int
_ -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"can't happen"

-- | assumes inputs are same length
carryadd' :: [Bool] -> [Bool] -> Bool -> ([Bool],Bool)
carryadd' :: [Bool] -> [Bool] -> Bool -> ([Bool], Bool)
carryadd' [] [Bool]
_ Bool
c = ([],Bool
c)
carryadd' (Bool
_:[Bool]
_) [] Bool
c = ([],Bool
c)
carryadd' (Bool
a:[Bool]
as) (Bool
b:[Bool]
bs) Bool
c =
  (Bool
abBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
res, Bool
c'')
  where
   ([Bool]
res, Bool
c') = [Bool] -> [Bool] -> Bool -> ([Bool], Bool)
carryadd' [Bool]
as [Bool]
bs Bool
c
   (Bool
ab , Bool
c'') = Bool -> Bool -> Bool -> (Bool, Bool)
rca Bool
a Bool
b Bool
c'

msBit' :: [Bool] -> Bool
msBit' :: [Bool] -> Bool
msBit' (Bool
b:[Bool]
_) = Bool
b
msBit' []    = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"msBit: empty list"

lsBit' :: [Bool] -> Bool
lsBit' :: [Bool] -> Bool
lsBit' = [Bool] -> Bool
forall a. HasCallStack => [a] -> a
last

bitwiseXor' :: [Bool] -> [Bool] -> [Bool]
bitwiseXor' :: [Bool] -> [Bool] -> [Bool]
bitwiseXor' = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
xor

bitwiseAnd':: [Bool] -> [Bool] -> [Bool]
bitwiseAnd' :: [Bool] -> [Bool] -> [Bool]
bitwiseAnd' = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(Prelude.&&)

bitwiseOr' :: [Bool] -> [Bool] -> [Bool]
bitwiseOr' :: [Bool] -> [Bool] -> [Bool]
bitwiseOr' = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(Prelude.||)

bitwiseNot' :: [Bool] -> [Bool]
bitwiseNot' :: [Bool] -> [Bool]
bitwiseNot' = (Bool -> Bool) -> [Bool] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Bool
not

bitwiseXNor' :: [Bool] -> [Bool] -> [Bool]
bitwiseXNor' :: [Bool] -> [Bool] -> [Bool]
bitwiseXNor' = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(>~^<)

rAnd' :: [Bool] -> Bool
rAnd' :: [Bool] -> Bool
rAnd' = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>&&<) Bool
True

rOr' :: [Bool] -> Bool
rOr' :: [Bool] -> Bool
rOr' = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>||<) Bool
False

rNand' :: [Bool] -> Bool
rNand' :: [Bool] -> Bool
rNand' = Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>&&<) Bool
True

rNor' :: [Bool] -> Bool
rNor' :: [Bool] -> Bool
rNor' = Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>||<) Bool
False

rXor' :: [Bool] -> Bool
rXor' :: [Bool] -> Bool
rXor' = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>^<) Bool
False

rXnor' :: [Bool] -> Bool
rXnor' :: [Bool] -> Bool
rXnor' = Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(>^<) Bool
False

-- | Produces bits in little endian form.
int2bits' :: Integer -> [Bool]
int2bits' :: Integer -> [Bool]
int2bits' Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Integer
0      = []
            | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Integer -> [Bool]
int2bits' (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` ((Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
Prelude.^ (Integer
128::Integer)))
            | Bool
otherwise = Bool
b Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Integer -> [Bool]
int2bits' (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2)
              where b :: Bool
b = case Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
2 of
                      Integer
0 -> Bool
False
                      Integer
1 -> Bool
True
                      Integer
_ -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible remainder"

lit' :: Integer -> [Bool]
lit' :: Integer -> [Bool]
lit' = [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> (Integer -> [Bool]) -> Integer -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Bool]
int2bits'

pad' :: Int -> [Bool] -> [Bool]
pad' :: Int -> [Bool] -> [Bool]
pad' Int
n [Bool]
v | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Int
0 = [Bool]
v
         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Int
0 = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Int -> [Bool] -> [Bool]
pad' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- Int
1) [Bool]
v
         | Bool
otherwise = [Char] -> [Bool]
forall a. HasCallStack => [Char] -> a
error [Char]
"negative padding"

-- | w is bigendian
padTrunc' :: Int -> [Bool] -> [Bool]
padTrunc' :: Int -> [Bool] -> [Bool]
padTrunc' Int
d [Bool]
w
      | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d    = [Bool]
w
      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d     = Int -> [Bool] -> [Bool]
pad' (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- Int
l) [Bool]
w
      | Bool
otherwise = [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
d ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool]
w
         where
           l :: Int
l = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w

-- | takes little endian bits
toIntLE' :: [Bool] -> Int
toIntLE' :: [Bool] -> Int
toIntLE' [] = Int
0
toIntLE' (Bool
b:[Bool]
bs) = Bool -> Int
toInt Bool
b Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.* [Bool] -> Int
toIntLE' [Bool]
bs

toInt' :: [Bool] -> Int
toInt' :: [Bool] -> Int
toInt' = [Bool] -> Int
toIntLE' ([Bool] -> Int) -> ([Bool] -> [Bool]) -> [Bool] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse

fromBool :: Bool -> Integer
fromBool :: Bool -> Integer
fromBool = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Bool -> Int) -> Bool -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum

toInteger' :: Vec n Bool -> Integer
toInteger' :: forall (n :: Nat). Vec n Bool -> Integer
toInteger' = (Integer -> Bool -> Integer)
-> Integer -> Vector Vector n Bool -> Integer
forall b a. (b -> a -> b) -> b -> Vector Vector n a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Integer
s Bool
x -> Bool -> Integer
fromBool Bool
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.* Integer
s) Integer
0

-- | The unsigned value of a big-endian bit list, as an Integer (exact at
--   any width, unlike 'toInt'').
bitsToInteger' :: [Bool] -> Integer
bitsToInteger' :: [Bool] -> Integer
bitsToInteger' = (Integer -> Bool -> Integer) -> Integer -> [Bool] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Integer
s Bool
x -> Bool -> Integer
fromBool Bool
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.* Integer
s) Integer
0

-- | Materialize an Integer as exactly d bits, big-endian, reducing mod 2^d
--   (so a negative value takes its d-bit two's-complement form).
intToBits' :: Int -> Integer -> [Bool]
intToBits' :: Int -> Integer -> [Bool]
intToBits' Int
d Integer
x = Int -> [Bool] -> [Bool]
padTrunc' Int
d ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Integer -> [Bool]
int2bits' (Integer -> [Bool]) -> Integer -> [Bool]
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
d)

-- | w is bigendian
resize' :: Int -> [Bool] -> [Bool]
resize' :: Int -> [Bool] -> [Bool]
resize' Int
d [Bool]
w | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Int
d = [Bool]
w
            | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.< Int
d  = Int -> [Bool] -> [Bool]
pad' (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- Int
l) [Bool]
w
            | Bool
otherwise = [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
d ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool]
w
       where
         l :: Int
l = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w

false' :: [Bool] -> Bool
false' :: [Bool] -> Bool
false' [] = Bool
True
false' (Bool
False:[Bool]
bs) = [Bool] -> Bool
false' [Bool]
bs
false' (Bool
True:[Bool]
_) = Bool
False

toBit' :: [Bool] -> Bool
toBit' :: [Bool] -> Bool
toBit' = Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
false'

zero' :: [Bool]
zero' :: [Bool]
zero' = [Bool
False]

one' :: [Bool]
one' :: [Bool]
one' = [Bool
True]

negate' :: [Bool] -> [Bool]
negate' :: [Bool] -> [Bool]
negate' [Bool]
w = [Bool] -> [Bool] -> [Bool]
plus' ([Bool] -> [Bool]
bitwiseNot' [Bool]
w) (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w) [Bool]
one')

plus' :: [Bool] -> [Bool] -> [Bool]
plus' :: [Bool] -> [Bool] -> [Bool]
plus' [Bool]
as [Bool]
bs = ([Bool], Bool) -> [Bool]
forall a b. (a, b) -> a
fst (([Bool], Bool) -> [Bool]) -> ([Bool], Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool] -> Bool -> ([Bool], Bool)
carryadd' [Bool]
as [Bool]
bs Bool
False

minus' :: [Bool] -> [Bool] -> [Bool]
minus' :: [Bool] -> [Bool] -> [Bool]
minus' [Bool]
as [Bool]
bs = [Bool] -> [Bool] -> [Bool]
plus' [Bool]
as ([Bool] -> [Bool]
negate' [Bool]
bs)

nudgeL' :: ([Bool] , Bool) -> (Bool , [Bool])
nudgeL' :: ([Bool], Bool) -> (Bool, [Bool])
nudgeL' (Bool
b:[Bool]
bs,Bool
q) = (Bool
b,[Bool]
bs [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
q])
nudgeL' ([Bool], Bool)
_        = [Char] -> (Bool, [Bool])
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"nudgeL': empty list"

nudgeR' :: (Bool,[Bool]) -> ([Bool],Bool)
nudgeR' :: (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' (Bool
q,[Bool]
w) = (Bool
q Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool]
forall a. HasCallStack => [a] -> [a]
init [Bool]
w , [Bool] -> Bool
forall a. HasCallStack => [a] -> a
last [Bool]
w)

rNudge' :: ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' :: ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' ([Bool]
a,[Bool]
q) = ([Bool]
a' , [Bool]
q' , Bool
lsb)
     where
       ([Bool]
a',Bool
la)  = (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' ([Bool] -> Bool
msBit' [Bool]
a , [Bool]
a)
       ([Bool]
q',Bool
lsb) = (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' (Bool
la , [Bool]
q)

boothround :: ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool])
boothround :: ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool])
boothround ([Bool]
a,[Bool]
q,Bool
q_1,[Bool]
m) = let
    q_0 :: Bool
q_0 = [Bool] -> Bool
lsBit' [Bool]
q in
    case (Bool
q_0,Bool
q_1) of
      (Bool
False,Bool
False) -> ([Bool]
a',[Bool]
q',Bool
q_1',[Bool]
m)
        where
          ([Bool]
a',[Bool]
q',Bool
q_1') = ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' ([Bool]
a,[Bool]
q)

      (Bool
True,Bool
False) -> ([Bool]
a'',[Bool]
q',Bool
q_1',[Bool]
m)           -- A - M
        where
          a' :: [Bool]
a'            = [Bool] -> [Bool] -> [Bool]
minus' [Bool]
a [Bool]
m
          ([Bool]
a'',[Bool]
q',Bool
q_1') = ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' ([Bool]
a',[Bool]
q)

      (Bool
False,Bool
True) -> ([Bool]
a'', [Bool]
q',Bool
q_1',[Bool]
m)     -- A + M
        where
          a' :: [Bool]
a'            = [Bool] -> [Bool] -> [Bool]
plus' [Bool]
a [Bool]
m
          ([Bool]
a'',[Bool]
q',Bool
q_1') = ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' ([Bool]
a',[Bool]
q)

      (Bool
True,Bool
True) -> ([Bool]
a',[Bool]
q',Bool
q_1',[Bool]
m)
        where
          ([Bool]
a',[Bool]
q',Bool
q_1')  = ([Bool], [Bool]) -> ([Bool], [Bool], Bool)
rNudge' ([Bool]
a,[Bool]
q)


-- | assume all are same length, for example W8
booth' :: ([Bool], [Bool]) -> ([Bool], [Bool])
booth' :: ([Bool], [Bool]) -> ([Bool], [Bool])
booth' ([Bool]
w1,[Bool]
w2) = ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool])
forall {a} {b} {c} {d}. (a, b, c, d) -> (a, b)
proj (([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool]))
-> ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool])
forall a b. (a -> b) -> a -> b
$ ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool])
rounds (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w1) [Bool]
zero' , [Bool]
w1,Bool
False,[Bool]
w2)
      where proj :: (a, b, c, d) -> (a, b)
proj (a
x,b
y,c
_,d
_) = (a
x,b
y)
            rounds :: ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool])
rounds ([Bool], [Bool], Bool, [Bool])
z = (([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool]))
-> ([Bool], [Bool], Bool, [Bool])
-> [([Bool], [Bool], Bool, [Bool])]
forall a. (a -> a) -> a -> [a]
iterate ([Bool], [Bool], Bool, [Bool]) -> ([Bool], [Bool], Bool, [Bool])
boothround ([Bool], [Bool], Bool, [Bool])
z [([Bool], [Bool], Bool, [Bool])]
-> Int -> ([Bool], [Bool], Bool, [Bool])
forall a. HasCallStack => [a] -> Int -> a
!! [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w1

times' :: [Bool] -> [Bool] -> [Bool]
times' :: [Bool] -> [Bool] -> [Bool]
times' [Bool]
as [Bool]
bs = ([Bool], [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd (([Bool], [Bool]) -> [Bool]) -> ([Bool], [Bool]) -> [Bool]
forall a b. (a -> b) -> a -> b
$ ([Bool], [Bool]) -> ([Bool], [Bool])
booth' ([Bool]
as,[Bool]
bs)

shiftL1' :: [Bool] -> [Bool]
shiftL1' :: [Bool] -> [Bool]
shiftL1' [Bool]
w = (Bool, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd ((Bool, [Bool]) -> [Bool]) -> (Bool, [Bool]) -> [Bool]
forall a b. (a -> b) -> a -> b
$ ([Bool], Bool) -> (Bool, [Bool])
nudgeL' ([Bool]
w,Bool
False)

shiftR1' :: [Bool] -> [Bool]
shiftR1' :: [Bool] -> [Bool]
shiftR1' [Bool]
w = ([Bool], Bool) -> [Bool]
forall a b. (a, b) -> a
fst (([Bool], Bool) -> [Bool]) -> ([Bool], Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' (Bool
False,[Bool]
w)

arithShiftR1' :: [Bool] -> [Bool]
arithShiftR1' :: [Bool] -> [Bool]
arithShiftR1' [Bool]
w =
   if [Bool] -> Bool
msBit' [Bool]
w
   then ([Bool], Bool) -> [Bool]
forall a b. (a, b) -> a
fst (([Bool], Bool) -> [Bool]) -> ([Bool], Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' (Bool
True,[Bool]
w)
   else ([Bool], Bool) -> [Bool]
forall a b. (a, b) -> a
fst (([Bool], Bool) -> [Bool]) -> ([Bool], Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ (Bool, [Bool]) -> ([Bool], Bool)
nudgeR' (Bool
False,[Bool]
w)

decr' :: [Bool] -> [Bool]
decr' :: [Bool] -> [Bool]
decr' [Bool]
n = [Bool] -> [Bool] -> [Bool]
minus' [Bool]
n (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
n) [Bool]
one')

iter' :: [Bool] -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
iter' :: [Bool] -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
iter' [Bool]
n [Bool] -> [Bool]
f [Bool]
w =
  if [Bool] -> Bool
false' [Bool]
n
  then [Bool]
w
  else [Bool] -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
iter' ([Bool] -> [Bool]
decr' [Bool]
n) [Bool] -> [Bool]
f ([Bool] -> [Bool]
f [Bool]
w)

-- | The shift amount as an Int, saturated to the word length (the guard
--   compares in Integer, so amounts too wide for Int cannot wrap).
shiftAmount' :: [Bool] -> [Bool] -> Int
shiftAmount' :: [Bool] -> [Bool] -> Int
shiftAmount' [Bool]
w [Bool]
n
      | [Bool] -> Integer
bitsToInteger' [Bool]
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.>= Int -> Integer
forall a. Integral a => a -> Integer
Prelude.toInteger ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w) = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w
      | Bool
otherwise                                                = Integer -> Int
forall a. Num a => Integer -> a
Prelude.fromInteger ([Bool] -> Integer
bitsToInteger' [Bool]
n)

shiftL' :: [Bool] -> [Bool] -> [Bool]
shiftL' :: [Bool] -> [Bool] -> [Bool]
shiftL' [Bool]
w [Bool]
n = Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
drop Int
k [Bool]
w [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
k Bool
False
      where k :: Int
k = [Bool] -> [Bool] -> Int
shiftAmount' [Bool]
w [Bool]
n

shiftR' :: [Bool] -> [Bool] -> [Bool]
shiftR' :: [Bool] -> [Bool] -> [Bool]
shiftR' [Bool]
w [Bool]
n = Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
k Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- Int
k) [Bool]
w
      where k :: Int
k = [Bool] -> [Bool] -> Int
shiftAmount' [Bool]
w [Bool]
n

arithShiftR' :: [Bool] -> [Bool] -> [Bool]
arithShiftR' :: [Bool] -> [Bool] -> [Bool]
arithShiftR' [] [Bool]
_ = []
arithShiftR' [Bool]
w [Bool]
n  = Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
k ([Bool] -> Bool
msBit' [Bool]
w) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- Int
k) [Bool]
w
      where k :: Int
k = [Bool] -> [Bool] -> Int
shiftAmount' [Bool]
w [Bool]
n

-- | For (Unsigned!) comparison:
--   we assume that the input words are the same length
--   so we can use (lexicographic) ordering as defined on lists
--   so we need a function pad the shorter word
padMax' :: [Bool] -> [Bool] -> ([Bool],[Bool])
padMax' :: [Bool] -> [Bool] -> ([Bool], [Bool])
padMax' [Bool]
v [Bool]
w =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
v) ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w) of
       Ordering
EQ -> ([Bool]
v,[Bool]
w)
       Ordering
LT -> (Int -> [Bool] -> [Bool]
pad' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
v) [Bool]
v , [Bool]
w)
       Ordering
GT -> ([Bool]
v, Int -> [Bool] -> [Bool]
pad' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
v Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.- [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w) [Bool]
w)

-- | Modular exponentiation by squaring over the exponent's bits, so wide
--   dynamic exponents evaluate in O(width) multiplies instead of
--   O(value) (the result cycles mod 2^(length w) regardless).
power' :: [Bool] -> [Bool] -> [Bool]
power' :: [Bool] -> [Bool] -> [Bool]
power' [Bool]
w [Bool]
n = Int -> Integer -> [Bool]
intToBits' Int
l (Integer -> Integer -> [Bool] -> Integer
go Integer
1 ([Bool] -> Integer
bitsToInteger' [Bool]
w Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m) ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse [Bool]
n))
      where l :: Int
l = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
w
            m :: Integer
m = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
l
            go :: Integer -> Integer -> [Bool] -> Integer
            go :: Integer -> Integer -> [Bool] -> Integer
go Integer
acc Integer
_ []        = Integer
acc
            go Integer
acc Integer
sq (Bool
b : [Bool]
bs) = Integer -> Integer -> [Bool] -> Integer
go (if Bool
b then Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.* Integer
sq Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m else Integer
acc) (Integer
sq Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.* Integer
sq Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m) [Bool]
bs


-- | assumed positive inputs, n = dividend, d = divisor
--   b is s.t. d \<\< b \<= n , d \<\< b+1 > n
--   returns (quotient,remainder)
nonrestoringDivide' :: [Bool] -> [Bool] -> [Bool] -> ([Bool],[Bool])
nonrestoringDivide' :: [Bool] -> [Bool] -> [Bool] -> ([Bool], [Bool])
nonrestoringDivide' [Bool]
n [Bool]
d [Bool]
b =
   let rq :: [Bool]
rq = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
n
       b' :: [Bool]
b' = [Bool] -> [Bool] -> [Bool]
plus' (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
b) (Int -> [Bool] -> [Bool]
resize' (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.+ [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
b) [Bool]
one')
       shiftd :: [Bool]
shiftd = [Bool] -> [Bool] -> [Bool]
shiftL' (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
rq) [Bool]
d) [Bool]
b
       rq' :: [Bool]
rq' = [Bool] -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
iter' [Bool]
b' ([Bool] -> [Bool] -> [Bool]
loopbody [Bool]
shiftd) [Bool]
rq in
        (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
toInt' [Bool]
b') [Bool]
rq'
        ,[Bool] -> [Bool] -> [Bool]
shiftR' [Bool]
rq' [Bool]
b')
    where
      loopbody :: [Bool] -> [Bool] -> [Bool]
      loopbody :: [Bool] -> [Bool] -> [Bool]
loopbody [Bool]
shiftd [Bool]
rq =
        if [Bool]
shiftd [Bool] -> [Bool] -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> [Bool]
rq
          then [Bool] -> [Bool] -> [Bool]
shiftL' [Bool]
rq [Bool]
one'
          else [Bool] -> [Bool] -> [Bool]
bitwiseOr' (Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
rq) [Bool]
one') ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool] -> [Bool]
shiftL' ([Bool] -> [Bool] -> [Bool]
minus' [Bool]
rq [Bool]
shiftd) [Bool]
one'

-- | assumes n and d are the same length and n >= d
divCounter' :: [Bool] -> [Bool] -> Int
divCounter' :: [Bool] -> [Bool] -> Int
divCounter' [Bool]
n [Bool]
d =
  if [Bool]
n [Bool] -> [Bool] -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.< [Bool]
d
    then -Int
1
    else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
Prelude.+ [Bool] -> [Bool] -> Int
divCounter' [Bool]
n ([Bool] -> [Bool] -> [Bool]
shiftL' [Bool]
d [Bool]
one')

-- | assumes the same length inputs
divide' :: [Bool] -> [Bool] -> [Bool]
divide' :: [Bool] -> [Bool] -> [Bool]
divide' [Bool]
n [Bool]
d = Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
n) ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Integer -> [Bool]
int2bits' (Integer -> [Bool]) -> Integer -> [Bool]
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Bool] -> Int
toInt' [Bool]
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [Bool] -> Int
toInt' [Bool]
d

{- PREFERRED DIVIDE IMPLEMENTATION (long division); but broken for now
divide' n d = resize' (length n) $ fst $ nonrestoringDivide' n d b
  where
  b = lit' $ toInteger $ divCounter' (False:n) (False:d)  -- start positive unsigned
-}

-- | assumes the same length inputs
mod' :: [Bool] -> [Bool] -> [Bool]
mod' :: [Bool] -> [Bool] -> [Bool]
mod' [Bool]
n [Bool]
d = Int -> [Bool] -> [Bool]
resize' ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
n) ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ ([Bool], [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd (([Bool], [Bool]) -> [Bool]) -> ([Bool], [Bool]) -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool] -> [Bool] -> ([Bool], [Bool])
nonrestoringDivide' [Bool]
n [Bool]
d [Bool]
b
  where
  b :: [Bool]
b = Integer -> [Bool]
lit' (Integer -> [Bool]) -> Integer -> [Bool]
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool] -> Int
divCounter' (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
n) (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
d)

---------------------------
-- Showing BitWords
---------------------------

fours :: a -> [a] -> [(a,a,a,a)]
fours :: forall a. a -> [a] -> [(a, a, a, a)]
fours a
_ []                       = []
fours a
d (a
x1 : a
x2 : a
x3 : a
x4 : [a]
xs) = (a
x4 , a
x3 , a
x2 , a
x1) (a, a, a, a) -> [(a, a, a, a)] -> [(a, a, a, a)]
forall a. a -> [a] -> [a]
: a -> [a] -> [(a, a, a, a)]
forall a. a -> [a] -> [(a, a, a, a)]
fours a
d [a]
xs
fours a
d [a
x1,a
x2,a
x3]      = [(a
d , a
x3 , a
x2 , a
x1)]
fours a
d [a
x1,a
x2]           = [(a
d , a
d , a
x2 , a
x1)]
fours a
d [a
x1]               = [(a
d , a
d , a
d , a
x1)]

toHex :: (Bool , Bool , Bool , Bool) -> Char
toHex :: (Bool, Bool, Bool, Bool) -> Char
toHex (Bool
False , Bool
False , Bool
False , Bool
False) = Char
'0'
toHex (Bool
False , Bool
False , Bool
False , Bool
True) = Char
'1'
toHex (Bool
False , Bool
False , Bool
True , Bool
False) = Char
'2'
toHex (Bool
False , Bool
False , Bool
True , Bool
True) = Char
'3'
toHex (Bool
False , Bool
True , Bool
False , Bool
False) = Char
'4'
toHex (Bool
False , Bool
True , Bool
False , Bool
True) = Char
'5'
toHex (Bool
False , Bool
True , Bool
True , Bool
False) = Char
'6'
toHex (Bool
False , Bool
True , Bool
True , Bool
True) = Char
'7'
toHex (Bool
True , Bool
False , Bool
False , Bool
False) = Char
'8'
toHex (Bool
True , Bool
False , Bool
False , Bool
True) = Char
'9'
toHex (Bool
True , Bool
False , Bool
True , Bool
False) = Char
'a'
toHex (Bool
True , Bool
False , Bool
True , Bool
True) = Char
'b'
toHex (Bool
True , Bool
True , Bool
False , Bool
False) = Char
'c'
toHex (Bool
True , Bool
True , Bool
False , Bool
True) = Char
'd'
toHex (Bool
True , Bool
True , Bool
True , Bool
False) = Char
'e'
toHex (Bool
True , Bool
True , Bool
True , Bool
True) = Char
'f'

toBin :: Bool -> Char
toBin :: Bool -> Char
toBin Bool
False = Char
'0'
toBin Bool
True = Char
'1'

hexify :: [Bool] -> String
hexify :: [Bool] -> [Char]
hexify [Bool]
bits = [Char]
"0x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ((Bool, Bool, Bool, Bool) -> Char)
-> [(Bool, Bool, Bool, Bool)] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Bool, Bool, Bool) -> Char
toHex ([(Bool, Bool, Bool, Bool)] -> [(Bool, Bool, Bool, Bool)]
forall a. [a] -> [a]
reverse (Bool -> [Bool] -> [(Bool, Bool, Bool, Bool)]
forall a. a -> [a] -> [(a, a, a, a)]
fours Bool
False ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse [Bool]
bits)))

binify :: [Bool] -> String
binify :: [Bool] -> [Char]
binify [Bool]
bits = [Char]
"0b" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Bool -> Char) -> [Bool] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Char
toBin ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse [Bool]
bits)