bitset 1.3.0 → 1.4.0

raw patch · 8 files changed

+439/−127 lines, 8 filesdep ~random-shufflePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: random-shuffle

API changes (from Hackage documentation)

Files

• CHANGES +23/−0
• benchmarks/Benchmarks.hs +30/−30
• bitset.cabal +8/−7
• src/Data/BitSet.hs +0/−12
• src/Data/BitSet/Dynamic.hs +97/−47
• src/Data/BitSet/Generic.hs +80/−22
• src/Data/BitSet/Word.hs +183/−0
• tests/Tests.hs +18/−9

@@ -3,6 +3,29 @@  Here you can see the full list of changes between each bitset release. +Version 1.4.0+-------------++Released on April 4th, 2013++- More speed optimizations, 'Data.BitSet.Dynamic' is close to 'Data.Set'+  performance on most operations.+- Added 'Data.BitSet.Word', a bit set with native integer as container+  type, significantly faster then 'Data.Set' for enumerated types with+  small number of constructors.+- Added folds, 'map' and 'filter' for consistency with other Haskell+  containers.++Version 1.3.0+-------------++Released on March 25th, 2013++- Added a generic bit set data type, abstract with respect to the underlying+  container.+- Improved dynamic bit set performance via optimized 'popCount' and+  'testBit' functions.+ Version 1.2 ----------- 

