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 +6/−5
- Codec/Binary/Gray/Bits.hs +45/−20
- Codec/Binary/Gray_props.hs +4/−0
- gray-code.cabal +1/−1
- test.hs +6/−4
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