Bits.hs

-- | Gray code is a binary numeral system where two successive numbers
-- differ in only one bit.
--
-- This module provides an interface to encode/decode @'Bits'@ types.
--
-- Algorithm:
--   Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms,
--   Second ed. (2004),  5.4. Gray Codes.
module Codec.Binary.Gray.Bits
    ( gray
    , binary
    , showBits
    ) where

import Data.Bits
    ( Bits, testBit, setBit, clearBit, bitSize
    , shiftL, shiftR, complement, xor, (.&.), (.|.), isSigned)

import qualified Codec.Binary.Gray.List as L

-- | Right shift without extension of the sign bit (reset it to zero).
shiftR' :: (Bits a, Num a) => a -> Int -> a
shiftR' n 0    = n
shiftR' n s
  | isSigned n && signum n == -1 =
      let n' = clearBit (shiftR n 1) (bitSize n - 1)
      in  shiftR' n' (s-1)
  | otherwise  = shiftR n s

-- | Convert an integer number from binary to Gray code.
--
-- 'gray' is undefined for negative numbers of types that do not have
-- fixed bitsize, e.g. for negative 'Integer's.
gray :: (Bits a, Num a) => a -> a
gray n = n `xor` (shiftR' n 1)

-- | Convert an integer number from Gray code to binary.
--
-- 'binary' is undefined for types that do not have fixed bitsize,
-- e.g. for 'Integer'.
binary :: (Bits a, Num a) => a -> a
binary 0 = 0
binary n =
  binary' mask0 n (copyMSB n)
  where
    sz = bitSize n - 1
    mask0 = let m = setBit 0 sz in  (m, m)
    copyMSB n = (setBit 0 sz) .&. n

binary' (maskReady, maskLast) ngray nbin
  | complement maskReady == 0 = nbin
  | otherwise =
     let
       sz = bitSize ngray - 1
       nReady = maskReady .&. nbin
       maskReady' = setBit (shiftR maskReady 1) sz
       maskLast' = shiftR' maskLast 1
       nNext = (shiftR' (maskLast .&. nReady) 1) `xor` (maskLast' .&. ngray)
     in
       binary' (maskReady', maskLast') ngray (nReady .|. nNext)

-- | Render binary code as a string of @0@s and @1@s.
-- For example, @(42::Int8)@ is formatted as @101010@.
showBits :: (Bits a, Num a) => a -> String
showBits = L.showBits . L.toList