bitset 1.2 → 1.3.0

raw patch · 7 files changed

+674/−259 lines, 7 filesdep +containersdep +ghc-primdep +integer-gmpdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: containers, ghc-prim, integer-gmp, random, random-shuffle

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• benchmarks/Benchmarks.hs +86/−4
• bitset.cabal +29/−21
• src/Data/BitSet.hs +24/−180
• src/Data/BitSet/Dynamic.hs +247/−0
• src/Data/BitSet/Generic.hs +221/−0
• tests/Tests.hs +66/−53

@@ -1,4 +1,4 @@-Copyright (c) 2013 Sergei Lebedev+Copyright (c) 2013 Sergei Lebedev, Aleksey Kladov  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction,

@@ -1,14 +1,96 @@+{-# LANGUAGE ExistentialQuantification #-}+ module Main (main) where -import Criterion.Main (defaultMain, bench, nf)+import Data.List (foldl') -import qualified Data.BitSet as BitSet+import Control.DeepSeq (NFData(..))+import Criterion.Main (defaultMain, bench, bgroup, nf)+import Data.Set (Set)+import System.Random (mkStdGen)+import System.Random.Shuffle (shuffle')+import qualified Data.Set as Set +import Data.BitSet (BitSet)+import qualified Data.BitSet as BS++data B = forall a. NFData a => B a++instance NFData B where+    rnf (B b) = rnf b+ main :: IO () main = do+    let bs1 = BS.fromList elems1+        bs2 = BS.fromList elems2+        s1  = Set.fromList elems1+        s2  = Set.fromList elems2+        r   = mkStdGen 42+        shuffledElems1 = shuffle' elems1 n r+        shuffledElems2 = shuffle' elems2 (n `div` 2) r+    return $ rnf [B bs1, B bs2, B s1, B s2, B shuffledElems1, B shuffledElems2]     defaultMain-        [ bench "fromList" (nf BitSet.fromList [1..n])+        [ 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)+          ]++        , 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)+          ]         ]   where     n :: Int-    n = 1024+    n = 128++    elems1 = [1..n]+    elems2 = [1..n `div` 2]++memberS :: [Int] -> Set Int -> Bool+memberS xs s = all (\x -> Set.member x s) xs++memberBS :: [Int] -> BitSet Int -> Bool+memberBS xs bs = all (\x -> BS.member x bs) xs++notMemberS :: [Int] -> Set Int -> Bool+notMemberS xs s = all (\x -> Set.notMember x s) xs++notMemberBS :: [Int] -> BitSet Int -> Bool+notMemberBS xs bs = all (\x -> BS.notMember x bs) xs++insertS :: [Int] -> Set Int -> Set Int+insertS xs s0 = foldl' (\s x -> Set.insert x s) s0 xs++insertBS :: [Int] -> BitSet Int -> BitSet Int+insertBS xs bs0 = foldl' (\bs x -> BS.insert x bs) bs0 xs++deleteS :: [Int] -> Set Int -> Set Int+deleteS xs s0 = foldl' (\s x -> Set.delete x s) s0 xs++deleteBS :: [Int] -> BitSet Int -> BitSet Int+deleteBS xs bs0 = foldl' (\bs x -> BS.delete x bs) bs0 xs

@@ -1,33 +1,40 @@ Name:                 bitset-Version:              1.2-Synopsis:             A compact functional set data structure.+Version:              1.3.0+Synopsis:             A space-efficient set data structure. Description:   A /bit set/ is a compact data structure, which maintains a set of members-  from a type that can be enumerated (i. e. has an `Enum' instance). Current-  implementations uses @Integer@ for as bit storage and provides most of the-  expected set operations: insertion, deletion, intersection, membership-  testing etc.+  from a type that can be enumerated (i. e. has an `Enum' instance). Category:             Data Structures License:              MIT License-file:         LICENSE Data-files:           CHANGES Author:               Sergei Lebedev <superbobry@gmail.com>-Maintainer:           Sergei Lebedev <superbobry@gmail.com>-Stability:            Alpha+                    , Aleksey Kladov <aleksey.kladov@gmail.com>+                    , Fedor Gogolev <knsd@knsd.net>+Maintainer:           superbobry@gmail.com+Bug-reports:          http://github.com/superbobry/bitset/issues+Stability:            Experimental Cabal-Version:        >= 1.12 Build-type:           Simple Tested-with:          GHC >= 7.4.2 +Source-repository head+  Type:     git+  Location: https://github.com/superbobry/bitset+ Library   Hs-source-dirs:     src-  Ghc-options:        -Wall+  Ghc-options:        -Wall -fno-warn-orphans   Default-language:   Haskell2010 -  Build-depends:      base                    >= 4.5.1 && < 4.7+  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  Test-suite bitset-tests   Hs-source-dirs:     tests@@ -37,25 +44,26 @@   Type:               exitcode-stdio-1.0   Main-is:            Tests.hs -  Build-depends:      base                       >= 4.5.1 && < 4.7+  Build-depends:      base                       >= 4.4.0 && < 4.7                     , QuickCheck                 == 2.5.*                     , test-framework             == 0.6.*                     , test-framework-quickcheck2 == 0.2.*                     , bitset  Benchmark bitset-benchmarks-  Main-is: Benchmarks.hs-  Hs-source-dirs:     tests, benchmarks+  Hs-source-dirs:     src benchmarks+  Ghc-options:        -Wall -O2 -optc-O3 -optc-msse4.1 -fno-warn-orphans   Default-language:   Haskell2010+   Type:               exitcode-stdio-1.0+  Main-is:            Benchmarks.hs -  Build-depends:      base                        >= 4.5.1 || < 4.7+  Build-depends:      base                        >= 4.4.0 || < 4.7                     , deepseq                     == 1.3.*-                    , bitset+                    , integer-gmp+                    , ghc-prim                      , criterion                   == 0.6.*---Source-repository head-  Type:     git-  Location: https://github.com/superbobry/bitset+                    , containers                  >= 0.4.2+                    , random                      == 1.0.*+                    , random-shuffle              == 0.0.3

@@ -1,184 +1,28 @@-{-# LANGUAGE DeriveDataTypeable #-}---- | A /bit set/ maintains a record of members from a type that can be--- enumerated (i. e. has and `Enum' instance). The maximum number of elements--- that can be stored is @maxBound :: Int@.+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.BitSet.Dynamic+-- 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 ----- To use this library, define a `Enum' instance for your data type or--- have it derived. It is important that the values you intend to store--- in a bit set start from 0 and go up. A value for which @fromEnum x@ is @n@--- corresponds to bit location @n@ in an @Integer@, and thus requires that--- @Integer@ to have at least @n@ bits.+-- A space-efficient implementation of set data structure enumerated+-- data types. ----- /Note/: The idea of using `Integer' as bit storage for a bit set was--- borrowed from an unsupported `Data.BitSet' implementation by Denis Bueno.-module Data.BitSet-    (-    -- * Bit set type-      BitSet--    -- * Operators-    , (\\)--    -- * Query-    , null-    , size-    , member-    , notMember-    , isSubsetOf-    , isProperSubsetOf--    -- * Construction-    , empty-    , singleton-    , insert-    , delete--    -- * Combine-    , union-    , unions-    , difference-    , intersection--    -- * Conversion-    -- ** List-    , elems-    , toList-    , fromList-    -- ** Arbitraty integral type-    , toIntegral-    , unsafeFromIntegral-    ) where--import Prelude hiding (null)--import Data.Bits (Bits, (.|.), (.&.), complement,-                  testBit, setBit, clearBit, shiftR, popCount)-import Data.Data (Data, Typeable)-import Data.List (foldl')-import Data.Monoid (Monoid(..))--import Control.DeepSeq (NFData(..))--data BitSet a = BitSet {-# UNPACK #-} !Int !Integer-    deriving (Eq, Ord, Data, Typeable)--instance Enum a => Monoid (BitSet a) where-    mempty  = empty-    mappend = union-    mconcat = unions--instance (Enum a, Show a) => Show (BitSet a) where-    show bs = "fromList " ++ show (elems bs)--instance NFData (BitSet a) where-    rnf (BitSet count i) = rnf count `seq` rnf i `seq` ()----- | /O(1)/. Is the bit set empty?-null :: BitSet a -> Bool-null (BitSet _n i) = i == 0-{-# INLINE null #-}---- | /O(1)/. The number of elements in the bit set.-size :: BitSet a -> Int-size (BitSet n _i) = n-{-# INLINE size #-}---- | /O(testBit on Integer)/. Ask whether the item is in the bit set.-member :: Enum a => a -> BitSet a -> Bool-member x (BitSet _n i) = testBit i (fromEnum x)-{-# INLINE member #-}---- | /O(testBit on Integer)/. Ask whether the item is in the bit set.-notMember :: Enum a => a -> BitSet a -> Bool-notMember bs = not . member bs-{-# INLINE notMember #-}---- | /O(max(n, m))/.. Is this a subset? (@s1 isSubsetOf s2@) tells whether--- @s1@ is a subset of @s2@.-isSubsetOf :: Enum a => BitSet a -> BitSet a -> Bool-isSubsetOf (BitSet n1 i1) (BitSet n2 i2) = n2 >= n1 && i2 .|. i1 == i2---- | /O(max(n, m)/.. Is this a proper subset? (ie. a subset but not equal).-isProperSubsetOf :: Enum a => BitSet a -> BitSet a -> Bool-isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2---- | The empty bit set.-empty :: BitSet a-empty = BitSet 0 0-{-# INLINE empty #-}---- | O(setBit on Integer). Create a singleton set.-singleton :: Enum a => a -> BitSet a-singleton x = insert x empty-{-# INLINE singleton #-}---- | /O(setBit on Integer)/. Insert an item into the bit set.-insert :: Enum a => a -> BitSet a -> BitSet a-insert x (BitSet n i) = BitSet n' $ setBit i e where-  n' = if testBit i e then n else n + 1-  e  = fromEnum x-{-# INLINE insert #-}---- | /O(clearBit on Integer)/. Delete an item from the bit set.-delete :: Enum a => a -> BitSet a -> BitSet a-delete x (BitSet n i) = BitSet n' $ clearBit i e where-  n' = if testBit i e then n - 1 else n-  e  = fromEnum x-{-# INLINE delete #-}---- | /O(max(m, n))/. The union of two bit sets.-union :: Enum a => BitSet a -> BitSet a -> BitSet a-union (BitSet _n1 i1) (BitSet _n2 i2) = BitSet (popCount i) i where-  i = i1 .|. i2-{-# INLINE union #-}---- | /O(max(m, n))/. The union of a list of bit sets.-unions :: Enum a => [BitSet a] -> BitSet a-unions = foldl' union empty-{-# INLINE unions #-}---- | /O(max(m, n))/. Difference of two bit sets.-difference :: Enum a => BitSet a -> BitSet a -> BitSet a-difference (BitSet _n1 i1) (BitSet _n2 i2) = BitSet (popCount i) i where-  i = i1 .&. complement i2---- | /O(max(m, n))/. See `difference'.-(\\) :: Enum a => BitSet a -> BitSet a -> BitSet a-(\\) = difference---- | /O(max(m, n))/. The intersection of two bit sets.-intersection :: Enum a => BitSet a -> BitSet a -> BitSet a-intersection (BitSet _n1 i1) (BitSet _n2 i2) = BitSet (popCount i) i where-  i = i1 .&. i2---- | /O(n * shiftR on Integer)/. An alias to @toList@.-elems :: Enum a => BitSet a -> [a]-elems = toList---- | /O(n * shiftR on Integer)/. Convert a bit set to a list of elements.-toList :: Enum a => BitSet a -> [a]-toList (BitSet _i n0) = go 0 n0 [] where-  go _i 0 acc = reverse acc-  go i n acc  = if n `testBit` 0-                then go (i + 1) (shiftR n 1) (toEnum i : acc)-                else go (i + 1) (shiftR n 1) acc---- | /O(n * setBit on Integer)/. Make a bit set from a list of elements.-fromList :: Enum a => [a] -> BitSet a-fromList xs = BitSet (popCount i) i where-  i = foldl' (\b x -> setBit b (fromEnum x)) 0 xs+-- /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. --- | /O(1)/. Project a bit set to an integral type.-toIntegral :: Integral b => BitSet a -> b-toIntegral (BitSet _n i) = fromIntegral i-{-# INLINE toIntegral #-}+module Data.BitSet ( module Data.BitSet.Dynamic ) where --- | /O(n)/. Make a bit set from an integral. Unsafe because we don't--- checked whether the bits set in a given value correspond to values--- of type @a@. This is only useful as a more efficient alternative to--- fromList.-unsafeFromIntegral :: Integral b => b -> BitSet a-unsafeFromIntegral x = let i = fromIntegral x in BitSet (popCount i) i-{-# INLINE unsafeFromIntegral #-}+import Data.BitSet.Dynamic

@@ -0,0 +1,247 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.BitSet.Dynamic+-- 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 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.Dynamic (BitSet)+-- > import qualified Data.BitSet.Dynamic as BS+--+-- The implementation uses 'Integer' as underlying container, thus it+-- grows automatically when more elements are inserted into the bit set.++module Data.BitSet.Dynamic+    (+    -- * Bit set type+      FasterInteger+    , BitSet+    -- * Operators+    , (\\)++    -- * Construction+    , empty+    , singleton+    , insert+    , delete++    -- * Query+    , null+    , size+    , member+    , notMember+    , isSubsetOf+    , isProperSubsetOf++    -- * Combine+    , union+    , unions+    , difference+    , intersection++    -- * Transformations+    , map++    -- * Filter+    , filter++    -- * Lists+    , toList+    , fromList+    ) where++import Prelude hiding (null, map, filter)++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.Word (Word(..))++import Control.DeepSeq (NFData(..))++import Data.BitSet.Generic (GBitSet(..))+import qualified Data.BitSet.Generic as BS++-- | A wrapper around 'Integer' which provides faster bit-level operations.+newtype FasterInteger = FasterInteger { unFI :: Integer }+    deriving (Read, Show, Eq, Ord, Enum, Integral, Num, Real, NFData)++instance Bits FasterInteger where+    FasterInteger x .&. FasterInteger y = FasterInteger $ x .&. y+    {-# INLINE (.&.) #-}++    FasterInteger x .|. FasterInteger y = FasterInteger $ x .|. y+    {-# INLINE (.|.) #-}++    FasterInteger x `xor` FasterInteger y = FasterInteger $ x `xor` y+    {-# INLINE xor #-}++    complement = FasterInteger . complement . unFI+    {-# INLINE complement #-}++    shift (FasterInteger x) i = FasterInteger $ shift x i+    {-# INLINE shift #-}++    rotate (FasterInteger x) i = FasterInteger $ rotate x i+    {-# INLINE rotate #-}++    bit = FasterInteger . bit+    {-# INLINE bit #-}++    testBit (FasterInteger x) i = testBitInteger x i+    {-# INLINE testBit #-}++    popCount (FasterInteger x) = I# (word2Int# (popCountInteger x))++    bitSize = bitSize . unFI+    {-# INLINE bitSize #-}++    isSigned = isSigned . unFI+    {-# INLINE isSigned #-}++type BitSet = GBitSet FasterInteger++-- | /O(1)/. Is the bit set empty?+null :: BitSet a -> Bool+null = BS.null+{-# INLINE null #-}++-- | /O(1)/. The number of elements in the bit set.+size :: BitSet a -> Int+size = BS.size+{-# INLINE size #-}++-- | /O(1)/. Ask whether the item is in the bit set.+member :: a -> BitSet a -> Bool+member = BS.member+{-# INLINE member #-}++-- | /O(1)/. Ask whether the item is in the bit set.+notMember :: a -> BitSet a -> Bool+notMember = BS.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++-- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal).+isProperSubsetOf :: BitSet a -> BitSet a -> Bool+isProperSubsetOf = BS.isProperSubsetOf++-- | The empty bit set.+empty :: Enum a => BitSet a+empty = BS.empty+{-# INLINE empty #-}++-- | O(1). Create a singleton set.+singleton :: Enum a => a -> BitSet a+singleton = BS.singleton+{-# INLINE singleton #-}++-- | /O(1)/. Insert an item into the bit set.+insert :: a -> BitSet a -> BitSet a+insert = BS.insert+{-# INLINE insert #-}++-- | /O(1)/. Delete an item from the bit set.+delete :: a -> BitSet a -> BitSet a+delete = BS.delete+{-# INLINE delete #-}++-- | /O(max(m, n))/. The union of two bit sets.+union :: BitSet a -> BitSet a -> BitSet a+union = BS.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.+difference :: BitSet a -> BitSet a -> BitSet a+difference = BS.difference+{-# INLINE difference #-}++-- | /O(max(m, n))/. See `difference'.+(\\) :: BitSet a -> BitSet a -> BitSet a+(\\) = difference++-- | /O(max(m, n))/. The intersection of two bit sets.+intersection :: BitSet a -> BitSet a -> BitSet a+intersection = BS.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++-- | /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++-- | /O(n)/. Convert the bit set set to a list of elements.+toList :: BitSet a -> [a]+toList = BS.toList++-- | /O(n)/. Make a bit set from a list of elements.+fromList :: Enum a => [a] -> BitSet a+fromList = BS.fromList+{-# INLINE fromList #-}++popCountInteger :: Integer -> Word#+popCountInteger (S# i#)    = popCnt# (int2Word# i#)+popCountInteger (J# s# d#) = go 0# (int2Word# 0#) where+  go i acc =+      if i ==# s#+      then acc+      else go (i +# 1#) $ acc `plusWord#` popCnt# (indexWordArray# d# i)+{-# INLINE popCountInteger #-}++#include "MachDeps.h"+#ifndef WORD_SIZE_IN_BITS+#error WORD_SIZE_IN_BITS not defined!+#endif++-- Note(superbobry): this will be irrelevant after the new GHC release.+testBitInteger :: Integer -> Int -> Bool+testBitInteger (S# i#) b = I# i# `testBit` b+testBitInteger (J# s# d#) (I# b#) =+    if block# >=# s#+    then False+    else W# (indexWordArray# d# block#) `testBit` I# offset#+  where+    n# :: Int#+    n# = WORD_SIZE_IN_BITS#++    block# :: Int#+    !block# = b# `divInt#` n#++    offset# :: Int#+    !offset# = b# `modInt#` n#+{-# INLINE testBitInteger #-}

@@ -0,0 +1,221 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.BitSet.Generic+-- 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.Generic (BitSet)+-- > import qualified Data.BitSet.Generic as BS+--+-- The implementation is abstract with respect to conatiner 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 GADTs #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Data.BitSet.Generic+    (+    -- * Bit set type+      GBitSet(..)+    -- * Operators+    , (\\)++    -- * Construction+    , empty+    , singleton+    , insert+    , delete++    -- * Query+    , null+    , size+    , member+    , notMember+    , isSubsetOf+    , isProperSubsetOf++    -- * Combine+    , union+    , unions+    , difference+    , intersection++    -- * Transformations+    , map++    -- * Filter+    , filter++    -- * Lists+    , toList+    , fromList+    ) where++import Prelude hiding (null, map, filter)++import Control.Applicative ((<$>))+import Control.DeepSeq (NFData(..))+import Data.Bits (Bits, (.|.), (.&.), complement, bit,+                  testBit, setBit, clearBit, popCount)+import Data.Data (Typeable)+import Data.Function (on)+import Data.Monoid (Monoid(..), (<>))+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.+                          }+    deriving Typeable++instance Eq (GBitSet c a) where+    (==) = (==) `on` _n++instance Ord (GBitSet c a) where+    compare = compare `on` _n++instance (Enum a, Read a, Bits c, Num c) => Read (GBitSet c a) where+    readPrec = parens . prec 10 $ do+        Ident "fromList" <- lexP+        fromList <$> readPrec++instance (Show a, Num c) => Show (GBitSet c a) where+    showsPrec p bs = showParen (p > 10) $+                     showString "fromList " . shows (toList bs)++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 Num c => Foldable.Foldable (GBitSet c) where+    foldMap f (BitSet { _n, _bits }) = go _n 0 where+        go 0 _b = mempty+        go !n b = if _bits `testBit` b+                  then f (toEnum b) <> go (pred n) (succ b)+                  else go n (succ b)++-- | /O(1)/. Is the bit set empty?+null :: GBitSet c a -> Bool+null (BitSet { _bits }) = _bits == 0+{-# INLINE null #-}++-- | /O(1)/. The number of elements in the bit set.+size :: GBitSet c a -> Int+size = _n+{-# 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+{-# INLINE member #-}++-- | /O(d)/. Ask whether the item is in the bit set.+notMember :: a -> GBitSet c a -> Bool+notMember x = not . member x+{-# INLINE notMember #-}++-- | /O(max(n, m))/. Is this a subset? (@s1 isSubsetOf s2@) tells whether+-- @s1@ is a subset of @s2@.+isSubsetOf :: GBitSet c a -> GBitSet c a -> Bool+isSubsetOf (BitSet { _n = n1, _bits = b1 }) (BitSet { _n = n2, _bits = b2 }) =+    n2 >= n1 && b2 .|. b1 == b2++-- | /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++-- | The empty bit set.+empty :: (Enum a, Bits c, Num c) => GBitSet c a+empty = BitSet { _n = 0, _bits = 0 }+{-# INLINE empty #-}++-- | O(1). Create a singleton set.+singleton :: (Enum a, Bits c, Num c) => a -> GBitSet c a+singleton x = BitSet { _n = 1, _bits = bit $! fromEnum x }+{-# INLINE singleton #-}++-- | /O(d)/. Insert an item into the bit set.+insert :: a -> GBitSet c a -> GBitSet c a+insert x bs@(BitSet { _bits }) =+    let b = _bits `setBit` fromEnum x in bs { _n = popCount b, _bits = b }+{-# INLINE insert #-}++-- | /O(d)/. Delete an item from the bit set.+delete :: a -> GBitSet c a -> GBitSet c a+delete x bs@(BitSet { _bits }) =+    let b = _bits `clearBit` fromEnum x in bs { _n = popCount b, _bits = b }+{-# INLINE delete #-}++-- | /O(max(m, n))/. The union of two bit sets.+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 }) =+    let b = b1 .&. complement b2 in BitSet { _n = popCount b, _bits = b }+{-# INLINE difference #-}++-- | /O(max(m, n))/. See 'difference'.+(\\) :: GBitSet c a -> GBitSet c a -> GBitSet c a+(\\) = difference++-- | /O(max(m, n))/. The intersection of two bit sets.+intersection :: GBitSet c a -> GBitSet c a -> GBitSet c a+intersection (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =+    BitSet { _n = popCount b, _bits = b }+  where+    b = b1 .&. b2+{-# 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.+map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> GBitSet c a -> GBitSet c b+map f = fromList . List.map f . toList++-- | /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++-- | /O(d * n)/. Convert the bit set set to a list of elements.+toList :: Num c => GBitSet c a -> [a]+toList = Foldable.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+{-# INLINE fromList #-}

@@ -1,8 +1,11 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+ module Main (main) where  import Control.Applicative ((<$>)) import Data.List ((\\), intersect, union, nub, sort)-import Data.Monoid (mempty, mappend)+import Data.Monoid ((<>), mempty) import Data.Word (Word16)  import Test.Framework (Test, defaultMain)@@ -10,88 +13,85 @@ import Test.QuickCheck (Property, Arbitrary(..), (==>), classify)  import Data.BitSet (BitSet)-import qualified Data.BitSet as BitSet+import qualified Data.BitSet as BS  instance (Arbitrary a, Enum a) => Arbitrary (BitSet a) where-    arbitrary = BitSet.fromList <$> arbitrary+    arbitrary = BS.fromList <$> arbitrary +instance Show (Word16 -> a) where+    show = const "FUNCTION"  propSize :: [Word16] -> Bool propSize = go . nub where-  go xs = length xs == BitSet.size (BitSet.fromList xs)+  go xs = length xs == BS.size (BS.fromList xs)  propSizeAfterInsert :: Word16 -> BitSet Word16 -> Bool propSizeAfterInsert x bs =-    BitSet.size (BitSet.insert x bs) == BitSet.size bs + diff+    BS.size (BS.insert x bs) == BS.size bs + diff   where     diff :: Int-    diff = if x `BitSet.member` bs then 0 else 1+    diff = if x `BS.member` bs then 0 else 1  propSizeAfterDelete :: Word16 -> BitSet Word16 -> Bool propSizeAfterDelete x bs =-    BitSet.size (BitSet.delete x bs) == BitSet.size bs - diff+    BS.size (BS.delete x bs) == BS.size bs - diff   where     diff :: Int-    diff = if x `BitSet.member` bs then 1 else 0+    diff = if x `BS.member` bs then 1 else 0  propInsertMember :: Word16 -> BitSet Word16 -> Bool-propInsertMember x bs = x `BitSet.member` BitSet.insert x bs+propInsertMember x bs = x `BS.member` BS.insert x bs  propDeleteMember :: Word16 -> BitSet Word16 -> Bool-propDeleteMember x bs = x `BitSet.notMember` BitSet.delete x bs+propDeleteMember x bs = x `BS.notMember` BS.delete x bs  propInsertDeleteIdempotent :: Word16 -> BitSet Word16 -> Property propInsertDeleteIdempotent x bs =-    x `BitSet.notMember` bs ==> bs == BitSet.delete x (BitSet.insert x bs)+    x `BS.notMember` bs ==>+    bs == BS.delete x (BS.insert x bs)  propDeleteIdempotent :: Word16 -> BitSet Word16 -> Property propDeleteIdempotent x bs =-    classify (x `BitSet.member` bs) "x in bs" $-    classify (x `BitSet.notMember` bs) "x not in bs" $-    BitSet.delete x bs == BitSet.delete x (BitSet.delete x bs)+    classify (x `BS.member` bs) "x in bs" $+    classify (x `BS.notMember` bs) "x not in bs" $+    BS.delete x bs == BS.delete x (BS.delete x bs)  propInsertIdempotent :: Word16 -> BitSet Word16 -> Bool propInsertIdempotent x bs =-    BitSet.insert x bs == BitSet.insert x (BitSet.insert x bs)+    BS.insert x bs == BS.insert x (BS.insert x bs)  propToList :: [Word16] -> Bool-propToList xs = nub (sort xs) == BitSet.toList bs where+propToList xs = nub (sort xs) == BS.toList bs where   bs :: BitSet Word16-  bs = BitSet.fromList xs+  bs = BS.fromList xs  propFromList :: [Word16] -> Bool-propFromList xs = all (`BitSet.member` bs) xs where+propFromList xs = all (`BS.member` bs) xs where   bs :: BitSet Word16-  bs = BitSet.fromList xs+  bs = BS.fromList xs  propEmpty :: Word16 -> Bool-propEmpty x = x `BitSet.notMember` BitSet.empty--propUnsafeFromIntegral :: Word16 -> Bool-propUnsafeFromIntegral x =-    bs == BitSet.unsafeFromIntegral (BitSet.toIntegral bs :: Integer)-  where-    bs :: BitSet Word16-    bs = BitSet.singleton x+propEmpty x = x `BS.notMember` BS.empty  propUnions :: [Word16] -> Bool-propUnions xs = all (`BitSet.member` bs) xs where+propUnions xs = all (`BS.member` bs) xs where   n      = length xs   (l, r) = splitAt (n `div` 2) xs    bs :: BitSet Word16-  bs = BitSet.unions $ map BitSet.fromList [l, r, l, r, l]+  bs = BS.unions $ map BS.fromList [l, r, l, r, l]  propIntersectionWithSelf :: [Word16] -> Bool-propIntersectionWithSelf xs = all (`BitSet.member` bs) xs+propIntersectionWithSelf xs = all (`BS.member` bs) xs   where     bs :: BitSet Word16-    bs = let bs0 = BitSet.fromList xs in bs0 `BitSet.intersection` bs0+    bs = let bs0 = BS.fromList xs in+         bs0 `BS.intersection` bs0  propIntersection :: [Word16] -> Bool propIntersection xs =-    all (`BitSet.member` bs) (l `intersect` r) &&-    all (`BitSet.notMember` bs) (dl `union` dr)+    all (`BS.member` bs) (l `intersect` r) &&+    all (`BS.notMember` bs) (dl `union` dr)   where     n      = length xs     (l, r) = splitAt (n `div` 2) $ nub xs@@ -100,53 +100,64 @@     dr = r \\ l      bs :: BitSet Word16-    bs = let bs1 = BitSet.fromList l-             bs2 = BitSet.fromList r-         in bs1 `BitSet.intersection` bs2+    bs = let bs1 = BS.fromList l+             bs2 = BS.fromList r+         in bs1 `BS.intersection` bs2  propDifferenceWithSelf :: [Word16] -> Bool-propDifferenceWithSelf xs = bs == BitSet.empty where+propDifferenceWithSelf xs = bs == BS.empty where   bs :: BitSet Word16-  bs = let bs0 = BitSet.fromList xs in bs0 `BitSet.difference` bs0+  bs = let bs0 = BS.fromList xs in+       bs0 `BS.difference` bs0  propDifference :: [Word16] -> Property propDifference xs = n > 0 ==>-                    all (`BitSet.member` bs) (l \\ r) &&-                    all (`BitSet.notMember` bs) (l `intersect` r)+                    all (`BS.member` bs) (l \\ r) &&+                    all (`BS.notMember` bs) (l `intersect` r)   where     n      = length xs     (l, r) = splitAt (n `div` 2) $ nub xs      bs :: BitSet Word16-    bs = let bs1 = BitSet.fromList l-             bs2 = BitSet.fromList r-         in bs1 `BitSet.difference` bs2+    bs = let bs1 = BS.fromList l+             bs2 = BS.fromList r+         in bs1 `BS.difference` bs2  propMonoidLaws :: BitSet Word16 -> BitSet Word16 -> BitSet Word16 -> Bool propMonoidLaws bs1 bs2 bs3 =-    bs1 `mappend` mempty == bs1 &&-    mempty `mappend` bs1 == bs1 &&-    mappend bs1 (bs2 `mappend` bs3) == (bs1 `mappend` bs2) `mappend` bs3+    bs1 <> mempty == bs1 &&+    mempty <> bs1 == bs1 &&+    bs1 <> (bs2 <> bs3) == (bs1 <> bs2) <> bs3  propIsSubsetOfSelf :: BitSet Word16 -> Bool-propIsSubsetOfSelf bs = bs `BitSet.isSubsetOf` bs &&-                        not (bs `BitSet.isProperSubsetOf` bs)+propIsSubsetOfSelf bs = bs `BS.isSubsetOf` bs &&+                        not (bs `BS.isProperSubsetOf` bs)  propIsSubsetOf :: [Word16] -> Bool propIsSubsetOf xs =-    bs1 `BitSet.isSubsetOf` bs && bs2 `BitSet.isSubsetOf` bs+    bs1 `BS.isSubsetOf` bs &&+    bs2 `BS.isSubsetOf` bs   where     n = length xs      bs :: BitSet Word16-    bs = BitSet.fromList xs+    bs = BS.fromList xs      bs1 :: BitSet Word16-    bs1 = BitSet.fromList $ take (n `div` 2) xs+    bs1 = BS.fromList $ take (n `div` 2) xs      bs2 :: BitSet Word16-    bs2 = BitSet.fromList $ drop (n `div` 2) xs+    bs2 = BS.fromList $ drop (n `div` 2) 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)++propFilter :: BitSet Word16 -> (Word16 -> Bool) -> Bool+propFilter bs f = BS.filter f bs == (BS.fromList $ filter f $ BS.toList bs)+ main :: IO () main = defaultMain tests where   tests :: [Test]@@ -161,7 +172,6 @@           , testProperty "toList" propToList           , testProperty "fromList" propFromList           , testProperty "empty" propEmpty-          , testProperty "unsafe construction from integral" propUnsafeFromIntegral           , testProperty "unions" propUnions           , testProperty "intersection with self" propIntersectionWithSelf           , testProperty "intersection" propIntersection@@ -170,4 +180,7 @@           , testProperty "monoid laws" propMonoidLaws           , testProperty "is subset of self" propIsSubsetOfSelf           , testProperty "is subset of" propIsSubsetOf+          , testProperty "show read" propShowRead+          , testProperty "map" propMap+          , testProperty "filter" propFilter           ]