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' :: a -> Int -> a
shiftR' a
n Int
s =
case (a -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe a
n, a -> a
forall a. Num a => a -> a
signum a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (-a
1)) of
(Just Int
sz, Bool
True) ->
let n' :: a
n' = a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
1) (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
in a -> Int -> a
forall a. (Bits a, Num a) => a -> Int -> a
shiftR' a
n' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
(Maybe Int
_, Bool
_) ->
a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
s
gray :: (Bits a, Num a) => a -> a
gray :: a -> a
gray a
n = a
n a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (a -> Int -> a
forall a. (Bits a, Num a) => a -> Int -> a
shiftR' a
n Int
1)
binary :: (Bits a, Num a) => a -> a
binary :: a -> a
binary a
0 = a
0
binary a
n =
case Maybe Int
maybeSz of
(Just Int
sz) ->
let lastbit :: Int
lastbit = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
mask0 :: (a, a)
mask0 = let m :: a
m = a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
0 Int
lastbit in (a
m, a
m)
copyMSB :: a -> a
copyMSB a
n = (a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
0 Int
lastbit) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
n
in Int -> (a, a) -> a -> a -> a
forall t. (Bits t, Num t) => Int -> (t, t) -> t -> t -> t
binary' Int
lastbit (a, a)
mask0 a
n (a -> a
forall a. (Bits a, Num a) => a -> a
copyMSB a
n)
Maybe Int
Nothing ->
a
0
where
maybeSz :: Maybe Int
maybeSz = case a -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe a
n of
(Just Int
bsz) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bsz
Maybe Int
Nothing -> a -> Maybe Int
forall a. (Bits a, Num a) => a -> Maybe Int
effectiveBitSize a
n
effectiveBitSize :: (Bits a, Num a) => a -> Maybe Int
effectiveBitSize :: a -> Maybe Int
effectiveBitSize a
n
| a -> a
forall a. Num a => a -> a
signum a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (-a
1) = a -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe a
n
| Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ a -> Int -> Int
forall t t. (Bits t, Num t, Num t) => t -> t -> t
ebs a
n Int
0
where
ebs :: t -> t -> t
ebs t
n t
bsz
| t -> t
forall a. Num a => a -> a
signum t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
1 = t
bsz
| Bool
otherwise = t -> t -> t
ebs (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (t
bsz t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
binary' :: Int -> (t, t) -> t -> t -> t
binary' Int
lastbit (t
maskReady, t
maskLast) t
ngray t
nbin
| (t
maskReady t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
1) t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
0 = t
nbin
| Bool
otherwise =
let
nReady :: t
nReady = t
maskReady t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
nbin
maskReady' :: t
maskReady' = t -> Int -> t
forall a. Bits a => a -> Int -> a
setBit (t -> Int -> t
forall a. Bits a => a -> Int -> a
shiftR t
maskReady Int
1) Int
lastbit
maskLast' :: t
maskLast' = t -> Int -> t
forall a. (Bits a, Num a) => a -> Int -> a
shiftR' t
maskLast Int
1
nNext :: t
nNext = (t -> Int -> t
forall a. (Bits a, Num a) => a -> Int -> a
shiftR' (t
maskLast t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
nReady) Int
1) t -> t -> t
forall a. Bits a => a -> a -> a
`xor` (t
maskLast' t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
ngray)
in
Int -> (t, t) -> t -> t -> t
binary' Int
lastbit (t
maskReady', t
maskLast') t
ngray (t
nReady t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
nNext)
showBits :: (Bits a, Num a) => a -> String
showBits :: a -> String
showBits = [Bool] -> String
L.showBits ([Bool] -> String) -> (a -> [Bool]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Bool]
forall b. (Bits b, Num b) => b -> [Bool]
L.toList