module Lava.Binary where
import Char
binToNat :: Integral a => [Bool] -> a
binToNat [] = 0
binToNat (x:xs) = 2 * binToNat xs + if x then 1 else 0
natToBin :: Integral a => a -> [Bool]
natToBin 0 = []
natToBin n = odd n : natToBin (n `div` 2)
binToHex :: [Bool] -> String
binToHex [] = ""
binToHex xs = hexit (binToNat (take 4 xs)) : binToHex (drop 4 xs)
where hexit n = if n <= 9 then chr (ord '0' + fromIntegral n)
else chr (ord 'A' + fromIntegral n 10)
natToHex :: Integral a => a -> String
natToHex = reverse . binToHex . natToBin
hex :: Integral a => Int -> a -> String
hex w n = replicate (w length s) '0' ++ s
where s = natToHex n
ext :: Int -> a -> [a] -> [a]
ext w x xs = take w (xs ++ repeat x)
natToSizedBin :: Integral a => a -> Int -> [Bool]
natToSizedBin n s = ext s False (natToBin n)
twosComplement :: [Bool] -> [Bool]
twosComplement = boolAdd True . map not
boolAdd :: Bool -> [Bool] -> [Bool]
boolAdd a [] = []
boolAdd a (b:bs) = (a /= b) : boolAdd (a && b) bs
intToBin :: Integral a => a -> [Bool]
intToBin n
| n >= 0 = natToBin n
| otherwise = twosComplement $ natToBin $ abs n
intToSizedBin :: Integral a => a -> Int -> [Bool]
intToSizedBin n s = ext s (n < 0) (intToBin n)
binToInt :: Integral a => [Bool] -> a
binToInt bs
| last bs = negate $ binToNat $ twosComplement bs
| otherwise = binToNat bs
log2 :: Integral a => a -> a
log2 n = if n == 1 then 0 else 1 + log2 (n `div` 2)
rol :: [a] -> Int -> [a]
rol xs n = drop n xs ++ take n xs
ror :: [a] -> Int -> [a]
ror xs n = reverse $ (`rol` n) $ reverse xs