packages feed

gray-code 0.3 → 0.3.1

raw patch · 5 files changed

+62/−30 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Codec.Binary.Gray.Bits: binary :: (FiniteBits a, Num a) => a -> a
+ Codec.Binary.Gray.Bits: binary :: (Bits a, Num a) => a -> a
- Codec.Binary.Gray.Bits: gray :: (FiniteBits a, Num a) => a -> a
+ Codec.Binary.Gray.Bits: gray :: (Bits a, Num a) => a -> a
- Codec.Binary.Gray.Bits: showBits :: (FiniteBits a, Num a) => a -> String
+ Codec.Binary.Gray.Bits: showBits :: (Bits a, Num a) => a -> String

Files

CHANGELOG view
@@ -1,5 +1,6 @@-  - 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
Codec/Binary/Gray/Bits.hs view
@@ -13,47 +13,72 @@     ) 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
Codec/Binary/Gray_props.hs view
@@ -84,6 +84,10 @@   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 
gray-code.cabal view
@@ -7,7 +7,7 @@ -- 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.
test.hs view
@@ -1,7 +1,8 @@ module Main where  import Control.Monad (unless)-import Test.QuickCheck.Test (verboseCheckResult, quickCheckResult, isSuccess)+import Test.QuickCheck.Test (verboseCheckWithResult, quickCheckWithResult+                            , Args(..), stdArgs, isSuccess) import System.Exit (exitFailure) import System.Environment (getArgs) @@ -9,10 +10,11 @@  main = do   args <- getArgs+  let qcArgs = stdArgs { maxSuccess = 10000 }   let testsResult = if (("-v" `elem` args) || ("--verbose" `elem` args))-                    then verboseCheckResult-                    else quickCheckResult-  result <- testsResult all_props+                    then verboseCheckWithResult+                    else quickCheckWithResult+  result <- testsResult qcArgs all_props   unless (isSuccess result) $ do          print result          exitFailure