bv-little 1.0.0 → 1.0.1

raw patch · 4 files changed

+92/−35 lines, 4 filesdep ~basedep ~semigroupsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, semigroups

API changes (from Hackage documentation)

Files

• bv-little.cabal +8/−7
• changelog.md +7/−0
• src/Data/BitVector/LittleEndian.hs +57/−13
• test/TestSuite.hs +20/−15

@@ -1,5 +1,5 @@ name:                bv-little-version:             1.0.0+version:             1.0.1 synopsis:            Efficient little-endian bit vector library category:            Data, Bit Vectors license:             BSD3@@ -20,7 +20,8 @@ build-type:          Simple cabal-version:       >= 1.22 -tested-with:         GHC == 8.6.2+tested-with:         GHC == 8.8.1+                     GHC == 8.6.5                      GHC == 8.4.4                      GHC == 8.2.2                      GHC == 8.0.2@@ -50,7 +51,7 @@    if !impl(ghc >= 8.0) -    build-depends:    semigroups+    build-depends:    semigroups       >= 0.18  && < 0.19    default-language: Haskell2010 @@ -103,7 +104,7 @@    main-is:          TestSuite.hs -  build-depends:      base             >= 4.5.1 && < 4.13+  build-depends:      base             >= 4.5.1 && < 5                     , bv-little                     , deepseq                     , hashable@@ -119,7 +120,7 @@    if !impl(ghc >= 8.0) -    build-depends:    semigroups+    build-depends:    semigroups       >= 0.18  && < 0.19                     , transformers    default-language: Haskell2010@@ -138,7 +139,7 @@    main-is:          Benchmarks.hs -  build-depends:      base             >= 4.5.1 && < 4.13+  build-depends:      base             >= 4.5.1 && < 5                     , bv-little                     , criterion                     , deepseq@@ -149,7 +150,7 @@    if !impl(ghc >= 8.0) -    build-depends:    semigroups+    build-depends:    semigroups       >= 0.18  && < 0.19    default-language: Haskell2010 

@@ -2,7 +2,13 @@    * None +### [v1.0.1][4] +  * Correcting Eq instance to test for value equality and not construction equality++  * Updated unit tests do not fail when the antecedent of logical implication cannot be satisfied++ ### [v1.0.0][3]    * Added explicit recursion to monomorphic folds to improve time and space performance@@ -65,3 +71,4 @@ [1]: https://github.com/recursion-ninja/bv-little/tree/v0.1.1 [2]: https://github.com/recursion-ninja/bv-little/tree/v0.1.2 [3]: https://github.com/recursion-ninja/bv-little/tree/v1.0.0+[4]: https://github.com/recursion-ninja/bv-little/tree/v1.0.1

