data-bword 0.1 → 0.1.0.1

raw patch · 3 files changed

+72/−7 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• data-bword.cabal +1/−1
• src/Data/BinaryWord.hs +31/−3
• tests/Tests.hs +40/−3

@@ -1,5 +1,5 @@ Name: data-bword-Version: 0.1+Version: 0.1.0.1 Category: Data Stability: experimental Synopsis: Extra operations on binary words of fixed length

@@ -20,7 +20,7 @@ import Data.Word import Data.Bits (Bits(..)) #if MIN_VERSION_base(4,7,0)-import Data.Bits (FiniteBits)+import Data.Bits (FiniteBits(..)) #endif #if __GLASGOW_HASKELL__ >= 705 import GHC.Prim (plusWord2#, timesWord2#)@@ -109,6 +109,12 @@           lo = fromIntegral p           hi = fromIntegral (shiftR p 8)   {-# INLINE unwrappedMul #-}+#if MIN_VERSION_base(4,8,0)+  leadingZeroes = countLeadingZeros+  {-# INLINE leadingZeroes #-}+  trailingZeroes = countTrailingZeros+  {-# INLINE trailingZeroes #-}+#else   leadingZeroes w | w .&. 0xF0 == 0 = go4 4 w                   | otherwise       = go4 0 (shiftR w 4)     where go4 off w' | w' .&. 8 /= 0 = off@@ -123,6 +129,7 @@                      | w' .&. 4 /= 0 = off + 2                      | w' .&. 8 /= 0 = off + 3                      | otherwise     = off + 4+#endif   allZeroes = 0   {-# INLINE allZeroes #-}   allOnes = 0xFF@@ -155,6 +162,12 @@           lo = fromIntegral p           hi = fromIntegral (shiftR p 16)   {-# INLINE unwrappedMul #-}+#if MIN_VERSION_base(4,8,0)+  leadingZeroes = countLeadingZeros+  {-# INLINE leadingZeroes #-}+  trailingZeroes = countTrailingZeros+  {-# INLINE trailingZeroes #-}+#else   leadingZeroes w | w .&. 0xFF00 == 0 = go8 8 w                   | otherwise         = go8 0 (shiftR w 8)     where@@ -175,6 +188,7 @@                  | w' .&. 4 /= 0    = off + 2                  | w' .&. 8 /= 0    = off + 3                  | otherwise        = off + 4+#endif   allZeroes = 0   {-# INLINE allZeroes #-}   allOnes = 0xFFFF@@ -221,6 +235,12 @@           hi = fromIntegral (shiftR p 32) #endif   {-# INLINE unwrappedMul #-}+#if MIN_VERSION_base(4,8,0)+  leadingZeroes = countLeadingZeros+  {-# INLINE leadingZeroes #-}+  trailingZeroes = countTrailingZeros+  {-# INLINE trailingZeroes #-}+#else   leadingZeroes w | w .&. 0xFFFF0000 == 0 = go16 16 w                   | otherwise             = go16 0 (shiftR w 16)     where@@ -245,6 +265,7 @@                   | w' .&. 4 /= 0      = off + 2                   | w' .&. 8 /= 0      = off + 3                   | otherwise          = off + 4+#endif   allZeroes = 0   {-# INLINE allZeroes #-}   allOnes = 0xFFFFFFFF@@ -301,7 +322,13 @@           (uHi1, uLo) = unwrappedAdd (fromIntegral p1) (fromIntegral p2)           (uHi2, lo') = unwrappedAdd (fromIntegral (shiftR lo0 32)) uLo #endif-#if WORD_SIZE_IN_BITS == 64+#if MIN_VERSION_base(4,8,0)+  leadingZeroes = countLeadingZeros+  {-# INLINE leadingZeroes #-}+  trailingZeroes = countTrailingZeros+  {-# INLINE trailingZeroes #-}+#else+# if WORD_SIZE_IN_BITS == 64   leadingZeroes w | w .&. 0xFFFFFFFF00000000 == 0 = go32 32 w                   | otherwise                     = go32 0 (shiftR w 32)     where@@ -330,7 +357,7 @@                   | w' .&. 4 /= 0          = off + 2                   | w' .&. 8 /= 0          = off + 3                   | otherwise              = off + 4-#else+# else   leadingZeroes w | hiZeroes == 32 = 32 + leadingZeroes lo                   | otherwise      = hiZeroes     where lo = fromIntegral w ∷ Word32@@ -341,6 +368,7 @@     where lo = fromIntegral w ∷ Word32           hi = fromIntegral (shiftR w 32) ∷ Word32           loZeroes = trailingZeroes lo+# endif #endif   allZeroes = 0   {-# INLINE allZeroes #-}

@@ -1,10 +1,14 @@ {-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}  import Test.Tasty (TestName, TestTree, defaultMain, localOption, testGroup) import Test.Tasty.QuickCheck hiding ((.&.))  import Data.Bits (Bits(..))+#if MIN_VERSION_base(4,7,0)+import Data.Bits (FiniteBits(..))+#endif import Data.Int import Data.Word import Data.BinaryWord@@ -23,6 +27,11 @@          , binWordGroup "Int64" (0 ∷ Int64)          ] +#if !MIN_VERSION_base(4,7,0)+finiteBitSize ∷ Bits α ⇒ α → Int+finiteBitSize = bitSize+#endif+ sameType ∷ α → α → α sameType = const id @@ -30,13 +39,41 @@                 BinaryWord w) ⇒ TestName → w → TestTree binWordGroup n w = testGroup n   [ testProperty "allZeroes" $ popCount (sameType w allZeroes) == 0-  , testProperty "allOnes" $ popCount (sameType w allOnes) == bitSize w+  , testProperty "allOnes" $ popCount (sameType w allOnes) == finiteBitSize w+  , testProperty "msb" $+      let bs = finiteBitSize w in+        testBit (sameType w msb) (bs - 1) &&+        all (not . testBit (sameType w msb)) [0 .. bs - 2]+  , testProperty "lsb" $+      let bs = finiteBitSize w in+        testBit (sameType w lsb) 0 &&+        all (not . testBit (sameType w lsb)) [1 .. bs - 1]+  , testProperty "testMsb" $ \x →+      testMsb (sameType w x) == testBit x (finiteBitSize x - 1)+  , testProperty "testLsb" $ \x →+      testLsb (sameType w x) == testBit x 0+  , testProperty "leadingZeroes" $ \x →+      let lz = leadingZeroes (sameType w x)+          bs = finiteBitSize x in+        if lz == 0+        then testBit x (bs - 1)+        else if lz == bs+             then x == 0+             else shiftR x (bs - lz) == 0 && testBit x (bs - lz - 1)+  , testProperty "trailingZeroes" $ \x →+      let tz = trailingZeroes (sameType w x)+          bs = finiteBitSize x in+        if tz == 0+        then testBit x 0+        else if tz == bs+             then x == 0+             else shiftL x (bs - tz) == 0 && testBit x tz   , testProperty "unwrappedAdd" $ \w₁ w₂ →       let (h, l) = unwrappedAdd (sameType w w₁) w₂ in-        toInteger h * 2 ^ bitSize w + toInteger l ==+        toInteger h * 2 ^ finiteBitSize w + toInteger l ==           toInteger w₁ + toInteger w₂   , testProperty "unwrappedMul" $ \w₁ w₂ →       let (h, l) = unwrappedMul (sameType w w₁) w₂ in-        toInteger h * 2 ^ bitSize w + toInteger l ==+        toInteger h * 2 ^ finiteBitSize w + toInteger l ==           toInteger w₁ * toInteger w₂   ]