-- | An efficient membership-testing module, for types that can be mapped into -- @Int@s. -- -- The implementation is quite simple: we rely on the @Bits Integer@ instance -- from @Data.Bits@ for the three main operations. An advantage of this -- library is the phantom parameter used in the BitSet type. Since there is -- no exported way to construct a value of type `BitSet' directly, the -- interface we expose ensures client code will not typecheck if it confuses -- two bit sets intended to keep track of different types. -- -- It is important that the values you intend to keep track of start from 0 -- and go up. Each @Int@ mapped to be hash corresponds to that bit location in -- an @Integer@, and thus requires that @Integer@ to have at least that many -- bits. Don't shoot yourself in the foot. module Data.BitSet ( Hash(..) , BitSet , empty , insert , delete , member ) where import Data.Bits import Test.QuickCheck -- | Map a value to an non-negative @Int@. -- -- For the implementation to give reliable results, it must be that if @hash x -- == hash y@, @x@ and @y@ are equivalent under the relevant relation used in -- the client code. (We don't depend on equality, but the client code will -- certainly want to use the above sort of inference.) -- -- In fact, if your equivalence relation is @==@, the following quickcheck -- test should pass, for arbitrary @x@ and @y@: -- -- @prop_hash x y = -- if hash x == hash y then x == y -- else x /= y -- && if x == y then hash x == hash y -- else hash x /= hash y@ class Hash a where hash :: a -> Int -- | The @Show@ instance kind of sucks. It just shows the @Integer@ -- representation. A good show would probably show all the present hashes. newtype BitSet a = BS { unBS :: Integer } deriving (Eq) instance Show (BitSet a) where show s = "BitSet " ++ show (unBS s) -- | The empty bit set. empty :: BitSet a -- | /O(setBit on Integer)/ Insert an item into the bit set. insert :: Hash a => a -> BitSet a -> BitSet a -- | /O(clearBit on Integer)/ Delete an item from the bit set. delete :: Hash a => a -> BitSet a -> BitSet a -- | /O(testBit on Integer)/ Ask whether the item is in the bit set. member :: Hash a => a -> BitSet a -> Bool -- * Implementation empty = BS 0 {-# INLINE insert #-} insert x s = BS $ setBit (unBS s) (hash x) {-# INLINE delete #-} delete x s = BS $ clearBit (unBS s) (hash x) {-# INLINE member #-} member x s = testBit (unBS s) (hash x) -- * Default instances instance Hash Int where hash = id instance Hash Integer where hash = fromIntegral -- Needs UndecidableInstances? -- instance Integral a => Hash a where -- hash = fromIntegral -- * Quickcheck properties instance Arbitrary (BitSet a) where arbitrary = sized $ \n -> return $ BS $ fromIntegral n prop_insert x s = xa `member` insert xa s where xa = abs x :: Int prop_delete x s = not $ xa `member` delete xa s where xa = abs x :: Int prop_insDelIdempotent x = empty == (delete xa . insert xa $ empty) where xa = abs x :: Int prop_delDelIdempotent x s = delete xa s == (delete xa . delete xa $ s) where xa = abs x :: Int prop_insInsIdempotent x s = insert xa s == (insert xa . insert xa $ s) where xa = abs x :: Int prop_extensional xs = and $ map (`member` s) xsa where s = foldr insert empty xsa xsa = map abs xs :: [Int] prop_empty x = not $ xa `member` empty where xa = abs x :: Int