bloomfilter 1.2.6.10 → 2.0.0.0

raw patch · 11 files changed

+383/−252 lines, 11 filesdep +QuickCheckdep +bloomfilterdep +randomdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, bloomfilter, random, test-framework, test-framework-quickcheck2

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• Data/BloomFilter.hs +114/−209
• Data/BloomFilter/Array.hs +2/−1
• Data/BloomFilter/Easy.hs +7/−6
• Data/BloomFilter/Hash.hs +6/−6
• Data/BloomFilter/Mutable.hs +189/−0
• Data/BloomFilter/Mutable/Internal.hs +37/−0
• bloomfilter.cabal +18/−5
• examples/SpellChecker.hs +3/−3
• examples/Words.hs +5/−5
• tests/QC.hs +2/−2
• tests/QCSupport.hs +0/−15

@@ -1,5 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types, ScopedTypeVariables,-    TypeOperators #-}+{-# LANGUAGE BangPatterns, Rank2Types, ScopedTypeVariables, TypeOperators #-}  -- | -- Module: Data.BloomFilter@@ -42,38 +41,27 @@     , MBloom      -- * Immutable Bloom filters-    -- ** Creation-    , unfoldB -    , fromListB-    , emptyB-    , singletonB--    -- ** Accessors-    , lengthB-    , elemB-    , notElemB--    -- ** Mutators-    , insertB-    , insertListB--    -- * Mutable Bloom filters-    -- ** Immutability wrappers-    , createB-    , modifyB+    -- ** Conversion+    , freeze+    , thaw+    , unsafeFreeze      -- ** Creation-    , newMB-    , unsafeFreezeMB-    , thawMB+    , unfold +    , fromList+    , empty+    , singleton+     -- ** Accessors-    , lengthMB-    , elemMB+    , length+    , elem+    , notElem -    -- ** Mutation-    , insertMB+    -- ** Modification+    , insert+    , insertList      -- * The underlying representation     -- | If you serialize the raw bit arrays below to disk, do not@@ -81,101 +69,43 @@     -- conventions for endianness or word size.      -- | The raw bit array used by the immutable 'Bloom' type.-    , bitArrayB--    -- | The raw bit array used by the immutable 'MBloom' type.-    , bitArrayMB+    , bitArray     ) where -#include "MachDeps.h"- import Control.Monad (liftM, forM_) import Control.Monad.ST (ST, runST) import Control.DeepSeq (NFData(..))-import Data.Array.Base (unsafeAt, unsafeRead, unsafeWrite)-import Data.Array.ST (STUArray, thaw, unsafeFreeze)+import Data.Array.Base (unsafeAt)+import qualified Data.Array.Base as ST import Data.Array.Unboxed (UArray)-import Data.Bits ((.&.), (.|.))-import Data.BloomFilter.Array (newArray)-import Data.BloomFilter.Util (FastShift(..), (:*)(..), nextPowerOfTwo)+import Data.Bits ((.&.))+import Data.BloomFilter.Util (FastShift(..), (:*)(..))+import qualified Data.BloomFilter.Mutable as MB+import qualified Data.BloomFilter.Mutable.Internal as MB+import Data.BloomFilter.Mutable.Internal (Hash, MBloom) import Data.Word (Word32) --- Make sure we're not performing any expensive arithmetic operations.-import Prelude hiding ((/), (*), div, divMod, mod, rem)+import Prelude hiding (elem, length, notElem,+                       (/), (*), div, divMod, mod, rem) -{--import Debug.Trace-traceM :: (Show a, Monad m) => a -> m ()-traceM v = show v `trace` return ()-traces :: Show a => a -> b -> b-traces s = trace (show s)--} --- | A hash value is 32 bits wide.  This limits the maximum size of a--- filter to about four billion elements, or 512 megabytes of memory.-type Hash = Word32---- | A mutable Bloom filter, for use within the 'ST' monad.-data MBloom s a = MB {-      hashMB :: !(a -> [Hash])-    , shiftMB :: {-# UNPACK #-} !Int-    , maskMB :: {-# UNPACK #-} !Int-    , bitArrayMB :: {-# UNPACK #-} !(STUArray s Int Hash)-    }- -- | An immutable Bloom filter, suitable for querying from pure code. data Bloom a = B {-      hashB :: !(a -> [Hash])-    , shiftB :: {-# UNPACK #-} !Int-    , maskB :: {-# UNPACK #-} !Int-    , bitArrayB :: {-# UNPACK #-} !(UArray Int Hash)+      hashes :: !(a -> [Hash])+    , shift :: {-# UNPACK #-} !Int+    , mask :: {-# UNPACK #-} !Int+    , bitArray :: {-# UNPACK #-} !(UArray Int Hash)     } -instance Show (MBloom s a) where-    show mb = "MBloom { " ++ show (lengthMB mb) ++ " bits } "- instance Show (Bloom a) where-    show ub = "Bloom { " ++ show (lengthB ub) ++ " bits } "+    show ub = "Bloom { " ++ show ((1::Int) `shiftL` shift ub) ++ " bits } "  instance NFData (Bloom a) where     rnf !_ = () --- | Create a new mutable Bloom filter.  For efficiency, the number of--- bits used may be larger than the number requested.  It is always--- rounded up to the nearest higher power of two, but clamped at a--- maximum of 4 gigabits, since hashes are 32 bits in size.------ For a safer creation interface, use 'createB'.  To convert a--- mutable filter to an immutable filter for use in pure code, use--- 'unsafeFreezeMB'.-newMB :: (a -> [Hash])          -- ^ family of hash functions to use-      -> Int                    -- ^ number of bits in filter-      -> ST s (MBloom s a)-newMB hash numBits = MB hash shift mask `liftM` newArray numElems numBytes-  where twoBits | numBits < 1 = 1-                | numBits > maxHash = maxHash-                | isPowerOfTwo numBits = numBits-                | otherwise = nextPowerOfTwo numBits-        numElems = max 2 (twoBits `shiftR` logBitsInHash)-        numBytes = numElems `shiftL` logBytesInHash-        trueBits = numElems `shiftL` logBitsInHash-        shift = logPower2 trueBits-        mask = trueBits - 1-        isPowerOfTwo n = n .&. (n - 1) == 0--maxHash :: Int-#if WORD_SIZE_IN_BITS == 64-maxHash = 4294967296-#else-maxHash = 1073741824-#endif- logBitsInHash :: Int logBitsInHash = 5 -- logPower2 bitsInHash -logBytesInHash :: Int-logBytesInHash = 2 -- logPower2 (sizeOf (undefined :: Hash))- -- | Create an immutable Bloom filter, using the given setup function -- which executes in the 'ST' monad. --@@ -184,42 +114,60 @@ -- @ --import "Data.BloomFilter.Hash" (cheapHashes) -----filter = createB (cheapHashes 3) 1024 $ \mf -> do+--filter = create (cheapHashes 3) 1024 $ \mf -> do --           insertMB mf \"foo\" --           insertMB mf \"bar\" -- @ -- -- Note that the result of the setup function is not used.-createB :: (a -> [Hash])        -- ^ family of hash functions to use+create :: (a -> [Hash])        -- ^ family of hash functions to use         -> Int                  -- ^ number of bits in filter-        -> (forall s. (MBloom s a -> ST s z))  -- ^ setup function (result is discarded)+        -> (forall s. (MBloom s a -> ST s ()))  -- ^ setup function         -> Bloom a-{-# INLINE createB #-}-createB hash numBits body = runST $ do-  mb <- newMB hash numBits-  _ <- body mb-  unsafeFreezeMB mb+{-# INLINE create #-}+create hash numBits body = runST $ do+  mb <- MB.new hash numBits+  body mb+  unsafeFreeze mb +-- | Create an immutable Bloom filter from a mutable one.  The mutable+-- filter may be modified afterwards.+freeze :: MBloom s a -> ST s (Bloom a)+freeze mb = B (MB.hashes mb) (MB.shift mb) (MB.mask mb) `liftM`+            ST.freeze (MB.bitArray mb)++-- | Create an immutable Bloom filter from a mutable one.  The mutable+-- filter /must not/ be modified afterwards, or a runtime crash may+-- occur.  For a safer creation interface, use 'freeze' or 'create'.+unsafeFreeze :: MBloom s a -> ST s (Bloom a)+unsafeFreeze mb = B (MB.hashes mb) (MB.shift mb) (MB.mask mb) `liftM`+                    ST.unsafeFreeze (MB.bitArray mb)++-- | Copy an immutable Bloom filter to create a mutable one.  There is+-- no non-copying equivalent.+thaw :: Bloom a -> ST s (MBloom s a)+thaw ub = MB.MB (hashes ub) (shift ub) (mask ub) `liftM` ST.thaw (bitArray ub)+ -- | Create an empty Bloom filter. ----- This function is subject to fusion with 'insertB'--- and 'insertListB'.-emptyB :: (a -> [Hash])         -- ^ family of hash functions to use+-- This function is subject to fusion with 'insert'+-- and 'insertList'.+empty :: (a -> [Hash])         -- ^ family of hash functions to use        -> Int                   -- ^ number of bits in filter        -> Bloom a-{-# INLINE [1] emptyB #-}-emptyB hash numBits = createB hash numBits (\_ -> return ())+{-# INLINE [1] empty #-}+empty hash numBits = create hash numBits (\_ -> return ())  -- | Create a Bloom filter with a single element. ----- This function is subject to fusion with 'insertB'--- and 'insertListB'.-singletonB :: (a -> [Hash])     -- ^ family of hash functions to use+-- This function is subject to fusion with 'insert'+-- and 'insertList'.+singleton :: (a -> [Hash])     -- ^ family of hash functions to use            -> Int               -- ^ number of bits in filter            -> a                 -- ^ element to insert            -> Bloom a-{-# INLINE [1] singletonB #-}-singletonB hash numBits elt = createB hash numBits (\mb -> insertMB mb elt)+{-# INLINE [1] singleton #-}+singleton hash numBits elt = create hash numBits (\mb -> MB.insert mb elt)  -- | Given a filter's mask and a hash value, compute an offset into -- a word array and a bit offset within that word.@@ -231,50 +179,28 @@ -- | Hash the given value, returning a list of (word offset, bit -- offset) pairs, one per hash value. hashesM :: MBloom s a -> a -> [Int :* Int]-hashesM mb elt = hashIdx (maskMB mb) `map` hashMB mb elt+hashesM mb elt = hashIdx (MB.mask mb) `map` MB.hashes mb elt  -- | Hash the given value, returning a list of (word offset, bit -- offset) pairs, one per hash value. hashesU :: Bloom a -> a -> [Int :* Int]-hashesU ub elt = hashIdx (maskB ub) `map` hashB ub elt---- | Insert a value into a mutable Bloom filter.  Afterwards, a--- membership query for the same value is guaranteed to return @True@.-insertMB :: MBloom s a -> a -> ST s ()-insertMB mb elt = do-  let mu = bitArrayMB mb-  forM_ (hashesM mb elt) $ \(word :* bit) -> do-      old <- unsafeRead mu word-      unsafeWrite mu word (old .|. (1 `shiftL` bit))---- | Query a mutable Bloom filter for membership.  If the value is--- present, return @True@.  If the value is not present, there is--- /still/ some possibility that @True@ will be returned.-elemMB :: a -> MBloom s a -> ST s Bool-elemMB elt mb = loop (hashesM mb elt)-  where mu = bitArrayMB mb-        loop ((word :* bit):wbs) = do-          i <- unsafeRead mu word-          if i .&. (1 `shiftL` bit) == 0-            then return False-            else loop wbs-        loop _ = return True+hashesU ub elt = hashIdx (mask ub) `map` hashes ub elt  -- | Query an immutable Bloom filter for membership.  If the value is -- present, return @True@.  If the value is not present, there is -- /still/ some possibility that @True@ will be returned.-elemB :: a -> Bloom a -> Bool-elemB elt ub = all test (hashesU ub elt)-  where test (off :* bit) = (bitArrayB ub `unsafeAt` off) .&. (1 `shiftL` bit) /= 0+elem :: a -> Bloom a -> Bool+elem elt ub = all test (hashesU ub elt)+  where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `shiftL` bit) /= 0           -modifyB :: (forall s. (MBloom s a -> ST s z))  -- ^ mutation function (result is discarded)+modify :: (forall s. (MBloom s a -> ST s z))  -- ^ mutation function (result is discarded)         -> Bloom a         -> Bloom a-{-# INLINE modifyB #-}-modifyB body ub = runST $ do-  mb <- thawMB ub+{-# INLINE modify #-}+modify body ub = runST $ do+  mb <- thaw ub   _ <- body mb-  unsafeFreezeMB mb+  unsafeFreeze mb  -- | Create a new Bloom filter from an existing one, with the given -- member added.@@ -284,9 +210,9 @@ -- -- Repeated applications of this function with itself are subject to -- fusion.-insertB :: a -> Bloom a -> Bloom a-{-# NOINLINE insertB #-}-insertB elt = modifyB (flip insertMB elt)+insert :: a -> Bloom a -> Bloom a+{-# NOINLINE insert #-}+insert elt = modify (flip MB.insert elt)  -- | Create a new Bloom filter from an existing one, with the given -- members added.@@ -296,63 +222,44 @@ -- -- Repeated applications of this function with itself are subject to -- fusion.-insertListB :: [a] -> Bloom a -> Bloom a-{-# NOINLINE insertListB #-}-insertListB elts = modifyB $ \mb -> mapM_ (insertMB mb) elts+insertList :: [a] -> Bloom a -> Bloom a+{-# NOINLINE insertList #-}+insertList elts = modify $ \mb -> mapM_ (MB.insert mb) elts -{-# RULES "Bloom insertB . insertB" forall a b u.-    insertB b (insertB a u) = insertListB [a,b] u+{-# RULES "Bloom insert . insert" forall a b u.+    insert b (insert a u) = insertList [a,b] u   #-} -{-# RULES "Bloom insertListB . insertB" forall x xs u.-    insertListB xs (insertB x u) = insertListB (x:xs) u+{-# RULES "Bloom insertList . insert" forall x xs u.+    insertList xs (insert x u) = insertList (x:xs) u   #-} -{-# RULES "Bloom insertB . insertListB" forall x xs u.-    insertB x (insertListB xs u) = insertListB (x:xs) u+{-# RULES "Bloom insert . insertList" forall x xs u.+    insert x (insertList xs u) = insertList (x:xs) u   #-} -{-# RULES "Bloom insertListB . insertListB" forall xs ys u.-    insertListB xs (insertListB ys u) = insertListB (xs++ys) u+{-# RULES "Bloom insertList . insertList" forall xs ys u.+    insertList xs (insertList ys u) = insertList (xs++ys) u   #-} -{-# RULES "Bloom insertListB . emptyB" forall h n xs.-    insertListB xs (emptyB h n) = fromListB h n xs+{-# RULES "Bloom insertList . empty" forall h n xs.+    insertList xs (empty h n) = fromList h n xs   #-} -{-# RULES "Bloom insertListB . singletonB" forall h n x xs.-    insertListB xs (singletonB h n x) = fromListB h n (x:xs)+{-# RULES "Bloom insertList . singleton" forall h n x xs.+    insertList xs (singleton h n x) = fromList h n (x:xs)   #-}  -- | Query an immutable Bloom filter for non-membership.  If the value -- /is/ present, return @False@.  If the value is not present, there -- is /still/ some possibility that @True@ will be returned.-notElemB :: a -> Bloom a -> Bool-notElemB elt ub = any test (hashesU ub elt)-  where test (off :* bit) = (bitArrayB ub `unsafeAt` off) .&. (1 `shiftL` bit) == 0---- | Create an immutable Bloom filter from a mutable one.  The mutable--- filter /must not/ be modified afterwards, or a runtime crash may--- occur.  For a safer creation interface, use 'createB'.-unsafeFreezeMB :: MBloom s a -> ST s (Bloom a)-unsafeFreezeMB mb = B (hashMB mb) (shiftMB mb) (maskMB mb) `liftM`-                    unsafeFreeze (bitArrayMB mb)---- | Copy an immutable Bloom filter to create a mutable one.  There is--- no non-copying equivalent.-thawMB :: Bloom a -> ST s (MBloom s a)-thawMB ub = MB (hashB ub) (shiftB ub) (maskB ub) `liftM` thaw (bitArrayB ub)---- bitsInHash :: Int--- bitsInHash = sizeOf (undefined :: Hash) `shiftL` 3---- | Return the size of a mutable Bloom filter, in bits.-lengthMB :: MBloom s a -> Int-lengthMB = shiftL 1 . shiftMB+notElem :: a -> Bloom a -> Bool+notElem elt ub = any test (hashesU ub elt)+  where test (off :* bit) = (bitArray ub `unsafeAt` off) .&. (1 `shiftL` bit) == 0  -- | Return the size of an immutable Bloom filter, in bits.-lengthB :: Bloom a -> Int-lengthB = shiftL 1 . shiftB+length :: Bloom a -> Int+length = shiftL 1 . shift  -- | Build an immutable Bloom filter from a seed value.  The seeding -- function populates the filter as follows.@@ -362,16 +269,16 @@ -- --   * If it returns @'Just' (a,b)@, @a@ is added to the filter and --     @b@ is used as a new seed.-unfoldB :: forall a b. (a -> [Hash]) -- ^ family of hash functions to use+unfold :: forall a b. (a -> [Hash]) -- ^ family of hash functions to use         -> Int                       -- ^ number of bits in filter         -> (b -> Maybe (a, b))       -- ^ seeding function         -> b                         -- ^ initial seed         -> Bloom a-{-# INLINE unfoldB #-}-unfoldB hashes numBits f k = createB hashes numBits (loop k)+{-# INLINE unfold #-}+unfold hashes numBits f k = create hashes numBits (loop k)   where loop :: forall s. b -> MBloom s a -> ST s ()         loop j mb = case f j of-                      Just (a, j') -> insertMB mb a >> loop j' mb+                      Just (a, j') -> MB.insert mb a >> loop j' mb                       _ -> return ()  -- | Create an immutable Bloom filter, populating it from a list of@@ -384,24 +291,24 @@ -- @ --import "Data.BloomFilter.Hash" (cheapHashes) -----filt = fromListB (cheapHashes 3) 1024 [\"foo\", \"bar\", \"quux\"]+--filt = fromList (cheapHashes 3) 1024 [\"foo\", \"bar\", \"quux\"] -- @-fromListB :: (a -> [Hash])      -- ^ family of hash functions to use+fromList :: (a -> [Hash])      -- ^ family of hash functions to use           -> Int                -- ^ number of bits in filter           -> [a]                -- ^ values to populate with           -> Bloom a-{-# INLINE [1] fromListB #-}-fromListB hashes numBits list = createB hashes numBits $ forM_ list . insertMB+{-# INLINE [1] fromList #-}+fromList hashes numBits list = create hashes numBits $ forM_ list . MB.insert -{-# RULES "Bloom insertListB . fromListB" forall h n xs ys.-    insertListB xs (fromListB h n ys) = fromListB h n (xs ++ ys)+{-# RULES "Bloom insertList . fromList" forall h n xs ys.+    insertList xs (fromList h n ys) = fromList h n (xs ++ ys)   #-}  {- -- This is a simpler definition, but GHC doesn't inline the unfold -- sensibly. -fromListB hashes numBits = unfoldB hashes numBits convert+fromList hashes numBits = unfold hashes numBits convert   where convert (x:xs) = Just (x, xs)         convert _      = Nothing -}@@ -432,11 +339,9 @@  -- $ease ----- This module provides both mutable and immutable interfaces for--- creating and querying a Bloom filter.  It is most useful as a--- low-level way to create a Bloom filter with a custom set of--- characteristics, perhaps in combination with the hashing functions--- in 'Data.BloomFilter.Hash'.+-- This module provides immutable interfaces for working with a+-- query-only Bloom filter, and for converting to and from mutable+-- Bloom filters. -- -- For a higher-level interface that is easy to use, see the -- 'Data.BloomFilter.Easy' module.

