{-# 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 ((.&.), (.|.), unsafeShiftL, unsafeShiftR)
import Data.BloomFilter.Array (newArray)
import Data.BloomFilter.Util ((:*)(..), 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 = forall s a.
(a -> [Hash]) -> Int -> Int -> STUArray s Int Hash -> MBloom s a
MB a -> [Hash]
hash Int
shft Int
msk forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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 forall a. Ord a => a -> a -> Bool
< Int
1 = Int
1
| Int
numBits forall a. Ord a => a -> a -> Bool
> Int
maxHash = Int
maxHash
| forall {a}. (Bits a, Num a) => a -> Bool
isPowerOfTwo Int
numBits = Int
numBits
| Bool
otherwise = Int -> Int
nextPowerOfTwo Int
numBits
numElems :: Int
numElems = forall a. Ord a => a -> a -> a
max Int
2 (Int
twoBits forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
logBitsInHash)
numBytes :: Int
numBytes = Int
numElems forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
logBytesInHash
trueBits :: Int
trueBits = Int
numElems forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
logBitsInHash
shft :: Int
shft = Int -> Int
logPower2 Int
trueBits
msk :: Int
msk = Int
trueBits forall a. Num a => a -> a -> a
- Int
1
isPowerOfTwo :: a -> Bool
isPowerOfTwo a
n = a
n forall a. Bits a => a -> a -> a
.&. (a
n forall a. Num a => a -> a -> a
- a
1) 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 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
logBitsInHash) forall a b. a -> b -> a :* b
:* (Int
y forall a. Bits a => a -> a -> a
.&. Int
hashMask)
where hashMask :: Int
hashMask = Int
31
y :: Int
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
x 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 (forall s a. MBloom s a -> Int
mask MBloom s a
mb) forall a b. (a -> b) -> [a] -> [b]
`map` 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 = forall s a. MBloom s a -> STUArray s Int Hash
bitArray MBloom s a
mb
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall s a. MBloom s a -> a -> [Int :* Int]
hashesM MBloom s a
mb a
elt) forall a b. (a -> b) -> a -> b
$ \(Int
word :* Int
bit) -> do
Hash
old <- 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
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 forall a. Bits a => a -> a -> a
.|. (Hash
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` 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 = forall {m :: * -> *}.
MArray (STUArray s) Hash m =>
[Int :* Int] -> m Bool
loop (forall s a. MBloom s a -> a -> [Int :* Int]
hashesM MBloom s a
mb a
elt)
where mu :: STUArray s Int Hash
mu = 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 <- 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 forall a. Bits a => a -> a -> a
.&. (Hash
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bit) forall a. Eq a => a -> a -> Bool
== Hash
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else [Int :* Int] -> m Bool
loop [Int :* Int]
wbs
loop [Int :* Int]
_ = 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 = forall a. Bits a => a -> Int -> a
unsafeShiftL Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. MBloom s a -> Int
shift
logPower2 :: Int -> Int
logPower2 :: Int -> Int
logPower2 Int
k = forall {t} {t}. (Num t, Num t, Bits 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
jforall a. Num a => a -> a -> a
+t
1) (t
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1)