Commits

Sergey Astanin committed e2334d9

revert API to support all Bits types (non-negative Integer inclusive)

  • Participants
  • Parent commits acb7605

Comments (0)

Files changed (4)

-  - 0.3: use only total functions on `FiniteBits`, requires GHC >= 7.8
-  - 0.2.2: build on GHC 7.6, integrate tests with cabal build
-  - 0.2.1: `toList'` function
-  - 0.2: split `C.B.G.Bits` and `C.B.G.List` APIs
-  - 0.1: initial Hackage release
+0.3.1: revert API to be backwards compatible with 0.2.2, requires GHC >= 7.8
+0.3: DON'T USE THIS VERSION. rely on total functions on `FiniteBits`, requires GHC >= 7.8
+0.2.2: build on GHC 7.6, integrate tests with cabal build
+0.2.1: `toList'` function
+0.2: split `C.B.G.Bits` and `C.B.G.List` APIs
+0.1: initial Hackage release

File Codec/Binary/Gray/Bits.hs

     ) where
 
 import Data.Bits
-    ( FiniteBits, testBit, setBit, clearBit, finiteBitSize
+    ( Bits, testBit, setBit, clearBit, finiteBitSize, bitSizeMaybe
     , 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' :: (FiniteBits a, Num a) => a -> Int -> a
-shiftR' n 0    = n
-shiftR' n s
-  | isSigned n && signum n == -1 =
-      let n' = clearBit (shiftR n 1) (finiteBitSize n - 1)
-      in  shiftR' n' (s-1)
-  | otherwise  = shiftR n s
+--
+-- Results on negative values of unbounded integral types (like 'Integer') may be wrong.
+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' (s-1)
+    (_, _) ->
+        shiftR n s
+
 
 -- | Convert an integer number from binary to Gray code.
-gray :: (FiniteBits a, Num a) => a -> a
+--
+-- Results on negative values of unbounded integral types (like 'Integer') may be wrong.
+gray :: (Bits a, Num a) => a -> a
 gray n = n `xor` (shiftR' n 1)
 
 -- | Convert an integer number from Gray code to binary.
-binary :: (FiniteBits a, Num a) => a -> a
+--
+-- Results on negative values of unbounded integral types (like 'Integer') may be wrong.
+binary :: (Bits a, Num a) => a -> a
 binary 0 = 0
 binary n =
-  binary' mask0 n (copyMSB 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 ->  -- unbounded and negative
+          0
   where
-    sz = finiteBitSize n - 1
-    mask0 = let m = setBit 0 sz in  (m, m)
-    copyMSB n = (setBit 0 sz) .&. n
+    maybeSz = case bitSizeMaybe n of
+                (Just bsz) -> Just bsz
+                Nothing -> effectiveBitSize n
 
-binary' (maskReady, maskLast) ngray nbin
-  | complement maskReady == 0 = nbin
+
+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
-       sz = finiteBitSize ngray - 1
        nReady = maskReady .&. nbin
-       maskReady' = setBit (shiftR maskReady 1) sz
+       maskReady' = setBit (shiftR maskReady 1) lastbit
        maskLast' = shiftR' maskLast 1
        nNext = (shiftR' (maskLast .&. nReady) 1) `xor` (maskLast' .&. ngray)
      in
-       binary' (maskReady', maskLast') ngray (nReady .|. nNext)
+       binary' lastbit (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 :: (FiniteBits a, Num a) => a -> String
+showBits :: (Bits a, Num a) => a -> String
 showBits = L.showBits . L.toList

File Codec/Binary/Gray_props.hs

   forAll (arbitrary :: Gen Word) $ \w ->
       (hammingBits `on` B.gray) w (w+1) == 1
 
+prop_bits_gray_succ_Integer = label "hamming x (x+1) == 1 [Integer]" $
+  forAll (arbitrary :: Gen (NonNegative Integer)) $ \(NonNegative i) ->
+      (hammingBits `on` B.gray) i (i+1) == 1
+
 hammingBits :: (Bits a, Num a) => a -> a -> Int
 hammingBits = hamming `on` L.toList
 

File gray-code.cabal

 -- The package version. See the Haskell package versioning policy
 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
 -- standards guiding when and how versions should be incremented.
-Version:             0.3
+Version:             0.3.1
 
 -- A short (one-line) description of the package.
 Synopsis:            Gray code encoder/decoder.