@@ -3,7 +3,8 @@  module Data.BloomFilter.Array (newArray) where -import Control.Monad.ST (ST, unsafeIOToST)+import Control.Monad.ST (ST)+import Control.Monad.ST.Unsafe (unsafeIOToST) import Data.Array.Base (MArray, STUArray(..), unsafeNewArray_) #if __GLASGOW_HASKELL__ >= 704 import Foreign.C.Types (CInt(..), CSize(..))

@@ -16,9 +16,9 @@     -- * Easy creation and querying       Bloom     , easyList-    , elemB-    , notElemB-    , lengthB+    , B.elem+    , B.notElem+    , B.length      -- ** Example: a spell checker     -- $example@@ -28,11 +28,12 @@     , suggestSizing     ) where -import Data.BloomFilter (Bloom, elemB, fromListB, lengthB, notElemB)+import Data.BloomFilter (Bloom) import Data.BloomFilter.Hash (Hashable, cheapHashes) import Data.BloomFilter.Util (nextPowerOfTwo) import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB+import qualified Data.BloomFilter as B  -- | Create a Bloom filter with the given false positive rate and -- members.  The hash functions used are computed by the @cheapHashes@@@ -44,7 +45,7 @@ {-# SPECIALIZE easyList :: Double -> [String] -> Bloom String #-} {-# SPECIALIZE easyList :: Double -> [LB.ByteString] -> Bloom LB.ByteString #-} {-# SPECIALIZE easyList :: Double -> [SB.ByteString] -> Bloom SB.ByteString #-}-easyList errRate xs = fromListB (cheapHashes numHashes) numBits xs+easyList errRate xs = B.fromList (cheapHashes numHashes) numBits xs     where capacity = length xs           (numBits, numHashes)               | capacity > 0 = suggestSizing capacity errRate@@ -71,7 +72,7 @@             minimum [((-k) * cap / log (1 - (errRate ** (1 / k))), k)                      | k <- [1..100]]         roundedBits = nextPowerOfTwo (ceiling bits)-    in if roundedBits <= 0+    in if roundedBits <= 0 || roundedBits > 0xffffffff        then Left  "capacity too large to represent"        else Right (roundedBits, truncate hashes) 

@@ -96,13 +96,13 @@                    h1 <- hashIO32 v s1                    h2 <- hashIO32 v s2                    return $ (fromIntegral h1 `shiftL` 32) .|. fromIntegral h2-      + -- | Compute a 32-bit hash. hash32 :: Hashable a => a -> Word32-hash32 = hashSalt32 0x106fc397+hash32 = hashSalt32 0x16fc397c  hash64 :: Hashable a => a -> Word64-hash64 = hashSalt64 0x106fc397cf62f64d3+hash64 = hashSalt64 0x16fc397cf62f64d3  -- | Compute a salted 32-bit hash. hashSalt32 :: Hashable a => Word32  -- ^ salt@@ -123,7 +123,7 @@ hashes :: Hashable a => Int     -- ^ number of hashes to compute        -> a                     -- ^ value to hash        -> [Word32]-hashes n v = unfoldr go (n,0x3f56da2d3ddbb9f6)+hashes n v = unfoldr go (n,0x3f56da2d)     where go (k,s) | k <= 0    = Nothing                    | otherwise = let s' = hashSalt32 s v                                  in Just (s', (k-1,s'))@@ -160,7 +160,7 @@  instance Hashable Integer where     hashIO32 k salt | k < 0 = hashIO32 (unfoldr go (-k))-                                   (salt `xor` 0x3ece731e9c1c64f8)+                                   (salt `xor` 0x3ece731e)                   | otherwise = hashIO32 (unfoldr go k) salt         where go 0 = Nothing               go i = Just (fromIntegral i :: Word32, i `shiftR` 32)@@ -377,7 +377,7 @@                 then step c (fromIntegral (nstoff - stoff))                 else frag xs nstoff             frag LB.Empty stoff = return (fromIntegral (12 - stoff))-        c_begin p1 p2 st +        c_begin p1 p2 st         unread <- step s 0         c_end (fromIntegral unread) p1 p2 st       peek sp

@@ -0,0 +1,189 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types,+    TypeOperators #-}++-- |+-- Module: Data.BloomFilter.Mutable+-- Copyright: Bryan O'Sullivan+-- License: BSD3+--+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: unstable+-- Portability: portable+--+-- A fast, space efficient Bloom filter implementation.  A Bloom+-- filter is a set-like data structure that provides a probabilistic+-- membership test.+--+-- * Queries do not give false negatives.  When an element is added to+--   a filter, a subsequent membership test will definitely return+--   'True'.+--+-- * False positives /are/ possible.  If an element has not been added+--   to a filter, a membership test /may/ nevertheless indicate that+--   the element is present.+--+-- This module provides low-level control.  For an easier to use+-- interface, see the "Data.BloomFilter.Easy" module.++module Data.BloomFilter.Mutable+    (+    -- * Overview+    -- $overview++    -- ** Ease of use+    -- $ease++    -- ** Performance+    -- $performance++    -- * Types+      Hash+    , MBloom+    -- * Mutable Bloom filters++    -- ** Creation+    , new++    -- ** Accessors+    , length+    , elem++    -- ** Mutation+    , insert++    -- * The underlying representation+    -- | If you serialize the raw bit arrays below to disk, do not+    -- expect them to be portable to systems with different+    -- conventions for endianness or word size.++    -- | The raw bit array used by the mutable 'MBloom' type.+    , bitArray+    ) where++#include "MachDeps.h"++import Control.Monad (liftM, forM_)+import Control.Monad.ST (ST)+import Data.Array.Base (unsafeRead, unsafeWrite)+import Data.Bits ((.&.), (.|.))+import Data.BloomFilter.Array (newArray)+import Data.BloomFilter.Util (FastShift(..), (:*)(..), nextPowerOfTwo)+import Data.Word (Word32)+import Data.BloomFilter.Mutable.Internal++import Prelude hiding (elem, length, notElem,+                       (/), (*), div, divMod, mod, rem)++-- | Create a new mutable Bloom filter.  For efficiency, the number of+-- bits used may be larger than the number requested.  It is always+-- rounded up to the nearest higher power of two, but will be clamped+-- at a maximum of 4 gigabits, since hashes are 32 bits in size.+new :: (a -> [Hash])          -- ^ family of hash functions to use+    -> Int                    -- ^ number of bits in filter+    -> ST s (MBloom s a)+new hash numBits = MB hash shft msk `liftM` newArray numElems numBytes+  where twoBits | numBits < 1 = 1+                | numBits > maxHash = maxHash+                | isPowerOfTwo numBits = numBits+                | otherwise = nextPowerOfTwo numBits+        numElems = max 2 (twoBits `shiftR` logBitsInHash)+        numBytes = numElems `shiftL` logBytesInHash+        trueBits = numElems `shiftL` logBitsInHash+        shft     = logPower2 trueBits+        msk      = trueBits - 1+        isPowerOfTwo n = n .&. (n - 1) == 0++maxHash :: Int+#if WORD_SIZE_IN_BITS == 64+maxHash = 4294967296+#else+maxHash = 1073741824+#endif++logBitsInHash :: Int+logBitsInHash = 5 -- logPower2 bitsInHash++logBytesInHash :: Int+logBytesInHash = 2 -- logPower2 (sizeOf (undefined :: Hash))++-- | Given a filter's mask and a hash value, compute an offset into+-- a word array and a bit offset within that word.+hashIdx :: Int -> Word32 -> (Int :* Int)+hashIdx msk x = (y `shiftR` logBitsInHash) :* (y .&. hashMask)+  where hashMask = 31 -- bitsInHash - 1+        y = fromIntegral x .&. msk++-- | Hash the given value, returning a list of (word offset, bit+-- offset) pairs, one per hash value.+hashesM :: MBloom s a -> a -> [Int :* Int]+hashesM mb elt = hashIdx (mask mb) `map` hashes mb elt++-- | Insert a value into a mutable Bloom filter.  Afterwards, a+-- membership query for the same value is guaranteed to return @True@.+insert :: MBloom s a -> a -> ST s ()+insert mb elt = do+  let mu = bitArray mb+  forM_ (hashesM mb elt) $ \(word :* bit) -> do+      old <- unsafeRead mu word+      unsafeWrite mu word (old .|. (1 `shiftL` bit))++-- | Query a mutable Bloom filter for membership.  If the value is+-- present, return @True@.  If the value is not present, there is+-- /still/ some possibility that @True@ will be returned.+elem :: a -> MBloom s a -> ST s Bool+elem elt mb = loop (hashesM mb elt)+  where mu = bitArray mb+        loop ((word :* bit):wbs) = do+          i <- unsafeRead mu word+          if i .&. (1 `shiftL` bit) == 0+            then return False+            else loop wbs+        loop _ = return True++-- bitsInHash :: Int+-- bitsInHash = sizeOf (undefined :: Hash) `shiftL` 3++-- | Return the size of a mutable Bloom filter, in bits.+length :: MBloom s a -> Int+length = shiftL 1 . shift+++-- | Slow, crummy way of computing the integer log of an integer known+-- to be a power of two.+logPower2 :: Int -> Int+logPower2 k = go 0 k+    where go j 1 = j+          go j n = go (j+1) (n `shiftR` 1)++-- $overview+--+-- Each of the functions for creating Bloom filters accepts two parameters:+--+-- * The number of bits that should be used for the filter.  Note that+--   a filter is fixed in size; it cannot be resized after creation.+--+-- * A function that accepts a value, and should return a fixed-size+--   list of hashes of that value.  To keep the false positive rate+--   low, the hashes computes should, as far as possible, be+--   independent.+--+-- By choosing these parameters with care, it is possible to tune for+-- a particular false positive rate.  The @suggestSizing@ function in+-- the "Data.BloomFilter.Easy" module calculates useful estimates for+-- these parameters.++-- $ease+--+-- This module provides both mutable interfaces for creating and+-- querying a Bloom filter.  It is most useful as a low-level way to+-- manage a Bloom filter with a custom set of characteristics.++-- $performance+--+-- The implementation has been carefully tuned for high performance+-- and low space consumption.+--+-- For efficiency, the number of bits requested when creating a Bloom+-- filter is rounded up to the nearest power of two.  This lets the+-- implementation use bitwise operations internally, instead of much+-- more expensive multiplication, division, and modulus operations.

@@ -0,0 +1,37 @@+-- |+-- Module: Data.BloomFilter.Mutable.Internal+-- Copyright: Bryan O'Sullivan+-- License: BSD3+--+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: unstable+-- Portability: portable++module Data.BloomFilter.Mutable.Internal+    (+    -- * Types+      Hash+    , MBloom(..)+    ) where++import Data.Array.Base (STUArray)+import Data.Bits (shiftL)+import Data.Word (Word32)++import Prelude hiding (elem, length, notElem,+                       (/), (*), div, divMod, mod, rem)++-- | A hash value is 32 bits wide.  This limits the maximum size of a+-- filter to about four billion elements, or 512 megabytes of memory.+type Hash = Word32++-- | A mutable Bloom filter, for use within the 'ST' monad.+data MBloom s a = MB {+      hashes :: !(a -> [Hash])+    , shift :: {-# UNPACK #-} !Int+    , mask :: {-# UNPACK #-} !Int+    , bitArray :: {-# UNPACK #-} !(STUArray s Int Hash)+    }++instance Show (MBloom s a) where+    show mb = "MBloom { " ++ show ((1::Int) `shiftL` shift mb) ++ " bits } "

@@ -1,5 +1,5 @@ name:            bloomfilter-version:         1.2.6.10+version:         2.0.0.0 license:         BSD3 license-file:    LICENSE author:          Bryan O'Sullivan <bos@serpentine.com>@@ -18,22 +18,35 @@ library   build-depends:     array,-    base       < 5,+    base       >= 4.4 && < 5,     bytestring >= 0.9,     deepseq-  if impl(ghc >= 6.10)-    build-depends:-      base >= 4   exposed-modules:  Data.BloomFilter                     Data.BloomFilter.Easy+                    Data.BloomFilter.Mutable                     Data.BloomFilter.Hash   other-modules:    Data.BloomFilter.Array+                    Data.BloomFilter.Mutable.Internal                     Data.BloomFilter.Util   c-sources:        cbits/lookup3.c   ghc-options:      -O2 -Wall   include-dirs:     cbits   includes:         lookup3.h   install-includes: lookup3.h++test-suite tests+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        QC.hs+  other-modules:  QCSupport+  build-depends:+    QuickCheck >= 2.5,+    base >= 4.4 && < 5,+    bloomfilter,+    bytestring,+    random,+    test-framework,+    test-framework-quickcheck2  source-repository head   type:     git

@@ -1,5 +1,5 @@-import Data.BloomFilter.Easy (easyList, notElemB)+import qualified Data.BloomFilter.Easy as BFE  main = do-  filt <- (easyList 0.01 . words) `fmap` readFile "/usr/share/dict/words"-  interact (unlines . filter (`notElemB` filt) . lines)+  filt <- (BFE.easyList 0.01 . words) `fmap` readFile "/usr/share/dict/words"+  interact (unlines . filter (`BFE.notElem` filt) . lines)

@@ -2,23 +2,23 @@ -- builds a Bloom filter from a list of words, one per line, and -- queries it exhaustively. -module Main () where+module Main (main) where  import Control.Monad (forM_, mapM_)-import Data.BloomFilter (Bloom, fromListB, elemB, lengthB)+import qualified Data.BloomFilter as BF import Data.BloomFilter.Hash (cheapHashes) import Data.BloomFilter.Easy (easyList, suggestSizing) import qualified Data.ByteString.Lazy.Char8 as B import Data.Time.Clock (diffUTCTime, getCurrentTime) import System.Environment (getArgs) -conservative, aggressive :: Double -> [B.ByteString] -> Bloom B.ByteString+conservative, aggressive :: Double -> [B.ByteString] -> BF.Bloom B.ByteString conservative = easyList  aggressive fpr xs     = let (size, numHashes) = suggestSizing (length xs) fpr           k = 3-      in fromListB (cheapHashes (numHashes - k)) (size * k) xs+      in BF.fromList (cheapHashes (numHashes - k)) (size * k) xs  testFunction = conservative @@ -36,6 +36,6 @@     print filt     c <- getCurrentTime     putStrLn $ show (diffUTCTime c b) ++ "s to construct filter"-    {-# SCC "query" #-} mapM_ print $ filter (not . (`elemB` filt)) words+    {-# SCC "query" #-} mapM_ print $ filter (not . (`BF.elem` filt)) words     d <- getCurrentTime     putStrLn $ show (diffUTCTime d c) ++ "s to query every element"

@@ -1,7 +1,7 @@ module Main where  import Control.Monad (forM_)-import Data.BloomFilter.Easy (easyList, elemB)+import qualified Data.BloomFilter.Easy as B import Data.BloomFilter.Hash (Hashable(..), hash64) import qualified Data.ByteString.Char8 as SB import qualified Data.ByteString.Lazy.Char8 as LB@@ -15,7 +15,7 @@ import QCSupport (P(..))  prop_pai :: (Hashable a) => a -> a -> P -> Bool-prop_pai _ xs (P q) = let bf = easyList q [xs] in xs `elemB` bf+prop_pai _ xs (P q) = let bf = B.easyList q [xs] in xs `B.elem` bf  tests :: [Test] tests = [

@@ -20,21 +20,6 @@     arbitrary = choose (epsilon, 1 - epsilon)         where epsilon = 1e-6 :: P -instance Arbitrary Ordering where-    arbitrary = oneof [return LT, return GT, return EQ]---- For some reason, MIN_VERSION_random doesn't work here :-(-#if __GLASGOW_HASKELL__ < 704-integralRandomR :: (Integral a, RandomGen g) => (a, a) -> g -> (a, g)-integralRandomR (a,b) g = case randomR (fromIntegral a :: Int,-                                        fromIntegral b :: Int) g-                          of (x,g') -> (fromIntegral x, g')--instance Random Int64 where-  randomR = integralRandomR-  random = randomR (minBound,maxBound)-#endif- instance Arbitrary LB.ByteString where     arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))                 ((LB.fromChunks . filter (not . SB.null)) `fmap` arbitrary)