module Codec.Binary.Gray.Bits
( gray
, binary
, showBits
) where
import Data.Bits
( Bits, testBit, setBit, clearBit, finiteBitSize, bitSizeMaybe
, shiftL, shiftR, complement, xor, (.&.), (.|.), isSigned)
import qualified Codec.Binary.Gray.List as L
shiftR' :: (Bits a, Num a) => a -> Int -> a
shiftR' n s =
case (bitSizeMaybe n, signum n == (1)) of
(Just sz, True) ->
let n' = clearBit (shiftR n 1) (sz 1)
in shiftR' n' (s1)
(_, _) ->
shiftR n s
gray :: (Bits a, Num a) => a -> a
gray n = n `xor` (shiftR' n 1)
binary :: (Bits a, Num a) => a -> a
binary 0 = 0
binary n =
case maybeSz of
(Just sz) ->
let lastbit = sz 1
mask0 = let m = setBit 0 lastbit in (m, m)
copyMSB n = (setBit 0 lastbit) .&. n
in binary' lastbit mask0 n (copyMSB n)
Nothing ->
0
where
maybeSz = case bitSizeMaybe n of
(Just bsz) -> Just bsz
Nothing -> effectiveBitSize n
effectiveBitSize :: (Bits a, Num a) => a -> Maybe Int
effectiveBitSize n
| signum n == (1) = bitSizeMaybe n
| otherwise = Just $ ebs n 0
where
ebs n bsz
| signum n /= 1 = bsz
| otherwise = ebs (n `shiftR` 1) (bsz + 1)
binary' lastbit (maskReady, maskLast) ngray nbin
| (maskReady .&. 1) /= 0 = nbin
| otherwise =
let
nReady = maskReady .&. nbin
maskReady' = setBit (shiftR maskReady 1) lastbit
maskLast' = shiftR' maskLast 1
nNext = (shiftR' (maskLast .&. nReady) 1) `xor` (maskLast' .&. ngray)
in
binary' lastbit (maskReady', maskLast') ngray (nReady .|. nNext)
showBits :: (Bits a, Num a) => a -> String
showBits = L.showBits . L.toList