{-# LANGUAGE BangPatterns, CPP, Rank2Types,
TypeOperators,FlexibleContexts #-}
module Data.BloomFilter.Mutable
(
Hash
, MBloom
, new
, length
, elem
, insert
, 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)
new :: (a -> [Hash])
-> Int
-> ST s (MBloom s a)
new :: forall a s. (a -> [Hash]) -> Int -> ST s (MBloom s a)
new a -> [Hash]
hash Int
numBits = (a -> [Hash]) -> Int -> Int -> STUArray s Int Hash -> MBloom s a
forall s a.
(a -> [Hash]) -> Int -> Int -> STUArray s Int Hash -> MBloom s a
MB a -> [Hash]
hash Int
shft Int
msk (STUArray s Int Hash -> MBloom s a)
-> ST s (STUArray s Int Hash) -> ST s (MBloom s a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> Int -> ST s (STUArray s Int Hash)
forall e s.
MArray (STUArray s) e (ST s) =>
Int -> Int -> ST s (STUArray s Int e)
newArray Int
numElems Int
numBytes
where twoBits :: Int
twoBits | Int
numBits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Int
1
| Int
numBits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxHash = Int
maxHash
| Int -> Bool
forall {a}. (Bits a, Num a) => a -> Bool
isPowerOfTwo Int
numBits = Int
numBits
| Bool
otherwise = Int -> Int
nextPowerOfTwo Int
numBits
numElems :: Int
numElems = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Int
twoBits Int -> Int -> Int
forall a. FastShift a => a -> Int -> a
`shiftR` Int
logBitsInHash)
numBytes :: Int
numBytes = Int
numElems Int -> Int -> Int
forall a. FastShift a => a -> Int -> a
`shiftL` Int
logBytesInHash
trueBits :: Int
trueBits = Int
numElems Int -> Int -> Int
forall a. FastShift a => a -> Int -> a
`shiftL` Int
logBitsInHash
shft :: Int
shft = Int -> Int
logPower2 Int
trueBits
msk :: Int
msk = Int
trueBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
isPowerOfTwo :: a -> Bool
isPowerOfTwo a
n = a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
maxHash :: Int
#if WORD_SIZE_IN_BITS == 64
maxHash :: Int
maxHash = Int
4294967296
#else
maxHash = 1073741824
#endif
logBitsInHash :: Int
logBitsInHash :: Int
logBitsInHash = Int
5
logBytesInHash :: Int
logBytesInHash :: Int
logBytesInHash = Int
2
hashIdx :: Int -> Word32 -> (Int :* Int)
hashIdx :: Int -> Hash -> Int :* Int
hashIdx Int
msk Hash
x = (Int
y Int -> Int -> Int
forall a. FastShift a => a -> Int -> a
`shiftR` Int
logBitsInHash) Int -> Int -> Int :* Int
forall a b. a -> b -> a :* b
:* (Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
hashMask)
where hashMask :: Int
hashMask = Int
31
y :: Int
y = Hash -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
msk
hashesM :: MBloom s a -> a -> [Int :* Int]
hashesM :: forall s a. MBloom s a -> a -> [Int :* Int]
hashesM MBloom s a
mb a
elt = Int -> Hash -> Int :* Int
hashIdx (MBloom s a -> Int
forall s a. MBloom s a -> Int
mask MBloom s a
mb) (Hash -> Int :* Int) -> [Hash] -> [Int :* Int]
forall a b. (a -> b) -> [a] -> [b]
`map` MBloom s a -> a -> [Hash]
forall s a. MBloom s a -> a -> [Hash]
hashes MBloom s a
mb a
elt
insert :: MBloom s a -> a -> ST s ()
insert :: forall s a. MBloom s a -> a -> ST s ()
insert MBloom s a
mb a
elt = do
let mu :: STUArray s Int Hash
mu = MBloom s a -> STUArray s Int Hash
forall s a. MBloom s a -> STUArray s Int Hash
bitArray MBloom s a
mb
[Int :* Int] -> ((Int :* Int) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (MBloom s a -> a -> [Int :* Int]
forall s a. MBloom s a -> a -> [Int :* Int]
hashesM MBloom s a
mb a
elt) (((Int :* Int) -> ST s ()) -> ST s ())
-> ((Int :* Int) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
word :* Int
bit) -> do
Hash
old <- STUArray s Int Hash -> Int -> ST s Hash
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Hash
mu Int
word
STUArray s Int Hash -> Int -> Hash -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Hash
mu Int
word (Hash
old Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. (Hash
1 Hash -> Int -> Hash
forall a. FastShift a => a -> Int -> a
`shiftL` Int
bit))
elem :: a -> MBloom s a -> ST s Bool
elem :: forall a s. a -> MBloom s a -> ST s Bool
elem a
elt MBloom s a
mb = [Int :* Int] -> ST s Bool
forall {m :: * -> *}.
MArray (STUArray s) Hash m =>
[Int :* Int] -> m Bool
loop (MBloom s a -> a -> [Int :* Int]
forall s a. MBloom s a -> a -> [Int :* Int]
hashesM MBloom s a
mb a
elt)
where mu :: STUArray s Int Hash
mu = MBloom s a -> STUArray s Int Hash
forall s a. MBloom s a -> STUArray s Int Hash
bitArray MBloom s a
mb
loop :: [Int :* Int] -> m Bool
loop ((Int
word :* Int
bit):[Int :* Int]
wbs) = do
Hash
i <- STUArray s Int Hash -> Int -> m Hash
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Hash
mu Int
word
if Hash
i Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. (Hash
1 Hash -> Int -> Hash
forall a. FastShift a => a -> Int -> a
`shiftL` Int
bit) Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else [Int :* Int] -> m Bool
loop [Int :* Int]
wbs
loop [Int :* Int]
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
length :: MBloom s a -> Int
length :: forall s a. MBloom s a -> Int
length = Int -> Int -> Int
forall a. FastShift a => a -> Int -> a
shiftL Int
1 (Int -> Int) -> (MBloom s a -> Int) -> MBloom s a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBloom s a -> Int
forall s a. MBloom s a -> Int
shift
logPower2 :: Int -> Int
logPower2 :: Int -> Int
logPower2 Int
k = Int -> Int -> Int
forall {t} {t}. (Eq t, Num t, Num t, FastShift t) => t -> t -> t
go Int
0 Int
k
where go :: t -> t -> t
go t
j t
1 = t
j
go t
j t
n = t -> t -> t
go (t
jt -> t -> t
forall a. Num a => a -> a -> a
+t
1) (t
n t -> Int -> t
forall a. FastShift a => a -> Int -> a
`shiftR` Int
1)