@@ -5,7 +5,7 @@ import Data.List (foldl')  import Control.DeepSeq (NFData(..))-import Criterion.Main (defaultMain, bench, bgroup, nf)+import Criterion.Main (defaultMain, bench, bgroup, whnf) import Data.Set (Set) import System.Random (mkStdGen) import System.Random.Shuffle (shuffle')@@ -31,42 +31,42 @@     return $ rnf [B bs1, B bs2, B s1, B s2, B shuffledElems1, B shuffledElems2]     defaultMain         [ bgroup "Set"-          [ bench "fromList" (nf Set.fromList shuffledElems1)-          , bench "toList" (nf Set.toList s1)-          , bench "singleton" (nf Set.singleton n)-          , bench "insert" (nf (insertS elems1) Set.empty)-          , bench "delete" (nf (deleteS elems1) s1)-          , bench "member" (nf (memberS shuffledElems1) s1)-          , bench "notMember" (nf (notMemberS shuffledElems2) s1)-          , bench "isSubsetOf" (nf (Set.isSubsetOf s2) s1)-          , bench "isProperSubsetOf" (nf (Set.isProperSubsetOf s2) s1)-          , bench "intersection" (nf (Set.intersection s2) s1)-          , bench "difference" (nf (Set.difference s2) s1)-          , bench "union" (nf (Set.union s2) s1)-          , bench "map" (nf (Set.map id) s1)-          , bench "filter" (nf (Set.filter $ const True) s1)+          [ bench "fromList" (whnf Set.fromList shuffledElems1)+          , bench "toList" (whnf Set.toList s1)+          , bench "singleton" (whnf Set.singleton n)+          , bench "insert" (whnf (insertS elems1) Set.empty)+          , bench "delete" (whnf (deleteS elems1) s1)+          , bench "notMember" (whnf (notMemberS shuffledElems1) s1)+          , bench "member" (whnf (memberS shuffledElems1) s1)+          , bench "isSubsetOf" (whnf (Set.isSubsetOf s2) s1)+          , bench "isProperSubsetOf" (whnf (Set.isProperSubsetOf s2) s1)+          , bench "intersection" (whnf (Set.intersection s2) s1)+          , bench "difference" (whnf (Set.difference s2) s1)+          , bench "union" (whnf (Set.union s2) s1)+          , bench "map" (whnf (Set.map (+ n)) s1)+          , bench "filter" (whnf (Set.filter odd) s1)           ]          , bgroup "BitSet"-          [ bench "fromList" (nf BS.fromList shuffledElems1)-          , bench "toList" (nf BS.toList bs1)-          , bench "singleton" (nf BS.singleton n)-          , bench "insert" (nf (insertBS elems1) BS.empty)-          , bench "delete" (nf (deleteBS elems1) bs1)-          , bench "member" (nf (memberBS shuffledElems1) bs1)-          , bench "notMember" (nf (notMemberBS shuffledElems2) bs1)-          , bench "isSubsetOf" (nf (BS.isSubsetOf bs2) bs1)-          , bench "isProperSubsetOf" (nf (BS.isProperSubsetOf bs2) bs1)-          , bench "intersection" (nf (BS.intersection bs2) bs1)-          , bench "difference" (nf (BS.difference bs2) bs1)-          , bench "union" (nf (BS.union bs2) bs1)-          , bench "map" (nf (BS.map id) bs1)-          , bench "filter" (nf (BS.filter $ const True) bs1)+          [ bench "fromList" (whnf BS.fromList shuffledElems1)+          , bench "toList" (whnf BS.toList bs1)+          , bench "singleton" (whnf BS.singleton n)+          , bench "insert" (whnf (insertBS elems1) BS.empty)+          , bench "delete" (whnf (deleteBS elems1) bs1)+          , bench "notMember" (whnf (notMemberBS shuffledElems1) bs1)+          , bench "member" (whnf (memberBS shuffledElems1) bs1)+          , bench "isSubsetOf" (whnf (BS.isSubsetOf bs2) bs1)+          , bench "isProperSubsetOf" (whnf (BS.isProperSubsetOf bs2) bs1)+          , bench "intersection" (whnf (BS.intersection bs2) bs1)+          , bench "difference" (whnf (BS.difference bs2) bs1)+          , bench "union" (whnf (BS.union bs2) bs1)+          , bench "map" (whnf (BS.map (+ n)) bs1)+          , bench "filter" (whnf (BS.filter odd) bs1)           ]         ]   where     n :: Int-    n = 128+    n = 4096      elems1 = [1..n]     elems2 = [1..n `div` 2]

@@ -1,5 +1,5 @@ Name:                 bitset-Version:              1.3.0+Version:              1.4.0 Synopsis:             A space-efficient set data structure. Description:   A /bit set/ is a compact data structure, which maintains a set of members@@ -12,7 +12,7 @@                     , Aleksey Kladov <aleksey.kladov@gmail.com>                     , Fedor Gogolev <knsd@knsd.net> Maintainer:           superbobry@gmail.com-Bug-reports:          http://github.com/superbobry/bitset/issues+Bug-reports:          http://github.com/lambda-llama/bitset/issues Stability:            Experimental Cabal-Version:        >= 1.12 Build-type:           Simple@@ -20,21 +20,22 @@  Source-repository head   Type:     git-  Location: https://github.com/superbobry/bitset+  Location: https://github.com/lambda-llama/bitset  Library   Hs-source-dirs:     src   Ghc-options:        -Wall -fno-warn-orphans   Default-language:   Haskell2010 -  Build-depends:      base                    >= 4.4.0 && < 4.7-                    , deepseq                 == 1.3.*+  Build-depends:      base                       >= 4.4.0 && < 4.7+                    , deepseq                    == 1.3.*                     , integer-gmp                     , ghc-prim    Exposed-modules:    Data.BitSet                     , Data.BitSet.Dynamic                     , Data.BitSet.Generic+                    , Data.BitSet.Word  Test-suite bitset-tests   Hs-source-dirs:     tests@@ -52,7 +53,7 @@  Benchmark bitset-benchmarks   Hs-source-dirs:     src benchmarks-  Ghc-options:        -Wall -O2 -optc-O3 -optc-msse4.1 -fno-warn-orphans+  Ghc-options:        -Wall -fno-warn-orphans -O2 -optc-O3 -optc-msse4.1   Default-language:   Haskell2010    Type:               exitcode-stdio-1.0@@ -66,4 +67,4 @@                     , criterion                   == 0.6.*                     , containers                  >= 0.4.2                     , random                      == 1.0.*-                    , random-shuffle              == 0.0.3+                    , random-shuffle              == 0.0.4

@@ -10,18 +10,6 @@ -- -- A space-efficient implementation of set data structure enumerated -- data types.------ /Note/: Read below the synopsis for important notes on the use of--- this module.------ This module is intended to be imported @qualified@, to avoid name--- clashes with "Prelude" functions, e.g.------ > import Data.BitSet (BitSet)--- > import qualified Data.BitSet as BS------ This module re-exports 'Dynamic' implementation that uses--- 'Integer' as underlying container.  module Data.BitSet ( module Data.BitSet.Dynamic ) where 

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  -----------------------------------------------------------------------------@@ -14,7 +14,7 @@ -- Stability   :  experimental -- Portability :  GHC ----- A space-efficient implementation of set data structure enumerated+-- A space-efficient implementation of set data structure for enumerated -- data types. -- -- /Note/: Read below the synopsis for important notes on the use of@@ -34,6 +34,7 @@     -- * Bit set type       FasterInteger     , BitSet+     -- * Operators     , (\\) @@ -53,13 +54,16 @@      -- * Combine     , union-    , unions     , difference     , intersection      -- * Transformations     , map +    -- * Folds+    , foldl'+    , foldr+     -- * Filter     , filter @@ -68,20 +72,23 @@     , fromList     ) where -import Prelude hiding (null, map, filter)+import Prelude hiding (null, map, filter, foldr)  import Data.Bits (Bits(..)) import GHC.Base (Int(..), divInt#, modInt#) import GHC.Exts (popCnt#) import GHC.Integer.GMP.Internals (Integer(..))-import GHC.Prim (Int#, Word#, (+#), (==#), (>=#),-                 word2Int#, int2Word#, plusWord#, indexWordArray#)+import GHC.Prim (State#, RealWorld, Int#, Word#, ByteArray#,+                 (+#), (==#), (>=#), (<#), negateInt#,+                 word2Int#, int2Word#, plusWord#, realWorld#,+                 newByteArray#, copyByteArray#, writeWordArray#,+                 indexWordArray#, unsafeFreezeByteArray#, sizeofByteArray#) import GHC.Word (Word(..))  import Control.DeepSeq (NFData(..)) -import Data.BitSet.Generic (GBitSet(..))-import qualified Data.BitSet.Generic as BS+import Data.BitSet.Generic (GBitSet)+import qualified Data.BitSet.Generic as GS  -- | A wrapper around 'Integer' which provides faster bit-level operations. newtype FasterInteger = FasterInteger { unFI :: Integer }@@ -100,19 +107,26 @@     complement = FasterInteger . complement . unFI     {-# INLINE complement #-} -    shift (FasterInteger x) i = FasterInteger $ shift x i+    shift (FasterInteger x) = FasterInteger . shift x     {-# INLINE shift #-} -    rotate (FasterInteger x) i = FasterInteger $ rotate x i+    rotate (FasterInteger x) = FasterInteger . rotate x     {-# INLINE rotate #-}      bit = FasterInteger . bit     {-# INLINE bit #-}      testBit (FasterInteger x) i = testBitInteger x i-    {-# INLINE testBit #-}+    {-# SPECIALIZE INLINE [1] testBit :: FasterInteger -> Int -> Bool #-} +    setBit (FasterInteger x) = FasterInteger . setBit x+    {-# SPECIALIZE INLINE setBit :: FasterInteger -> Int -> FasterInteger #-}++    clearBit (FasterInteger x) = FasterInteger . clearBitInteger x+    {-# SPECIALIZE INLINE clearBit :: FasterInteger -> Int -> FasterInteger #-}+     popCount (FasterInteger x) = I# (word2Int# (popCountInteger x))+    {-# SPECIALIZE INLINE popCount :: FasterInteger -> Int #-}      bitSize = bitSize . unFI     {-# INLINE bitSize #-}@@ -124,94 +138,108 @@  -- | /O(1)/. Is the bit set empty? null :: BitSet a -> Bool-null = BS.null+null = GS.null {-# INLINE null #-}  -- | /O(1)/. The number of elements in the bit set. size :: BitSet a -> Int-size = BS.size+size = GS.size {-# INLINE size #-}  -- | /O(1)/. Ask whether the item is in the bit set.-member :: a -> BitSet a -> Bool-member = BS.member+member :: Enum a => a -> BitSet a -> Bool+member = GS.member {-# INLINE member #-}  -- | /O(1)/. Ask whether the item is in the bit set.-notMember :: a -> BitSet a -> Bool-notMember = BS.notMember+notMember :: Enum a => a -> BitSet a -> Bool+notMember = GS.notMember {-# INLINE notMember #-}  -- | /O(max(n, m))/. Is this a subset? (@s1 isSubsetOf s2@) tells whether -- @s1@ is a subset of @s2@. isSubsetOf :: BitSet a -> BitSet a -> Bool-isSubsetOf = BS.isSubsetOf+isSubsetOf = GS.isSubsetOf+{-# INLINE isSubsetOf #-}  -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal). isProperSubsetOf :: BitSet a -> BitSet a -> Bool-isProperSubsetOf = BS.isProperSubsetOf+isProperSubsetOf = GS.isProperSubsetOf+{-# INLINE isProperSubsetOf #-}  -- | The empty bit set. empty :: Enum a => BitSet a-empty = BS.empty+empty = GS.empty {-# INLINE empty #-}  -- | O(1). Create a singleton set. singleton :: Enum a => a -> BitSet a-singleton = BS.singleton+singleton = GS.singleton {-# INLINE singleton #-}  -- | /O(1)/. Insert an item into the bit set. insert :: a -> BitSet a -> BitSet a-insert = BS.insert+insert = GS.insert {-# INLINE insert #-}  -- | /O(1)/. Delete an item from the bit set. delete :: a -> BitSet a -> BitSet a-delete = BS.delete+delete = GS.delete {-# INLINE delete #-}  -- | /O(max(m, n))/. The union of two bit sets. union :: BitSet a -> BitSet a -> BitSet a-union = BS.union+union = GS.union {-# INLINE union #-} --- | /O(max(m, n))/. The union of a list of bit sets.-unions :: Enum a => [BitSet a] -> BitSet a-unions = BS.unions-{-# INLINE unions #-}---- | /O(max(m, n))/. Difference of two bit sets.+-- | /O(1)/. Difference of two bit sets. difference :: BitSet a -> BitSet a -> BitSet a-difference = BS.difference+difference = GS.difference {-# INLINE difference #-} --- | /O(max(m, n))/. See `difference'.+-- | /O(1)/. See `difference'. (\\) :: BitSet a -> BitSet a -> BitSet a (\\) = difference --- | /O(max(m, n))/. The intersection of two bit sets.+-- | /O(1)/. The intersection of two bit sets. intersection :: BitSet a -> BitSet a -> BitSet a-intersection = BS.intersection+intersection = GS.intersection {-# INLINE 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 = BS.map+map = GS.map+{-# INLINE map #-} +-- | /O(n)/ Reduce this bit set by applying a binary function to all+-- elements, using the given starting value.  Each application of the+-- operator is evaluated before before using the result in the next+-- application.  This function is strict in the starting value.+foldl' :: (b -> a -> b) -> b -> BitSet a -> b+foldl' = GS.foldl'+{-# INLINE foldl' #-}++-- | /O(n)/ Reduce this bit set by applying a binary function to all+-- elements, using the given starting value.+foldr :: (a -> b -> b) -> b -> BitSet a -> b+foldr = GS.foldr+{-# 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 = BS.filter+filter = GS.filter+{-# INLINE filter #-}  -- | /O(n)/. Convert the bit set set to a list of elements. toList :: BitSet a -> [a]-toList = BS.toList+toList = GS.toList+{-# INLINE toList #-}  -- | /O(n)/. Make a bit set from a list of elements. fromList :: Enum a => [a] -> BitSet a-fromList = BS.fromList+fromList = GS.fromList {-# INLINE fromList #-}  popCountInteger :: Integer -> Word#@@ -228,20 +256,42 @@ #error WORD_SIZE_IN_BITS not defined! #endif --- Note(superbobry): this will be irrelevant after the new GHC release.+divModInt# :: Int# -> Int# -> (# Int#, Int# #)+divModInt# x y = (# d, m #) where+  !d = x `divInt#` y+  !m = x `modInt#` y+{-# INLINE divModInt# #-}++abs# :: Int# -> Int#+abs# x = if x <# 0# then negateInt# x else x+{-# INLINE abs# #-}+ testBitInteger :: Integer -> Int -> Bool testBitInteger (S# i#) b = I# i# `testBit` b testBitInteger (J# s# d#) (I# b#) =-    if block# >=# s#+    if b# <# 0# || block# >=# abs# s#     then False     else W# (indexWordArray# d# block#) `testBit` I# offset#   where-    n# :: Int#-    n# = WORD_SIZE_IN_BITS#+    (# !block#, !offset# #) = b# `divModInt#` WORD_SIZE_IN_BITS#+{-# NOINLINE testBitInteger #-} -    block# :: Int#-    !block# = b# `divInt#` n#+clearBitInteger :: Integer -> Int -> Integer+clearBitInteger (S# i#) b = S# i# `clearBit` b+clearBitInteger i@(J# s# d0#) (I# b#) =+    if b# <# 0# || block# >=# abs# s#+    then i+    else J# s# (go realWorld#)+  where+    (# !block#, !offset# #) = b# `divModInt#` WORD_SIZE_IN_BITS# -    offset# :: Int#-    !offset# = b# `modInt#` n#-{-# INLINE testBitInteger #-}+    go :: State# RealWorld -> ByteArray#+    go state0 =+        let !n = sizeofByteArray# d0#+            (# state1, !d1 #) = newByteArray# n state0+            state2 = copyByteArray# d0# 0# d1 0# n state1+            !(W# chunk) = W# (indexWordArray# d0# block#) `clearBit` I# offset#+            state3 = writeWordArray# d1 block# chunk state2+            (# _state4, d2 #) = unsafeFreezeByteArray# d1 state3+        in d2+{-# NOINLINE clearBitInteger #-}

@@ -20,11 +20,12 @@ -- > import Data.BitSet.Generic (BitSet) -- > import qualified Data.BitSet.Generic as BS ----- The implementation is abstract with respect to conatiner type, so any+-- The implementation is abstract with respect to container type, so any -- numeric type with 'Bits' instance can be used as a container. However, -- independent of container choice, the maximum number of elements in a -- bit set is bounded by @maxBound :: Int@. +{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-}@@ -33,7 +34,8 @@ module Data.BitSet.Generic     (     -- * Bit set type-      GBitSet(..)+      GBitSet+     -- * Operators     , (\\) @@ -53,22 +55,29 @@      -- * Combine     , union-    , unions     , difference     , intersection      -- * Transformations     , map +    -- * Folds+    , foldl'+    , foldr+     -- * Filter     , filter      -- * Lists     , toList     , fromList++    -- * Internal+    , toBits+    , unsafeFromBits     ) where -import Prelude hiding (null, map, filter)+import Prelude hiding (null, map, filter, foldr)  import Control.Applicative ((<$>)) import Control.DeepSeq (NFData(..))@@ -77,15 +86,18 @@ import Data.Data (Typeable) import Data.Function (on) import Data.Monoid (Monoid(..), (<>))+import Foreign (Storable(..), castPtr)+import GHC.Exts (build) import Text.Read (Read(..), Lexeme(..), lexP, prec, parens) import qualified Data.Foldable as Foldable import qualified Data.List as List  -- | A bit set with unspecified container type.-data GBitSet c a = (Enum a, Bits c, Num c) =>-                   BitSet { _n    :: Int  -- ^ Number of elements in the bit set.-                          , _bits :: c    -- ^ Bit container.-                          }+data GBitSet c a =+    (Enum a, Bits c, Num c) =>+    BitSet { _n    :: {-# UNPACK #-} !Int  -- ^ Number of elements in the bit set.+           , _bits :: !c                   -- ^ Bit container.+           }     deriving Typeable  instance Eq (GBitSet c a) where@@ -106,12 +118,24 @@ instance (Enum a, Bits c, Num c) => Monoid (GBitSet c a) where     mempty  = empty     mappend = union-    mconcat = unions  instance NFData c => NFData (GBitSet c a) where     rnf (BitSet { _n, _bits }) = rnf _n `seq` rnf _bits `seq` () +instance (Bits c, Enum a, Num c, Storable c) => Storable (GBitSet c a) where+    sizeOf = sizeOf . _bits+    alignment = alignment . _bits+    peek ptr = do+        b <- peek $ castPtr ptr+        return $! BitSet (popCount b) b+    poke ptr = poke (castPtr ptr) . _bits+ instance Num c => Foldable.Foldable (GBitSet c) where+#if MIN_VERSION_base(4, 6, 0)+    foldl' = foldl'+#endif+    foldr  = foldr+     foldMap f (BitSet { _n, _bits }) = go _n 0 where         go 0 _b = mempty         go !n b = if _bits `testBit` b@@ -129,12 +153,12 @@ {-# INLINE size #-}  -- | /O(d)/. Ask whether the item is in the bit set.-member :: a -> GBitSet c a -> Bool-member x (BitSet { _bits }) = _bits `testBit` fromEnum x+member :: (Enum a , Bits c) => a -> GBitSet c a -> Bool+member x = (`testBit` fromEnum x) . _bits {-# INLINE member #-}  -- | /O(d)/. Ask whether the item is in the bit set.-notMember :: a -> GBitSet c a -> Bool+notMember :: (Enum a, Bits c) => a -> GBitSet c a -> Bool notMember x = not . member x {-# INLINE notMember #-} @@ -143,10 +167,12 @@ isSubsetOf :: GBitSet c a -> GBitSet c a -> Bool isSubsetOf (BitSet { _n = n1, _bits = b1 }) (BitSet { _n = n2, _bits = b2 }) =     n2 >= n1 && b2 .|. b1 == b2+{-# INLINE isSubsetOf #-}  -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal). isProperSubsetOf :: Eq c => GBitSet c a -> GBitSet c a -> Bool isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2+{-# INLINE isProperSubsetOf #-}  -- | The empty bit set. empty :: (Enum a, Bits c, Num c) => GBitSet c a@@ -174,14 +200,8 @@ union :: GBitSet c a -> GBitSet c a -> GBitSet c a union (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =     let b = b1 .|. b2 in BitSet { _n = popCount b, _bits = b }- {-# INLINE union #-} --- | /O(max(m, n))/. The union of a list of bit sets.-unions :: (Enum a, Bits c, Num c) => [GBitSet c a] -> GBitSet c a-unions = List.foldl' union empty-{-# INLINE unions #-}- -- | /O(max(m, n))/. Difference of two bit sets. difference :: GBitSet c a -> GBitSet c a -> GBitSet c a difference (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =@@ -201,21 +221,59 @@ {-# INLINE intersection #-}  -- | /O(d * n)/ Transform this bit set by applying a function to every--- value. Resulting bit set may be smaller then the original.+-- value.  Resulting bit set may be smaller then the original. map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> GBitSet c a -> GBitSet c b map f = fromList . List.map f . toList+{-# INLINE map #-} +-- | /O(d * n)/ Reduce this bit set by applying a binary function to all+-- elements, using the given starting value.  Each application of the+-- operator is evaluated before before using the result in the next+-- application.  This function is strict in the starting value.+foldl' :: (b -> a -> b) -> b -> GBitSet c a -> b+foldl' f acc0  (BitSet { _n, _bits }) = go acc0 _n 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)+{-# INLINE foldl' #-}++-- | /O(d * n)/ Reduce this bit set by applying a binary function to+-- all elements, using the given starting value.+foldr :: (a -> b -> b) -> b -> GBitSet c a -> b+foldr f acc0 (BitSet { _n, _bits }) = go _n 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)+{-# INLINE foldr #-}+ -- | /O(d * n)/ Filter this bit set by retaining only elements satisfying -- predicate. filter :: (Enum a, Bits c, Num c) => (a -> Bool) -> GBitSet c a -> GBitSet c a filter f = fromList . List.filter f . toList+{-# INLINE filter #-} --- | /O(d * n)/. Convert the bit set set to a list of elements.+-- | /O(d * n)/. Convert this bit set set to a list of elements. toList :: Num c => GBitSet c a -> [a]-toList = Foldable.toList+toList bs = build (\f acc -> foldr f acc bs)+{-# INLINE toList #-}  -- | /O(d * n)/. Make a bit set from a list of elements. fromList :: (Enum a, Bits c, Num c) => [a] -> GBitSet c a fromList xs = BitSet { _n = popCount b, _bits = b } where-  b = List.foldl' (\i x -> setBit i (fromEnum x)) 0 xs+  b = List.foldl' (\i x -> i `setBit` fromEnum x) 0 xs {-# INLINE fromList #-}++-- | /O(1)/. Internal function, which extracts the underlying container+-- from the bit set.+toBits :: GBitSet c a -> c+toBits = _bits+{-# INLINE toBits #-}++-- | /O(1)/. Internal function, which constructs a bit set, using a given+-- container value. Highly unsafe, because we don't check if bits in the+-- given value correspond to valid instances of type @a@.+unsafeFromBits :: (Enum a, Bits c, Num c) => c -> GBitSet c a+unsafeFromBits b = BitSet { _n = popCount b, _bits = b }+{-# INLINE unsafeFromBits #-}

@@ -0,0 +1,183 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.BitSet.Word+-- Copyright   :  (c) Sergei Lebedev, Aleksey Kladov, Fedor Gogolev 2013+--                Based on Data.BitSet (c) Denis Bueno 2008-2009+-- License     :  MIT+-- Maintainer  :  superbobry@gmail.com+-- Stability   :  experimental+-- Portability :  GHC+--+-- A space-efficient implementation of set data structure for enumerated+-- data types.+--+-- /Note/: Read below the synopsis for important notes on the use of+-- this module.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import Data.BitSet.Word (BitSet)+-- > import qualified Data.BitSet.Word as BS+--+-- The implementation uses 'Word' as underlying container, thus the+-- maximum number of elements you can store in this bit set is bounded+-- by the number of bits in 'Word' data type. However, due to native bitwise+-- operations "Data.BitSet.Word" is significantly faster then "Data.Set"+-- on all operations.++module Data.BitSet.Word+    (+    -- * Bit set type+      BitSet++    -- * Operators+    , (\\)++    -- * Construction+    , empty+    , singleton+    , insert+    , delete++    -- * Query+    , null+    , size+    , member+    , notMember+    , isSubsetOf+    , isProperSubsetOf++    -- * Combine+    , union+    , difference+    , intersection++    -- * Transformations+    , map++    -- * Folds+    , foldl'+    , foldr++    -- * Filter+    , filter++    -- * Lists+    , toList+    , fromList+    ) where++import Prelude hiding (null, map, filter, foldr)++import Data.Word (Word)++import Data.BitSet.Generic (GBitSet)+import qualified Data.BitSet.Generic as GS++type BitSet = GBitSet Word++-- | /O(1)/. Is the bit set empty?+null :: BitSet a -> Bool+null = GS.null+{-# INLINE null #-}++-- | /O(1)/. The number of elements in the bit set.+size :: BitSet a -> Int+size = GS.size+{-# INLINE size #-}++-- | /O(1)/. Ask whether the item is in the bit set.+member :: Enum a => a -> BitSet a -> Bool+member = GS.member+{-# INLINE member #-}++-- | /O(1)/. Ask whether the item is in the bit set.+notMember :: Enum a => a -> BitSet a -> Bool+notMember = GS.notMember+{-# INLINE notMember #-}++-- | /O(1)/. Is this a subset? (@s1 isSubsetOf s2@) tells whether+-- @s1@ is a subset of @s2@.+isSubsetOf :: BitSet a -> BitSet a -> Bool+isSubsetOf = GS.isSubsetOf+{-# INLINE isSubsetOf #-}++-- | /O(1)/. Is this a proper subset? (ie. a subset but not equal).+isProperSubsetOf :: BitSet a -> BitSet a -> Bool+isProperSubsetOf = GS.isProperSubsetOf+{-# INLINE isProperSubsetOf #-}++-- | The empty bit set.+empty :: Enum a => BitSet a+empty = GS.empty+{-# INLINE empty #-}++-- | O(1). Create a singleton set.+singleton :: Enum a => a -> BitSet a+singleton = GS.singleton+{-# INLINE singleton #-}++-- | /O(1)/. Insert an item into the bit set.+insert :: a -> BitSet a -> BitSet a+insert = GS.insert+{-# INLINE insert #-}++-- | /O(1)/. Delete an item from the bit set.+delete :: a -> BitSet a -> BitSet a+delete = GS.delete+{-# INLINE delete #-}++-- | /O(1)/. The union of two bit sets.+union :: BitSet a -> BitSet a -> BitSet a+union = GS.union+{-# INLINE union #-}++-- | /O(1)/. Difference of two bit sets.+difference :: BitSet a -> BitSet a -> BitSet a+difference = GS.difference+{-# INLINE difference #-}++-- | /O(1)/. See `difference'.+(\\) :: BitSet a -> BitSet a -> BitSet a+(\\) = difference++-- | /O(1)/. The intersection of two bit sets.+intersection :: BitSet a -> BitSet a -> BitSet a+intersection = GS.intersection+{-# INLINE 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++-- | /O(n)/ Reduce this bit set by applying a binary function to all+-- elements, using the given starting value.  Each application of the+-- operator is evaluated before before using the result in the next+-- application.  This function is strict in the starting value.+foldl' :: (b -> a -> b) -> b -> BitSet a -> b+foldl' = GS.foldl'+{-# INLINE foldl' #-}++-- | /O(n)/ Reduce this bit set by applying a binary function to all+-- elements, using the given starting value.+foldr :: (a -> b -> b) -> b -> BitSet a -> b+foldr = GS.foldr+{-# 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+{-# INLINE filter #-}++-- | /O(n)/. Convert the bit set set to a list of elements.+toList :: BitSet a -> [a]+toList = GS.toList+{-# INLINE toList #-}++-- | /O(n)/. Make a bit set from a list of elements.+fromList :: Enum a => [a] -> BitSet a+fromList = GS.fromList+{-# INLINE fromList #-}

@@ -7,17 +7,24 @@ import Data.List ((\\), intersect, union, nub, sort) import Data.Monoid ((<>), mempty) import Data.Word (Word16)+import Foreign (Storable(..), allocaBytes)  import Test.Framework (Test, defaultMain) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Property, Arbitrary(..), (==>), classify)+import Test.QuickCheck.Monadic (monadicIO, assert, run)  import Data.BitSet (BitSet)+import Data.BitSet.Generic (GBitSet) 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 (GBitSet Word16 a) where+    arbitrary = GS.fromList <$> arbitrary+ instance Show (Word16 -> a) where     show = const "FUNCTION" @@ -73,14 +80,6 @@ propEmpty :: Word16 -> Bool propEmpty x = x `BS.notMember` BS.empty -propUnions :: [Word16] -> Bool-propUnions xs = all (`BS.member` bs) xs where-  n      = length xs-  (l, r) = splitAt (n `div` 2) xs--  bs :: BitSet Word16-  bs = BS.unions $ map BS.fromList [l, r, l, r, l]- propIntersectionWithSelf :: [Word16] -> Bool propIntersectionWithSelf xs = all (`BS.member` bs) xs   where@@ -158,6 +157,16 @@ propFilter :: BitSet Word16 -> (Word16 -> Bool) -> Bool propFilter bs f = BS.filter f bs == (BS.fromList $ filter f $ BS.toList bs) +propStorable :: GBitSet Word16 Word16 -> Property+propStorable storable = monadicIO $ do+    peeked <- run $ do+        allocaBytes size $ \ptr -> do+            poke ptr storable+            peek ptr+    assert $ storable == peeked+  where+    size = sizeOf storable+ main :: IO () main = defaultMain tests where   tests :: [Test]@@ -172,7 +181,6 @@           , testProperty "toList" propToList           , testProperty "fromList" propFromList           , testProperty "empty" propEmpty-          , testProperty "unions" propUnions           , testProperty "intersection with self" propIntersectionWithSelf           , testProperty "intersection" propIntersection           , testProperty "difference with self" propDifferenceWithSelf@@ -183,4 +191,5 @@           , testProperty "show read" propShowRead           , testProperty "map" propMap           , testProperty "filter" propFilter+          , testProperty "storable instance" propStorable           ]