From f85d281dbcd950a124a8cd518085ce9b4ff7dc40 Mon Sep 17 00:00:00 2001 From: David Feuer Date: Wed, 8 Jun 2016 17:48:46 -0400 Subject: [PATCH 1/2] General improvements * Remove unnecessary constraints from `Data.BitSet.Generic`. * Use a more streamlined implementation of `foldl'` and `foldr'` when possible. * Update Cabal file to indicate required extensions. * Make the tests work again. --- .gitignore | 5 +++ bitset.cabal | 16 ++++++-- include/bitset.h | 39 ++++++++++++++++++ src/Data/BitSet/Dynamic.hs | 9 +++-- src/Data/BitSet/Generic.hs | 83 +++++++++++++++++++++++++++----------- tests/Tests.hs | 68 ++++++++++++++++++++++--------- 6 files changed, 170 insertions(+), 50 deletions(-) create mode 100644 include/bitset.h diff --git a/.gitignore b/.gitignore index 25a2322..ef1e00d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,10 @@ cabal-dev dist +.cabal-sandbox/ +cabal.sandbox.config +.stack-work/ +*.hi +*.o # This file will be autogenerated on 'cabal build'. cbits/GmpDerivedConstants.h diff --git a/bitset.cabal b/bitset.cabal index bee8f5f..b27fe09 100644 --- a/bitset.cabal +++ b/bitset.cabal @@ -16,8 +16,8 @@ Bug-reports: http://github.com/lambda-llama/bitset/issues Stability: Experimental Cabal-Version: >= 1.12 Build-type: Custom -Tested-with: GHC >= 7.4.1 -Extra-Source-Files: bin/mkDerivedGmpConstants.c +Tested-with: GHC == 7.4.1, GHC == 7.6.3, GHC == 7.8.4 +Extra-Source-Files: bin/mkDerivedGmpConstants.c, include/bitset.h Source-repository head Type: git @@ -27,9 +27,15 @@ Library Hs-source-dirs: src Ghc-options: -Wall -fno-warn-orphans Default-language: Haskell2010 + Other-extensions: CPP, NamedFieldPuns, MagicHash, UnboxedTuples, + BangPatterns, ForeignFunctionInterface, + GHCForeignImportPrim, MagicHash, + UnliftedFFITypes, UnboxedTuples, + GeneralizedNewtypeDeriving, TypeFamilies, + DeriveDataTypeable C-sources: cbits/gmp-extras.cmm - Include-dirs: cbits + Include-dirs: cbits, include if os(windows) Extra-libraries: gmp-10 @@ -52,6 +58,7 @@ Test-suite bitset-tests Hs-source-dirs: tests Ghc-options: -Wall -O2 -fno-warn-orphans Default-language: Haskell2010 + Other-extensions: CPP Type: exitcode-stdio-1.0 Main-is: Tests.hs @@ -66,9 +73,10 @@ Benchmark bitset-benchmarks Hs-source-dirs: src benchmarks Ghc-options: -Wall -fno-warn-orphans -O2 -optc-O3 -optc-msse4.1 Default-language: Haskell2010 + Other-extensions: CPP, ExistentialQuantification C-sources: cbits/gmp-extras.cmm - Include-dirs: cbits + Include-dirs: cbits, include Extra-libraries: gmp Type: exitcode-stdio-1.0 diff --git a/include/bitset.h b/include/bitset.h new file mode 100644 index 0000000..de7f8b2 --- /dev/null +++ b/include/bitset.h @@ -0,0 +1,39 @@ +/* + * Common macros for bitset + */ + +#ifndef HASKELL_BITSET_H +#define HASKELL_BITSET_H + +/* + * We use cabal-generated MIN_VERSION_base to adapt to changes of base. + * Nevertheless, as a convenience, we also allow compiling without cabal by + * defining an approximate MIN_VERSION_base if needed. The alternative version + * guesses the version of base using the version of GHC. This is usually + * sufficiently accurate. However, it completely ignores minor version numbers, + * and it makes the assumption that a pre-release version of GHC will ship with + * base libraries with the same version numbers as the final release. This + * assumption is violated in certain stages of GHC development, but in practice + * this should very rarely matter, and will not affect any released version. + */ +#ifndef MIN_VERSION_base +#if __GLASGOW_HASKELL__ >= 711 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major2) == 4)&&((major2)<=9))) +#elif __GLASGOW_HASKELL__ >= 709 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8))) +#elif __GLASGOW_HASKELL__ >= 707 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7))) +#elif __GLASGOW_HASKELL__ >= 705 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6))) +#elif __GLASGOW_HASKELL__ >= 703 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5))) +#elif __GLASGOW_HASKELL__ >= 701 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4))) +#elif __GLASGOW_HASKELL__ >= 700 +#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3))) +#else +#define MIN_VERSION_base(major1,major2,minor) (0) +#endif +#endif + +#endif diff --git a/src/Data/BitSet/Dynamic.hs b/src/Data/BitSet/Dynamic.hs index a6147df..f4b16a0 100644 --- a/src/Data/BitSet/Dynamic.hs +++ b/src/Data/BitSet/Dynamic.hs @@ -2,6 +2,8 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +#include + ----------------------------------------------------------------------------- -- | -- Module : Data.BitSet.Dynamic @@ -122,11 +124,10 @@ instance Bits FasterInteger where isSigned = isSigned . unFI {-# INLINE isSigned #-} - bitSize = bitSize . unFI - {-# INLINE bitSize #-} + bitSize _ = error "bitSize: FasterInteger does not support bitSize." -#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) - bitSizeMaybe = bitSizeMaybe . unFI +#if MIN_VERSION_base(4,7,0) + bitSizeMaybe _ = Nothing {-# INLINE bitSizeMaybe #-} #endif diff --git a/src/Data/BitSet/Generic.hs b/src/Data/BitSet/Generic.hs index 63a157e..90cfedb 100644 --- a/src/Data/BitSet/Generic.hs +++ b/src/Data/BitSet/Generic.hs @@ -31,6 +31,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +#include + module Data.BitSet.Generic ( -- * Bit set type @@ -79,6 +81,9 @@ import Control.Applicative ((<$>)) import Control.DeepSeq (NFData(..)) import Data.Bits (Bits, (.|.), (.&.), complement, bit, testBit, setBit, clearBit, popCount) +#if MIN_VERSION_base(4,7,0) +import Data.Bits (bitSizeMaybe, isSigned, unsafeShiftR, zeroBits) +#endif import Data.Data (Typeable) import Data.Monoid (Monoid(..)) import Foreign (Storable) @@ -94,29 +99,35 @@ import qualified Data.List as List newtype BitSet c a = BitSet { getBits :: c } deriving (Eq, NFData, Storable, Ord, Typeable) -instance (Enum a, Read a, Bits c, Num c) => Read (BitSet c a) where +instance (Enum a, Read a, Bits c) => Read (BitSet c a) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP fromList <$> readPrec -instance (Enum a, Show a, Bits c, Num c) => Show (BitSet c a) where +instance (Enum a, Show a, Bits c) => Show (BitSet c a) where showsPrec p bs = showParen (p > 10) $ showString "fromList " . shows (toList bs) -instance (Enum a, Bits c, Num c) => Monoid (BitSet c a) where +instance Bits c => Monoid (BitSet c a) where mempty = empty mappend = union #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) -instance (Enum a, Bits c, Num c) => IsList (BitSet c a) where +instance (Enum a, Bits c) => IsList (BitSet c a) where type Item (BitSet c a) = a fromList = fromList toList = toList #endif +#if !MIN_VERSION_base(4,7,0) +zeroBits :: Bits c => c +zeroBits = bit 0 `clearBit` 0 +{-# INLINE zeroBits #-} +#endif + -- | /O(1)/. Is the bit set empty? -null :: (Eq c, Num c) => BitSet c a -> Bool -null = (== 0) . getBits +null :: Bits c => BitSet c a -> Bool +null = (== zeroBits) . getBits {-# INLINE null #-} -- | /O(1)/. The number of elements in the bit set. @@ -136,22 +147,22 @@ notMember x = not . member x -- | /O(max(n, m))/. Is this a subset? (@s1 `isSubsetOf` s2@) tells whether -- @s1@ is a subset of @s2@. -isSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool +isSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool isSubsetOf (BitSet bits1) (BitSet bits2) = bits2 .|. bits1 == bits2 {-# INLINE isSubsetOf #-} -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal). -isProperSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool +isProperSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2 {-# INLINE isProperSubsetOf #-} -- | The empty bit set. -empty :: (Enum a, Bits c, Num c) => BitSet c a -empty = BitSet 0 +empty :: Bits c => BitSet c a +empty = BitSet zeroBits {-# INLINE empty #-} -- | O(1). Create a singleton set. -singleton :: (Enum a, Bits c, Num c) => a -> BitSet c a +singleton :: (Enum a, Bits c) => a -> BitSet c a singleton = BitSet . bit . fromEnum {-# INLINE singleton #-} @@ -186,7 +197,7 @@ intersection (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. bits2 -- | /O(d * n)/ Transform this bit set by applying a function to every -- value. Resulting bit set may be smaller then the original. -map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> BitSet c a -> BitSet c b +map :: (Enum a, Enum b, Bits c) => (a -> b) -> BitSet c a -> BitSet c b map f = foldl' (\bs -> (`insert` bs) . f) empty {-# INLINE map #-} @@ -195,37 +206,63 @@ map f = foldl' (\bs -> (`insert` bs) . f) empty -- operator is evaluated before before using the result in the next -- application. This function is strict in the starting value. foldl' :: (Enum a, Bits c) => (b -> a -> b) -> b -> BitSet c a -> b -foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 0 where - go !acc 0 _b = acc - go !acc !n b = if bits `testBit` b - then go (f acc $ toEnum b) (pred n) (succ b) - else go acc n (succ b) +#if MIN_VERSION_base(4,7,0) +-- If the bit set is represented by an unsigned type +-- then we can shift the bits off one by one until we're +-- left with all zeros. If the type is fairly narrow, then +-- this is likely to be cheap. In particular, in this case +-- we don't need to calculate the `popCount` and all shifts +-- are by fixed amounts. +foldl' f acc0 (BitSet bits0) + | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) = + go acc0 bits0 0 + where + go !acc !bits !b + | bits == zeroBits = acc + | bits `testBit` 0 = go (f acc $ toEnum b) (bits `unsafeShiftR` 1) (b + 1) + | otherwise = go acc (bits `unsafeShiftR` 1) (b + 1) +#endif +foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 0 + where + go !acc 0 !_b = acc + go !acc n !b = if bits `testBit` b + then go (f acc $ toEnum b) (n - 1) (b + 1) + else go acc n (b + 1) {-# INLINE foldl' #-} -- | /O(d * n)/ Reduce this bit set by applying a binary function to -- all elements, using the given starting value. foldr :: (Enum a, Bits c) => (a -> b -> b) -> b -> BitSet c a -> b +#if MIN_VERSION_base(4,7,0) +foldr f acc0 (BitSet bits0) + | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) = go bits0 0 + where + go !bits !b + | bits == zeroBits = acc0 + | bits `testBit` 0 = toEnum b `f` go (bits `unsafeShiftR` 1) (b + 1) + | otherwise = go (bits `unsafeShiftR` 1) (b + 1) +#endif foldr f acc0 (BitSet bits) = go (popCount bits) 0 where go 0 _b = acc0 go !n b = if bits `testBit` b - then toEnum b `f` go (pred n) (succ b) - else go n (succ b) + then toEnum b `f` go (n - 1) (b + 1) + else go n (b + 1) {-# INLINE foldr #-} -- | /O(d * n)/ Filter this bit set by retaining only elements satisfying -- predicate. -filter :: (Enum a, Bits c, Num c) => (a -> Bool) -> BitSet c a -> BitSet c a +filter :: (Enum a, Bits c) => (a -> Bool) -> BitSet c a -> BitSet c a filter f = foldl' (\bs x -> if f x then x `insert` bs else bs) empty {-# INLINE filter #-} -- | /O(d * n)/. Convert this bit set set to a list of elements. -toList :: (Enum a, Bits c, Num c) => BitSet c a -> [a] +toList :: (Enum a, Bits c) => BitSet c a -> [a] toList bs = build (\k z -> foldr k z bs) {-# INLINE [0] toList #-} -- | /O(d * n)/. Make a bit set from a list of elements. -fromList :: (Enum a, Bits c, Num c) => [a] -> BitSet c a -fromList = BitSet . List.foldl' (\i x -> i `setBit` fromEnum x) 0 +fromList :: (Enum a, Bits c) => [a] -> BitSet c a +fromList = List.foldl' (\i x -> insert x i) empty {-# INLINE [0] fromList #-} {-# RULES "fromList/toList" forall bs. fromList (toList bs) = bs diff --git a/tests/Tests.hs b/tests/Tests.hs index 5c4dea4..74d7feb 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,19 +1,19 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} module Main (main) where import Control.Applicative ((<$>)) -import Data.Bits (popCount, testBit, setBit, clearBit) +import Data.Bits (Bits, popCount, testBit, setBit, clearBit) import Data.Int (Int16) import Data.List ((\\), intersect, union, nub, sort) import Data.Monoid ((<>), mempty) -import Data.Word (Word16) +import Data.Word (Word, Word16) import Foreign (Storable(..), allocaBytes) import Test.Tasty (TestTree, testGroup, defaultMain) import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck (Property, Arbitrary(..), (==>), classify) +import Test.QuickCheck (Property, Arbitrary(..), CoArbitrary (..), (==>), classify, (===), choose) +import Test.QuickCheck.Function (Fun, Function (..), apply, functionMap) import Test.QuickCheck.Monadic (monadicIO, assert, run) import Data.BitSet (BitSet) @@ -21,15 +21,23 @@ import Data.BitSet.Dynamic (FasterInteger(..)) import qualified Data.BitSet as BS import qualified Data.BitSet.Generic as GS -instance (Arbitrary a, Enum a) => Arbitrary (BitSet a) where - arbitrary = BS.fromList <$> arbitrary - -instance (Arbitrary a, Enum a) => Arbitrary (GS.BitSet Word16 a) where +instance (Arbitrary a, Enum a, Bits b) => Arbitrary (GS.BitSet b a) where arbitrary = GS.fromList <$> arbitrary instance Arbitrary FasterInteger where arbitrary = FasterInteger <$> arbitrary +-- QuickCheck 2.8 does not offer a Function instance +-- for Word16 ( https://github.com/nick8325/quickcheck/issues/97 ). +-- We use a wrapper to work around that. +newtype Word16' = Word16' { getWord16 :: Word16 } deriving (Eq, Show) + +instance CoArbitrary Word16' where + coarbitrary = coarbitrary . getWord16 + +instance Function Word16' where + function = functionMap (fromIntegral . getWord16) (Word16' . fromInteger) + propSize :: [Word16] -> Bool propSize = go . nub where go xs = length xs == BS.size (BS.fromList xs) @@ -163,11 +171,37 @@ propIsSubsetOf xs = propShowRead :: BitSet Word16 -> Bool propShowRead bs = bs == (read $ show bs) -propMap :: BitSet Word16 -> (Word16 -> Word16) -> Bool -propMap bs f = BS.map f bs == (BS.fromList $ map f $ BS.toList bs) +propMap :: BitSet Word16 -> Fun Word16' Word16 -> Property +propMap bs f = BS.map (apply f . Word16') bs === (BS.fromList $ map (apply f . Word16') $ BS.toList bs) + +-- A little word, taking values in [0..15]. +data Little = Little {getLittle :: Word} deriving (Show, Eq) + +mkLittle :: Word -> Little +mkLittle x + | 0 <= x && x < 16 = Little x + | otherwise = error "Little out of range." + +instance Enum Little where + toEnum = mkLittle . fromIntegral + fromEnum = fromIntegral . getLittle + +instance Arbitrary Little where + arbitrary = mkLittle <$> choose (0,15) + +instance CoArbitrary Little where + coarbitrary = coarbitrary . getLittle + +instance Function Little where + -- We use `mod` here instead of `rem` because we need a non-negative result. + -- It would be nicer to use "Euclidean" division, but speed is not important. + function = functionMap (fromIntegral . getLittle) (mkLittle . fromInteger . (`mod` 16)) + +propMapWord16 :: GS.BitSet Word16 Little -> Fun Little Little -> Property +propMapWord16 bs f = GS.map (apply f) bs === (GS.fromList $ map (apply f) $ GS.toList bs) -propFilter :: BitSet Word16 -> (Word16 -> Bool) -> Bool -propFilter bs f = BS.filter f bs == (BS.fromList $ filter f $ BS.toList bs) +propFilter :: BitSet Word16 -> Fun Word16' Bool -> Property +propFilter bs f = BS.filter (apply f . Word16') bs === (BS.fromList $ filter (apply f . Word16') $ BS.toList bs) propStorable :: GS.BitSet Word16 Word16 -> Property propStorable storable = monadicIO $ do @@ -180,12 +214,10 @@ propStorable storable = monadicIO $ do size = sizeOf storable -#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) propPopCount :: FasterInteger -> Property -propPopCount xfi = xfi >= 0 ==> popCount xfi == popCount xi where +propPopCount xfi = xfi >= 0 ==> popCount xfi === popCount xi where xi :: Integer xi = fromIntegral xfi -#endif propTestBit :: FasterInteger -> Int16 -> Property propTestBit xfi i = xfi >= 0 ==> testBit xfi bit == testBit xi bit where @@ -247,6 +279,7 @@ main = defaultMain tests where , testProperty "is subset of self" propIsSubsetOfSelf , testProperty "is subset of" propIsSubsetOf , testProperty "show read" propShowRead + , testProperty "map Word16" propMapWord16 , testProperty "map" propMap , testProperty "filter" propFilter , testProperty "storable instance" propStorable @@ -255,11 +288,8 @@ main = defaultMain tests where testsFasterInteger :: TestTree testsFasterInteger = testGroup "GHC.Integer.GMP" $ [ -#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) testProperty "pop count" propPopCount - , -#endif - testProperty "test bit" propTestBit + , testProperty "test bit" propTestBit , testProperty "set bit" propSetBit , testProperty "clear bit" propClearBit ] From 231962e0e6a63fe63e1952826f97ca529f20a4e5 Mon Sep 17 00:00:00 2001 From: David Feuer Date: Thu, 9 Jun 2016 18:55:19 -0400 Subject: [PATCH 2/2] Add rules for list fusion Make `fromList` fuse with `build` and `augment`, and make `toList` fuse with `foldr`. Express the `toList/fromList` rule in terms of rewrite helper targets; this has the pleasant side effect of letting it handle things like `fromList $ toList xs ++ toList ys`. Adjust arities of functions in `Data.BitSet.Word` to convince most of the underlying functions to inline. I *think* this is what we want. --- src/Data/BitSet/Generic.hs | 45 ++++++++++++++++++++++++++++++++------ src/Data/BitSet/Word.hs | 14 ++++++------ tests/Tests.hs | 22 +++++++++++++++++++ 3 files changed, 67 insertions(+), 14 deletions(-) diff --git a/src/Data/BitSet/Generic.hs b/src/Data/BitSet/Generic.hs index 90cfedb..73568b6 100644 --- a/src/Data/BitSet/Generic.hs +++ b/src/Data/BitSet/Generic.hs @@ -257,13 +257,44 @@ filter f = foldl' (\bs x -> if f x then x `insert` bs else bs) empty -- | /O(d * n)/. Convert this bit set set to a list of elements. toList :: (Enum a, Bits c) => BitSet c a -> [a] -toList bs = build (\k z -> foldr k z bs) -{-# INLINE [0] toList #-} +toList bs = foldr (:) [] bs +{-# NOINLINE [0] toList #-} + +-- We rewrite toList to a `build` form to fuse with `foldr`. We write +-- `fromList` using a `foldr` form to fuse with `build` and `augment`. The +-- fromList/toList rule is more general than the old `fromList . toList = id` +-- rule. This extra generality fell out naturally from the rule construction, +-- but it seems to be at least somewhat useful; for example, `fromList $ toList +-- xs ++ toList ys` rewrites to the union of `xs` and `ys`. +{-# RULES +"toList" [~1] forall bs . toList bs = build (toListFB bs) +"toList/List" [1] forall bs . toListFB bs (:) [] = toList bs +"fromList/toList" forall bs f cs. toListFB bs fromListFB f cs = + f $! union bs cs + #-} + +{- +Explanation of fromList/toList rule: + +toListFB bs fromListFB f cs = +foldr fromListFB f bs cs = +foldr (\x r -> \ !acc -> r (insert x acc)) f bs cs = +foldr (\x r !acc -> r (insert x acc)) f bs cs + +This last form inserts each element of `bs` into `cs`, accumulating strictly, +then applies `f` to the final result. This is just the same as taking their +*union* and applying `f` to it. +-} + +toListFB :: (Enum a, Bits c) => BitSet c a -> (a -> b -> b) -> b -> b +toListFB bs = \k z -> foldr k z bs +{-# INLINE [0] toListFB #-} -- | /O(d * n)/. Make a bit set from a list of elements. fromList :: (Enum a, Bits c) => [a] -> BitSet c a -fromList = List.foldl' (\i x -> insert x i) empty -{-# INLINE [0] fromList #-} -{-# RULES -"fromList/toList" forall bs. fromList (toList bs) = bs - #-} +fromList xs = List.foldr fromListFB id xs empty +{-# INLINE fromList #-} + +fromListFB :: (Enum a, Bits c) => a -> (BitSet c a -> b) -> BitSet c a -> b +fromListFB x r = \ !acc -> r (insert x acc) +{-# INLINE [0] fromListFB #-} diff --git a/src/Data/BitSet/Word.hs b/src/Data/BitSet/Word.hs index 6a016d7..079be13 100644 --- a/src/Data/BitSet/Word.hs +++ b/src/Data/BitSet/Word.hs @@ -124,7 +124,7 @@ insert = GS.insert -- | /O(1)/. Delete an item from the bit set. delete :: Enum a => a -> BitSet a -> BitSet a -delete = GS.delete +delete x xs = GS.delete x xs {-# INLINE delete #-} -- | /O(1)/. The union of two bit sets. @@ -149,7 +149,7 @@ intersection = GS.intersection -- | /O(n)/ Transform this bit set by applying a function to every value. -- Resulting bit set may be smaller then the original. map :: (Enum a, Enum b) => (a -> b) -> BitSet a -> BitSet b -map = GS.map +map f = GS.map f {-# INLINE map #-} -- | /O(n)/ Reduce this bit set by applying a binary function to all @@ -157,27 +157,27 @@ map = GS.map -- operator is evaluated before before using the result in the next -- application. This function is strict in the starting value. foldl' :: Enum a => (b -> a -> b) -> b -> BitSet a -> b -foldl' = GS.foldl' +foldl' f b xs = GS.foldl' f b xs {-# INLINE foldl' #-} -- | /O(n)/ Reduce this bit set by applying a binary function to all -- elements, using the given starting value. foldr :: Enum a => (a -> b -> b) -> b -> BitSet a -> b -foldr = GS.foldr +foldr c n xs = GS.foldr c n xs {-# INLINE foldr #-} -- | /O(n)/ Filter this bit set by retaining only elements satisfying a -- predicate. filter :: Enum a => (a -> Bool) -> BitSet a -> BitSet a -filter = GS.filter +filter f = GS.filter f {-# INLINE filter #-} -- | /O(n)/. Convert the bit set set to a list of elements. toList :: Enum a => BitSet a -> [a] -toList = GS.toList +toList xs = GS.toList xs {-# INLINE toList #-} -- | /O(n)/. Make a bit set from a list of elements. fromList :: Enum a => [a] -> BitSet a -fromList = GS.fromList +fromList xs = GS.fromList xs {-# INLINE fromList #-} diff --git a/tests/Tests.hs b/tests/Tests.hs index 74d7feb..d42fec4 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -77,6 +77,24 @@ propInsertIdempotent :: Word16 -> BitSet Word16 -> Bool propInsertIdempotent x bs = BS.insert x bs == BS.insert x (BS.insert x bs) +-- A copy of fromList marked NOINLINE to ensure it is not +-- affected by RULES. +fromListNOINLINE :: (Bits i, Enum e) => [e] -> GS.BitSet i e +fromListNOINLINE = GS.fromList +{-# NOINLINE fromListNOINLINE #-} + +-- A copy of toList marked NOINLINE to ensure it is not +-- affected by RULES. +toListNOINLINE :: (Bits i, Enum e) => GS.BitSet i e -> [e] +toListNOINLINE = GS.toList +{-# NOINLINE toListNOINLINE #-} + +propFromDotToList :: BitSet Word16 -> Property +propFromDotToList x = x === fromListNOINLINE (toListNOINLINE x) + +propFromDotToListRULES :: BitSet Word16 -> Property +propFromDotToListRULES x = x === BS.fromList (BS.toList x) + propToList :: [Word16] -> Bool propToList xs = nub (sort xs) == BS.toList bs where bs :: BitSet Word16 @@ -197,6 +215,8 @@ instance Function Little where -- It would be nicer to use "Euclidean" division, but speed is not important. function = functionMap (fromIntegral . getLittle) (mkLittle . fromInteger . (`mod` 16)) +-- This tests the case of a bitset backed by a small unsigned +-- Bits instance. propMapWord16 :: GS.BitSet Word16 Little -> Fun Little Little -> Property propMapWord16 bs f = GS.map (apply f) bs === (GS.fromList $ map (apply f) $ GS.toList bs) @@ -268,6 +288,8 @@ main = defaultMain tests where , testProperty "insert is idempotent" propInsertIdempotent , testProperty "toList" propToList , testProperty "fromList" propFromList + , testProperty "fromListInvertsToList" propFromDotToList + , testProperty "fromListInvertsToListRULES" propFromDotToListRULES , testProperty "empty" propEmpty , testProperty "native empty is null" propNullEmpty , testProperty "generated empty is null" propNullAfterDelete