@@ -87,7 +87,7 @@ import GHC.Integer.GMP.Internals import GHC.Integer.Logarithms import GHC.Natural-import Test.QuickCheck           (Arbitrary(..), CoArbitrary(..), NonNegative(..), suchThat, variant)+import Test.QuickCheck           (Arbitrary(..), CoArbitrary(..), NonNegative(..), choose, suchThat, variant) import TextShow                  (TextShow(showb))  @@ -117,13 +117,52 @@ -- @since 0.1.0 instance Arbitrary BitVector where +    -- Arbitrary instance distribution weighting:+    --  -  2% = (maxBound :: Word)+    --  -  2% = (maxBound :: Word) + 1+    --  -  8% = all bits on+    --  -  8% = all bits off+    --  - 80% = any bit configuration     arbitrary = do-        dimVal <- getNonNegative <$> arbitrary-        let upperBound = shiftL 1 dimVal-        intVal <- (getNonNegative <$> arbitrary) `suchThat` (< upperBound)-        pure . BV (toEnum dimVal) $ intToNat intVal+        -- 1/25 chance of generating the boundary value at which the natural number+        -- must use different Natural constructors: NatS# & NatJ# +        n <- choose (0, 25 :: Word)+        case n of+          0 -> boundaryValue+          1 -> allBitsOn+          2 -> allBitsOn+          3 -> allBitsOff+          4 -> allBitsOff+          _ -> anyBitValue+      where+        allBitsOn     = genBitVector $ Just True+        allBitsOff    = genBitVector $ Just False+        anyBitValue   = genBitVector $ Nothing+        +        boundaryValue = do+            let wrdVal = maxBound :: Word+            let dimVal = toEnum $ popCount wrdVal+            let numVal = wordToNatural wrdVal+            -- 50/50 change to generate above or below the constructor boundary+            underBoundary <- arbitrary+            let (lowerBound, naturalVal)+                  | underBoundary = (dimVal    , numVal    )+                  | otherwise     = (dimVal + 1, numVal + 1)+            widthVal <- (getNonNegative <$> arbitrary) `suchThat` (>= lowerBound)+            pure $ BV widthVal naturalVal +        genBitVector spec = do+            dimVal <- getNonNegative <$> arbitrary +            let upperBound = shiftL 1 dimVal+            -- 1/5 chance all bits on or all bits off+            natVal <- case spec of+                        Just False -> pure $ intToNat 0+                        Just True  -> pure . intToNat $ upperBound - 1+                        Nothing    -> fmap intToNat $+                                        (getNonNegative <$> arbitrary) `suchThat` (< upperBound)+            pure $ BV (toEnum dimVal) natVal + -- | -- @since 0.1.0 instance Bits BitVector where@@ -156,12 +195,12 @@             !mask    = bit i `xor` allBits         in  BV w $ n .&. mask -{-     {-# INLINE setBit #-}     setBit bv@(BV w n) i-      | i < 0 || i >= w = bv-      | otherwise       = BV w $ n `setBit` i--}+      | i < 0 = bv+      | otherwise = BV (max w j) $ n `setBit` i+      where+        !j = toEnum i + 1      {-# INLINE testBit #-}     testBit (BV w n) i = i >= 0 && toEnum i < w && n `testBit` i@@ -238,7 +277,10 @@ instance Eq BitVector where      {-# INLINE (==) #-}-    (==) (BV w1 m) (BV w2 n) = w1 == w2 && m == n+    (==) (BV w1 m) (BV w2 n) = w1 == w2 && naturalToBigNat m == naturalToBigNat n+      where+        naturalToBigNat (NatS# w ) = wordToBigNat w+        naturalToBigNat (NatJ# bn) = bn   -- |@@ -1112,7 +1154,9 @@ -- this function does not throw an exception when an negative valued 'Integer' -- is supplied and is also compatible with base < 4.10.0.0. {-# INLINE intToNat #-}+-- {-# NOINLINE intToNat #-} intToNat :: Integer -> Natural-intToNat (S# i#) | I# i# >= 0  = NatS# (int2Word# i#)-intToNat (Jp# bn)              = NatJ# bn-intToNat _                     = NatS# (int2Word# 0#)+intToNat (S#  i#) | isTrue# (i# >=# 0#)               = NatS# (int2Word# i#)+intToNat (Jp# bn) | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)+                  | otherwise                         = NatJ# bn+intToNat _                                            = NatS# (int2Word# 0#)

