bv-little 0.1.0.0 → 0.1.1
raw patch · 5 files changed
+259/−170 lines, 5 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- bench/Benchmarks.hs +61/−99
- bv-little.cabal +8/−6
- changelog.md +18/−1
- src/Data/BitVector/LittleEndian.hs +120/−64
- test/TestSuite.hs +52/−0
bench/Benchmarks.hs view
@@ -7,6 +7,7 @@ import Data.Bits import Data.BitVector.LittleEndian import Data.List (nubBy)+import Data.Hashable import Data.Semigroup @@ -15,11 +16,19 @@ benchmarks :: Benchmark benchmarks = bgroup "BitVector"- [ fromNumberBench+ [ toBitsBench+ , fromBitsBench+ , fromNumberBench+ , toSignedNumberBench+ , toUnsignedNumberBench+ , dimmensionBench , isZeroVectorBench , zeroPopCountBench+ , subRangeBench , bitsBench , finiteBitsBench+ , hashableBench+ , semigroupBench ] @@ -63,11 +72,39 @@ hugeNumber = 14142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605715 +toBitsBench :: Benchmark+toBitsBench = unaryBenchmark "toBitsNumber" toBits+++fromBitsBench :: Benchmark+fromBitsBench = constantNumberTimeBenchmark "fromBits" id g+ where+ g int n = let !bitCount = fromEnum $ logBase2Word int+ bitStream = force $ foldMap (\i -> [testBit n i]) [0 .. bitCount - 1]+ in fromBits bitStream++ fromNumberBench :: Benchmark fromNumberBench = constantNumberTimeBenchmark "fromNumber" id g where g int = let !bitCount = logBase2Word int in fromNumber bitCount+++toSignedNumberBench :: Benchmark+toSignedNumberBench = unaryBenchmark "toSignedNumber" (toSignedNumber :: BitVector -> Integer)+++toUnsignedNumberBench :: Benchmark+toUnsignedNumberBench = unaryBenchmark "toUnsignedNumber" (toUnsignedNumber :: BitVector -> Integer)+++dimmensionBench :: Benchmark+dimmensionBench = constantNumberTimeBenchmark "dimmension" id g+ where+ g int _ = let !bitCount = logBase2Word int+ !bitVector = fromNumber bitCount int+ in dimension bitVector isZeroVectorBench :: Benchmark@@ -86,6 +123,16 @@ in ((0==) . popCount) bitVector +subRangeBench :: Benchmark+subRangeBench = constantNumberTimeBenchmark "subRange" id g+ where+ g int _ = let !bitCount = logBase2Word int+ !bitVector = fromNumber bitCount int+ !lowerBound = bitCount `div` 4+ !upperBound = (bitCount * 3) `div` 4+ in (lowerBound, upperBound) `subRange` bitVector+ + bitsBench :: Benchmark bitsBench = bgroup "Bits" [ binaryBenchmark "(.|.)" (.|.)@@ -117,6 +164,19 @@ ] +hashableBench :: Benchmark+hashableBench = bgroup "Hashable"+ [ unaryBenchmark "hash" hash+ , indexingBenchmark "hashWithSalt" (flip hashWithSalt)+ ]+ ++semigroupBench :: Benchmark+semigroupBench = bgroup "Semigroup"+ [ binaryBenchmark "(<>)" (<>)+ ]+ + constantNumberTimeBenchmark :: (NFData a, NFData b) => String -> (Integer -> a) -> (Integer -> a -> b) -> Benchmark constantNumberTimeBenchmark label f g = bgroup label $ generateBenchmark <$> magicNumbers where@@ -180,101 +240,3 @@ , ("large" , largeNumber) , ("huge" , hugeNumber) ]--{--invertBench :: Benchmark-invertBench = bench "MutualExclusionSet invert is constant-time" $ whnf invert $ force (ofSize 50)---isCoherentBench :: Benchmark-isCoherentBench = bench "MutualExclusionSet isCoherent is constant-time" $ whnf isCoherent $ force (ofSize 50)---isPermissibleBench :: Benchmark-isPermissibleBench = linearBenchmark "MutualExclusionSet isPermissible log-access" (force . ofSize) (const isPermissible)---isExcludedBench :: Benchmark-isExcludedBench = logBenchmark "MutualExclusionSet isExcluded log-access" ofSize f- where- -- We negate i to consider both the included and excluded cases- f i xs = (i `isExcluded` xs) `seq` negate i `isExcluded` xs---isIncludedBench :: Benchmark-isIncludedBench = logBenchmark "MutualExclusionSet isIncluded log-access" ofSize f- where- -- We negate i to consider both the included and excluded cases- f i xs = (i `isIncluded` xs) `seq` negate i `isIncluded` xs---excludedLookupBench :: Benchmark-excludedLookupBench = logBenchmark "MutualExclusionSet excludedLookup log-access" ofSize f- where- -- We negate i to consider both the included and excluded cases- f i xs = (i `excludedLookup` xs) `seq` negate i `excludedLookup` xs---includedLookupBench :: Benchmark-includedLookupBench = logBenchmark "MutualExclusionSet includedLookup log-access" ofSize f- where- -- We negate i to consider both the included and excluded cases- f i xs = (i `includedLookup` xs) `seq` negate i `includedLookup` xs---excludedSetBench :: Benchmark-excludedSetBench = linearBenchmark "MutualExclusionSet excludedSet linear access" (force . ofSize) (const excludedSet)---includedSetBench :: Benchmark-includedSetBench = linearBenchmark "MutualExclusionSet includedSet linear access" (force . ofSize) (const includedSet)---mutualExclusivePairsBench :: Benchmark-mutualExclusivePairsBench = linearBenchmark "MutualExclusionSet mutuallyExclusivePairs linear access" (force . ofSize) (const mutuallyExclusivePairs)---mergeBench :: Benchmark-mergeBench = linearBenchmark2 "merge (<>) is linear" (force . ofSize) (force . ofSizeEven) (const (<>))---linearBenchmark :: (NFData a, NFData b) => String -> (Int -> a) -> (Int -> a -> b) -> Benchmark-linearBenchmark label f g = bgroup label $ generateBenchmark <$> [0 .. 9]- where- generateBenchmark expVal = bench (show domainSize) $ nf app target- where- !target = force $ f domainSize- !app = g expVal- domainSize = 10 * (expVal + 1)- --linearBenchmark2 :: (NFData a, NFData b, NFData c) => String -> (Int -> a) -> (Int -> b) -> (Int -> a -> b -> c) -> Benchmark-linearBenchmark2 label f g h = bgroup label $ generateBenchmark <$> [0 .. 9]- where- generateBenchmark expVal = bench (show domainSize) $ nf app rhs- where- !lhs = force $ f domainSize- !rhs = force $ g domainSize- !app = h expVal lhs- domainSize = 10 * (expVal + 1)- --logBenchmark :: String -> (Int -> a) -> (Int -> a -> b) -> Benchmark-logBenchmark label f g = bgroup label $ generateBenchmark <$> [0 .. 9]- where- generateBenchmark expVal = bench (show domainSize) $ whnf app target- where- !app = g indexpValrod- !target = f domainSize- indexpValrod = product [1..expVal] `mod` domainSize- domainSize = 2 `shiftL` expVal---ofSize :: Int -> MutualExclusionSet Int-ofSize n = unsafeFromList $ (\x -> (x, negate x)) <$> [1..n]---ofSizeEven :: Int -> MutualExclusionSet Int-ofSizeEven n = unsafeFromList $ (\x -> (x, negate x)) <$> [2,4..2*n]---}
bv-little.cabal view
@@ -1,5 +1,5 @@ name: bv-little-version: 0.1.0.0+version: 0.1.1 synopsis: Efficient little-endian bit vector library category: Data, Bit Vectors license: BSD3@@ -11,7 +11,7 @@ copyright: (c) Alex Washburn 2018 description: .- This package contains a time- and space- efficient implementation of little-endian bit vectors. Provides implementations of applicable typeclasses and numeric conversions.+ This package contains a time- and space- efficient implementation of /little-endian/ bit vectors. Provides implementations of applicable typeclasses and numeric conversions. . The declared cost of each operation is either worst-case or amortized. .@@ -20,7 +20,7 @@ build-type: Simple cabal-version: >= 1.22 -tested-with: GHC == 8.4.1+tested-with: GHC == 8.4.2 GHC == 8.2.2 GHC == 8.0.2 GHC == 7.10.3@@ -36,7 +36,7 @@ library - build-depends: base >= 4.5.1 && < 4.11.1+ build-depends: base >= 4.5.1 && < 4.12 , deepseq , hashable , integer-gmp@@ -99,8 +99,9 @@ main-is: TestSuite.hs - build-depends: base >= 4.5.1 && < 4.11.1+ build-depends: base >= 4.5.1 && < 4.12 , bv-little+ , deepseq , hashable , mono-traversable , QuickCheck@@ -124,10 +125,11 @@ main-is: Benchmarks.hs - build-depends: base >= 4.5.1 && < 4.11.1+ build-depends: base >= 4.5.1 && < 4.12 , bv-little , criterion , deepseq+ , hashable if !impl(ghc >= 8.0)
changelog.md view
@@ -1,5 +1,18 @@-### v0.1.0.0+### Unreleased changes + * None++### [v0.1.1][1]++ * Updated to well-typed internal representation++ * Increased benchmark coverage++ * Increased test suite coverage+++### [v0.1.0][0]+ * Created instances of applicable typeclass instances * Added numeric conversion functions@@ -7,3 +20,7 @@ * Added basic test suite * Added stub benchmark+++[0]: https://github.com/recursion-ninja/bv-little/tree/v0.1.0+[1]: https://github.com/recursion-ninja/bv-little/tree/v0.1.1
src/Data/BitVector/LittleEndian.hs view
@@ -71,15 +71,16 @@ import GHC.Generics import GHC.Integer.GMP.Internals import GHC.Integer.Logarithms-import Test.QuickCheck (Arbitrary(..), CoArbitrary(..), NonNegative(..), suchThat)+import GHC.Natural+import Test.QuickCheck (Arbitrary(..), CoArbitrary(..), NonNegative(..), suchThat, variant) -- | -- A little-endian bit vector of non-negative dimension. data BitVector = BV- { dim :: {-# UNPACK #-} !Int -- ^ The /dimension/ of a bit vector.- , nat :: !Integer -- ^ The value of a bit vector, as a natural number.+ { dim :: {-# UNPACK #-} !Word -- ^ The /dimension/ of a bit vector.+ , nat :: !Natural -- ^ The value of a bit vector, as a natural number. } deriving ( Data , Generic , Typeable@@ -97,9 +98,9 @@ arbitrary = do dimVal <- getNonNegative <$> arbitrary- let upperBound = 2^dimVal+ let upperBound = shiftL 1 dimVal intVal <- (getNonNegative <$> arbitrary) `suchThat` (< upperBound)- pure $ BV dimVal intVal+ pure . BV (toEnum dimVal) $ intToNat intVal -- |@@ -116,18 +117,23 @@ (BV w1 a) `xor` (BV w2 b) = BV (max w1 w2) $ a `xor` b {-# INLINE complement #-}- complement (BV w n) = BV w $ 2^w - 1 - n+ complement (BV w n) = BV w $ (shiftL 1 (fromEnum w)) - 1 - n {-# INLINE zeroBits #-} zeroBits = BV 0 0 {-# INLINE bit #-}- bit i = BV (i+1) (2^i)+ bit i = BV (succ $ toEnum i) (shiftL 1 i) {-# INLINE clearBit #-}+ -- We do this more complicated operation rather than call 'clearBit'+ -- because it is undefined for Natural in base < 4.10.0.0 clearBit bv@(BV w n) i- | i < 0 || i >= w = bv- | otherwise = BV w $ n `clearBit` i+ | i < 0 || toEnum i >= w = bv+ | otherwise =+ let !allBits = pred . shiftL 1 $ fromEnum w+ !mask = bit i `xor` allBits+ in BV w $ n .&. mask {- {-# INLINE setBit #-}@@ -137,49 +143,63 @@ -} {-# INLINE testBit #-}- testBit (BV w n) i = i >= 0 && i < w && n `testBit` i+ testBit (BV w n) i = i >= 0 && toEnum i < w && n `testBit` i - bitSize (BV w _) = w+ bitSize (BV w _) = fromEnum w {-# INLINE bitSizeMaybe #-}- bitSizeMaybe (BV w _) = Just w+ bitSizeMaybe (BV w _) = Just $ fromEnum w {-# INLINE isSigned #-} isSigned = const False {-# INLINE shiftL #-} shiftL (BV w n) k- | k > w = BV w 0- | otherwise = BV w $ shiftL n k `mod` 2^w+ | toEnum k > w = BV w 0+ | otherwise = BV w $ shiftL n k .&. pred (shiftL 1 (fromEnum w)) {-# INLINE shiftR #-} shiftR (BV w n) k- | k > w = BV w 0- | otherwise = BV w $ shiftR n k+ | toEnum k > w = BV w 0+ | otherwise = BV w $ shiftR n k {-# INLINE rotateL #-}- rotateL bv 0 = bv+ rotateL bv 0 = bv+ rotateL bv@(BV 0 _) _ = bv+ rotateL bv@(BV 1 _) _ = bv rotateL bv@(BV w n) k- | 0 == w = bv- | k == w = BV w n- | k > w = rotateL (BV w n) (k `mod` w)- | otherwise = BV w $ h + l+ | k < 0 = bv+ | j >= w = go . fromEnum $ j `mod` w+ | otherwise = go k where- s = w - k- l = n `shiftR` s- h = (n `shiftL` k) `mod` 2^w+ !j = toEnum k+ go 0 = bv+ go !i = BV w $ h + l+ where+ !v = fromEnum w+ !d = v - i+ !m = pred $ shiftL 1 d+ !l = n `shiftR` d+ !h = (n .&. m) `shiftL` i {-# INLINE rotateR #-}- rotateR bv 0 = bv+ rotateR bv 0 = bv+ rotateR bv@(BV 0 _) _ = bv+ rotateR bv@(BV 1 _) _ = bv rotateR bv@(BV w n) k- | 0 == w = bv- | k == w = bv- | k > w = rotateR (BV w n) (k `mod` w)- | otherwise = BV w $ h + l+ | k < 0 = bv+ | j >= w = go . fromEnum $ j `mod` w+ | otherwise = go k where- s = w - k- l = n `shiftR` k- h = (n `shiftL` s) `mod` 2^w+ !j = toEnum k+ go 0 = bv+ go !i = BV w $ h + l+ where+ !v = fromEnum w+ !d = v - i+ !m = pred $ shiftL 1 i+ !l = n `shiftR` i+ !h = (n .&. m) `shiftL` d {-# INLINE popCount #-} popCount = popCount . nat@@ -187,9 +207,11 @@ -- | -- /Since: 0.1.0.0/-instance CoArbitrary BitVector+instance CoArbitrary BitVector where + coarbitrary bv = variant (dimension bv) + -- | -- /Since: 0.1.0.0/ instance Eq BitVector where@@ -203,27 +225,27 @@ instance FiniteBits BitVector where {-# INLINE finiteBitSize #-}- finiteBitSize = dim+ finiteBitSize = fromEnum . dim {-# INLINE countTrailingZeros #-}- countTrailingZeros (BV w n) = max 0 $ w - lastSetBit - 1+ countTrailingZeros (BV w n) = max 0 $ fromEnum w - lastSetBit - 1 where- lastSetBit = I# (integerLog2# n)+ lastSetBit = I# (integerLog2# (toInteger n)) {-# INLINE countLeadingZeros #-}- countLeadingZeros (BV w 0) = w- countLeadingZeros (BV w intVal) =- case intVal of- S# v -> countTrailingZeros $ iMask .|. I# v- Jp# (BN# v) -> f $ ByteArray v- Jn# (BN# v) -> f $ ByteArray v+ countLeadingZeros (BV w 0) = fromEnum w+ countLeadingZeros (BV w natVal) =+ case natVal of+ NatS# v -> countTrailingZeros $ iMask .|. W# v+ NatJ# (BN# v) -> f $ ByteArray v where iMask = complement zeroBits `xor` (2 ^ w - 1)+ !x = fromEnum w f :: ByteArray -> Int f byteArr = g 0 where- (q, r) = w `quotRem` 64+ (q, r) = x `quotRem` 64 wMask = complement zeroBits `xor` (2 ^ r - 1) :: Word64 g :: Int -> Int@@ -242,7 +264,7 @@ -- /Since: 0.1.0.0/ instance Hashable BitVector where - hash (BV w n) = w `hashWithSalt` hash n+ hash (BV w n) = fromEnum w `hashWithSalt` hash n hashWithSalt salt bv = salt `hashWithSalt` hash bv @@ -287,14 +309,14 @@ onull = (== 0) . dim {-# INLINE olength #-}- olength = dim+ olength = fromEnum . dim -- | -- /Since: 0.1.0.0/ instance MonoFunctor BitVector where - omap f (BV w n) = BV w . go w $ n `xor` n+ omap f (BV w n) = BV w . go (fromEnum w) $ n `xor` n -- NB: 'setBit' is a GMP function, faster than regular addition. where go 0 !acc = acc@@ -344,20 +366,24 @@ instance Semigroup BitVector where {-# INLINE (<>) #-}- (<>) (BV x m) (BV y n) = BV (x + y) $ (n `shiftL` x) + m+ (<>) (BV x m) (BV y n) = BV (x + y) $ (n `shiftL` fromEnum x) + m {-# INLINABLE sconcat #-}- sconcat xs = uncurry BV $ foldl' f (0,0) xs+ sconcat xs = BV w' n' where- f (bitCount, natVal) (BV w n) = (bitCount + w, natVal + (n `shiftL` bitCount))+ (w', _, n') = foldl' f (0, 0, 0) xs+ f (bitCountW, bitCountI, natVal) (BV w n) =+ (bitCountW + w, bitCountI + fromEnum w, natVal + (n `shiftL` bitCountI)) {-# INLINE stimes #-} stimes 0 _ = mempty- stimes e (BV w n) = BV limit $ go (limit - w) n+ stimes e (BV w n) = BV limit $ go start n where- limit = fromEnum e * w+ !x = fromEnum w+ !start = fromEnum $ limit - w+ !limit = (toEnum . fromEnum) e * w go 0 !acc = acc- go !k !acc = go (k-w) $ (n `shiftL` k) + acc+ go !k !acc = go (k-x) $ (n `shiftL` k) + acc -- |@@ -385,7 +411,7 @@ -- [3]1 {-# INLINE fromBits #-} fromBits :: Foldable f => f Bool -> BitVector-fromBits bs = BV n k+fromBits bs = BV (toEnum n) k -- NB: 'setBit' is a GMP function, faster than regular addition. where (!n, !k) = foldl' go (0, 0) bs@@ -412,7 +438,7 @@ -- [True, True, False, True] {-# INLINE toBits #-} toBits :: BitVector -> [Bool]-toBits (BV w n) = testBit n <$> [ 0 .. w - 1 ]+toBits (BV w n) = testBit n <$> [ 0 .. fromEnum w - 1 ] -- |@@ -450,14 +476,13 @@ => Word -- ^ dimension of bit vector -> v -- ^ /signed, little-endian/ integral value -> BitVector-fromNumber !dimValue !intValue = BV width $ mask .&. v+fromNumber !dimValue !intValue = BV dimValue . intToNat $ mask .&. v where- !v | signum int < 0 = negate $ 2^intBits - int+ !v | signum int < 0 = negate $ (shiftL 1 intBits) - int | otherwise = int !int = toInteger intValue !intBits = I# (integerLog2# int)- !width = fromEnum dimValue !mask = 2 ^ dimValue - 1 @@ -491,8 +516,9 @@ toSignedNumber :: Num a => BitVector -> a toSignedNumber (BV w n) = fromInteger v where- v | n `testBit` (w-1) = negate $ 2^w - n- | otherwise = n+ !i = toInteger n+ !v | n `testBit` (fromEnum w - 1) = negate $ (shiftL 1 (fromEnum w)) - i+ | otherwise = i -- |@@ -523,7 +549,7 @@ -- 15 {-# INLINE toUnsignedNumber #-} toUnsignedNumber :: Num a => BitVector -> a-toUnsignedNumber = fromInteger . nat+toUnsignedNumber = fromInteger . toInteger . nat -- |@@ -544,7 +570,7 @@ -- 4 {-# INLINE dimension #-} dimension :: BitVector -> Word-dimension = toEnum . dim+dimension = dim -- |@@ -598,7 +624,37 @@ subRange :: (Word, Word) -> BitVector -> BitVector subRange (!lower, !upper) (BV _ n) | lower > upper = zeroBits- | otherwise = BV m $ (n `shiftR` i) `mod` 2^m+ | otherwise =+ case toInt lower of+ Nothing -> zeroBits+ Just i ->+ let b = n `shiftR` i+ in case toInt upper of+ Nothing ->+ let m = toEnum $ maxBound - i + 1+ in BV m $ n `shiftR` i+ Just j ->+ let x = j - i+ m | x == maxBound = x+ | otherwise = x + 1+ in BV (toEnum m) $ b .&. pred (1 `shiftL` m)+++toInt :: Word -> Maybe Int+toInt w+ | w > maxInt = Nothing+ | otherwise = Just $ fromEnum w where- i = fromEnum lower- m = fromEnum $ upper - lower + 1+ maxInt = toEnum (maxBound :: Int)++++-- |+-- While similar to the function 'naturalFromInteger' exported from GHC.Natural,+-- 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 #-}+intToNat :: Integer -> Natural+intToNat (S# i#) | I# i# >= 0 = NatS# (int2Word# i#)+intToNat (Jp# bn) = NatJ# bn+intToNat _ = NatS# (int2Word# 0#)
test/TestSuite.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE FlexibleInstances #-} +-- We apply this to suppress the deprecated warning cause by calls to 'bitSize'+-- If there is a more fine-grained way to supress this warning without suppressing+-- deprecated warnings for the whole module, we should do that instead.+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+ module Main ( main ) where +import Control.DeepSeq import Data.Bits import Data.BitVector.LittleEndian import Data.Functor.Compose@@ -29,8 +35,10 @@ , monoFoldableProperties , monoidProperties , monoTraversableProperties+ , normalFormDataProperties , orderingProperties , semigroupProperties+ , showProperties , bitVectorProperties ] @@ -294,6 +302,7 @@ [ testProperty "t . otraverse f === otraverse (t . f)" testNaturality , testProperty "otraverse Identity === Identity" testIdentity , testProperty "otraverse (Compose . fmap g . f) === Compose . fmap (otraverse g) . otraverse f" testComposition+ , testProperty "otraverse === omapM" testDefinitionEquality ] where testNaturality :: Blind (Bool -> [Bool]) -> BitVector -> Property@@ -308,7 +317,21 @@ testComposition (Blind f) (Blind g) bv = otraverse (Compose . fmap g . f) bv === (Compose . fmap (otraverse g) . otraverse f) bv + testDefinitionEquality :: Blind (Bool -> Maybe Bool) -> BitVector -> Property+ testDefinitionEquality (Blind f) bv =+ otraverse f bv === omapM f bv ++normalFormDataProperties :: TestTree+normalFormDataProperties = testGroup "Properties of NFData"+ [ testProperty "rnf result is finite" finiteReduction+ ]+ where+ finiteReduction :: BitVector -> Property+ finiteReduction bv =+ rnf bv === ()++ orderingProperties :: TestTree orderingProperties = testGroup "Properties of an Ordering" [ testProperty "ordering preserves symetry" symetry@@ -355,6 +378,21 @@ stimes i bv === (mconcat . replicate i) bv +showProperties :: TestTree+showProperties = testGroup "Properties of Show"+ [ testProperty "show result is finite" finiteString+ , testProperty "show result is non-null" nonNullString+ ]+ where+ finiteString :: BitVector -> Property+ finiteString bv =+ show bv === show bv + + nonNullString :: BitVector -> Bool+ nonNullString =+ not . null . show+ + bitVectorProperties :: TestTree bitVectorProperties = testGroup "BitVector properties" [ testProperty "otoList === toBits" otoListTest@@ -367,6 +405,9 @@ , testProperty "(0 ==) . toUnsignedNumber ==> isZeroVector" toUnsignedNumImpliesZeroVector , testProperty "toSignedNumber . fromNumber === id" bitVectorUnsignedNumIdentity , testProperty "isSigned == const False" noSignBitVector+-- For an unknown reason, this test case causes GHC to panic!+-- , testProperty "i > j ==> subRange (i,j) === const zeroBits" badSubRangeEmptyResult+ , testProperty "i <= j ==> dimension . subRange (i,j) === const (j - i + 1)" subRangeFixedDimension ] where otoListTest :: BitVector -> Property@@ -410,3 +451,14 @@ noSignBitVector :: BitVector -> Property noSignBitVector bv = isSigned bv === False++ badSubRangeEmptyResult :: (Word, Word) -> BitVector -> Property+ badSubRangeEmptyResult range@(lower, upper) bv =+ 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+ where+ lower = toEnum lowerI+ upper = toEnum upperI