@@ -32,6 +32,11 @@ import           TextShow (TextShow(showb), toString)  +infix 0 -=>+(-=>) :: QC.Testable p => Bool -> p -> Property +(-=>) p q = not p .||. q++ main :: IO () main = defaultMain testSuite @@ -109,7 +114,7 @@      clearBitDefinition :: NonNegative Int -> BitVector -> Property     clearBitDefinition (NonNegative i) bv =-        i < (fromEnum . dimension) bv ==>+        i < (fromEnum . dimension) bv -=>           (bv `clearBit` i === bv .&. complement  (zed .|. bit i))       where         zed = fromNumber (dimension bv) (0 :: Integer)@@ -208,12 +213,12 @@ hashableTests :: TestTree hashableTests = testGroup "Properties of Hashable"     [ localOption (QuickCheckTests 10000)-        $ QC.testProperty "a == b ==> (hashWithSalt a) === (hashWithSalt b)" differentSaltsDifferentHashes+        $ QC.testProperty "a == b -=> (hashWithSalt a) === (hashWithSalt b)" differentSaltsDifferentHashes     ]   where     differentSaltsDifferentHashes :: BitVector -> Int -> Int -> Property     differentSaltsDifferentHashes bv salt1 salt2 =-        salt1 /= salt2 ==> hashWithSalt salt1 bv /= hashWithSalt salt2 bv+        salt1 /= salt2 -=> hashWithSalt salt1 bv /= hashWithSalt salt2 bv    @@ -299,13 +304,13 @@     testFoldr1 :: BinaryLogicalOperator -> BitVector -> Property --    testFoldr1 (Blind f) bv =     testFoldr1 x bv =-        (not . onull) bv  ==> ofoldr1Ex f bv === (foldr1 f . otoList) bv+        (not . onull) bv  -=> ofoldr1Ex f bv === (foldr1 f . otoList) bv       where         f = getBinaryLogicalOperator x      testFoldl1 :: Blind (Bool -> Bool -> Bool) -> BitVector -> Property     testFoldl1 (Blind f) bv =-        (not . onull) bv  ==> ofoldl1Ex' f bv === (foldl1 f . otoList) bv+        (not . onull) bv  -=> ofoldl1Ex' f bv === (foldl1 f . otoList) bv      testAll :: Blind (Bool -> Bool) -> BitVector -> Property     testAll (Blind f) bv =@@ -325,11 +330,11 @@      testHead :: BitVector -> Property     testHead bv =-        (not . onull) bv ==> headEx bv === (getFirst . ofoldMap1Ex First) bv+        (not . onull) bv -=> headEx bv === (getFirst . ofoldMap1Ex First) bv      testTail :: BitVector -> Property     testTail bv =-        (not . onull) bv ==> lastEx bv === (getLast . ofoldMap1Ex Last) bv+        (not . onull) bv -=> lastEx bv === (getLast . ofoldMap1Ex Last) bv      testInclusionConsistency :: (Bool, BitVector) -> Property     testInclusionConsistency (e, bv) =@@ -526,8 +531,8 @@     transitivity :: BitVector -> BitVector -> BitVector -> Property     transitivity a b c = caseOne .||. caseTwo       where-        caseOne = (a <= b && b <= c) ==> a <= c-        caseTwo = (a >= b && b >= c) ==> a >= c+        caseOne = (a <= b && b <= c) -=> a <= c+        caseTwo = (a >= b && b >= c) -=> a >= c   semigroupProperties :: TestTree@@ -589,12 +594,12 @@     ,    testCase     "isZeroVector zeroBits" zeroBitsIsZeroVector     , QC.testProperty "isZeroVector === (0 ==) . popCount" popCountAndZeroVector     , QC.testProperty "isZeroVector === all not . toBits" zeroVectorAndAllBitsOff-    , QC.testProperty "(0 ==) . toUnsignedNumber ==> isZeroVector" toUnsignedNumImpliesZeroVector+    , QC.testProperty "(0 ==) . toUnsignedNumber -=> isZeroVector" toUnsignedNumImpliesZeroVector     , QC.testProperty "toSignedNumber . fromNumber === id" bitVectorUnsignedNumIdentity     , QC.testProperty "isSigned == const False" noSignBitVector -- For an unknown reason, this test case causes GHC to panic!---    , QC.testProperty "i >  j ==> subRange (i,j) === const zeroBits" badSubRangeEmptyResult-    , QC.testProperty "i <= j ==> dimension . subRange (i,j) === const (j - i + 1)" subRangeFixedDimension+--    , QC.testProperty "i >  j -=> subRange (i,j) === const zeroBits" badSubRangeEmptyResult+    , QC.testProperty "i <= j -=> dimension . subRange (i,j) === const (j - i + 1)" subRangeFixedDimension     ]   where     otoListTest :: BitVector -> Property@@ -627,7 +632,7 @@      toUnsignedNumImpliesZeroVector :: BitVector -> Property     toUnsignedNumImpliesZeroVector bv =-        ((0 ==) . (toUnsignedNumber :: BitVector -> Integer)) bv ==> isZeroVector bv+        ((0 ==) . (toUnsignedNumber :: BitVector -> Integer)) bv -=> isZeroVector bv      bitVectorUnsignedNumIdentity :: Integer -> Property     bitVectorUnsignedNumIdentity num =@@ -641,11 +646,11 @@      badSubRangeEmptyResult :: (Word, Word) -> BitVector -> Property     badSubRangeEmptyResult range@(lower, upper) bv =-        lower > upper ==> subRange range bv === zeroBits+        lower > upper -=> subRange range bv === zeroBits      subRangeFixedDimension :: (NonNegative Int, NonNegative Int) -> BitVector -> Property     subRangeFixedDimension (NonNegative lowerI, NonNegative upperI) bv =-        lower <= upper ==> dimension (subRange (lower, upper) bv) === upper - lower + 1+        lower <= upper -=> dimension (subRange (lower, upper) bv) === upper - lower + 1       where         lower = toEnum lowerI         upper = toEnum upperI