{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module Data.HashTable.ST.Cuckoo
( HashTable
, new
, newSized
, delete
, lookup
, insert
, mutate
, mutateST
, mapM_
, foldM
, lookupIndex
, nextByIndex
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Monad hiding
(foldM,
mapM_)
import Control.Monad.ST (ST)
import Data.Bits
import Data.Hashable hiding
(hash)
import qualified Data.Hashable as H
import Data.Int
import Data.Maybe
import Data.Primitive.Array
import Data.STRef
import GHC.Exts
import Prelude hiding
(lookup,
mapM_,
read)
import qualified Data.HashTable.Class as C
import Data.HashTable.Internal.CacheLine
import Data.HashTable.Internal.CheapPseudoRandomBitStream
import Data.HashTable.Internal.IntArray (Elem)
import qualified Data.HashTable.Internal.IntArray as U
import Data.HashTable.Internal.Utils
#ifdef DEBUG
import System.IO
#endif
newtype HashTable s k v = HT (STRef s (HashTable_ s k v))
data HashTable_ s k v = HashTable
{ forall s k v. HashTable_ s k v -> Int
_size :: {-# UNPACK #-} !Int
, forall s k v. HashTable_ s k v -> BitStream s
_rng :: {-# UNPACK #-} !(BitStream s)
, forall s k v. HashTable_ s k v -> IntArray s
_hashes :: {-# UNPACK #-} !(U.IntArray s)
, forall s k v. HashTable_ s k v -> MutableArray s k
_keys :: {-# UNPACK #-} !(MutableArray s k)
, forall s k v. HashTable_ s k v -> MutableArray s v
_values :: {-# UNPACK #-} !(MutableArray s v)
, forall s k v. HashTable_ s k v -> Int
_maxAttempts :: {-# UNPACK #-} !Int
}
instance C.HashTable HashTable where
new :: forall s k v. ST s (HashTable s k v)
new = ST s (HashTable s k v)
forall s k v. ST s (HashTable s k v)
new
newSized :: forall s k v. Int -> ST s (HashTable s k v)
newSized = Int -> ST s (HashTable s k v)
forall s k v. Int -> ST s (HashTable s k v)
newSized
insert :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert = HashTable s k v -> k -> v -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert
delete :: forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> ST s ()
delete = HashTable s k v -> k -> ST s ()
forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s ()
delete
lookup :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup = HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup
foldM :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM = (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM
mapM_ :: forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_ = ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_
lookupIndex :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex = HashTable s k v -> k -> ST s (Maybe Word)
forall k s v.
(Hashable k, Eq k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex
nextByIndex :: forall s k v. HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex = HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
forall s k v. HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex
computeOverhead :: forall s k v. HashTable s k v -> ST s Double
computeOverhead = HashTable s k v -> ST s Double
forall s k v. HashTable s k v -> ST s Double
computeOverhead
mutate :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate = HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate
mutateST :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST
instance Show (HashTable s k v) where
show :: HashTable s k v -> String
show HashTable s k v
_ = String
"<HashTable>"
new :: ST s (HashTable s k v)
new :: forall s k v. ST s (HashTable s k v)
new = Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
2 ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s (HashTable s k v))
-> ST s (HashTable s k v)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s (HashTable s k v)
forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef
{-# INLINE new #-}
newSized :: Int -> ST s (HashTable s k v)
newSized :: forall s k v. Int -> ST s (HashTable s k v)
newSized Int
n = do
let n' :: Int
n' = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numElemsInCacheLine
let k :: Int
k = Int -> Int
nextBestPrime (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxLoad
Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
k ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s (HashTable s k v))
-> ST s (HashTable s k v)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s (HashTable s k v)
forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef
{-# INLINE newSized #-}
insert :: (Eq k, Hashable k) => HashTable s k v -> k -> v -> ST s ()
insert :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert HashTable s k v
ht !k
k !v
v = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
ht ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable_ s k v
h -> HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
insert' HashTable_ s k v
h k
k v
v ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable s k v -> HashTable_ s k v -> ST s ()
forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
ht
mutate :: (Eq k, Hashable k) =>
HashTable s k v
-> k
-> (Maybe v -> (Maybe v, a))
-> ST s a
mutate :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate HashTable s k v
htRef !k
k !Maybe v -> (Maybe v, a)
f = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST HashTable s k v
htRef k
k ((Maybe v, a) -> ST s (Maybe v, a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe v, a) -> ST s (Maybe v, a))
-> (Maybe v -> (Maybe v, a)) -> Maybe v -> ST s (Maybe v, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> (Maybe v, a)
f)
{-# INLINE mutate #-}
mutateST :: (Eq k, Hashable k) =>
HashTable s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s a
mutateST :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST HashTable s k v
htRef !k
k !Maybe v -> ST s (Maybe v, a)
f = do
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
(newHt, a) <- mutate' ht k f
writeRef htRef newHt
return a
{-# INLINE mutateST #-}
computeOverhead :: HashTable s k v -> ST s Double
computeOverhead :: forall s k v. HashTable s k v -> ST s Double
computeOverhead HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s Double) -> ST s Double
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s Double
forall {b} {s} {k} {v}. Fractional b => HashTable_ s k v -> ST s b
work
where
work :: HashTable_ s k v -> ST s b
work (HashTable Int
sz BitStream s
_ IntArray s
_ MutableArray s k
_ MutableArray s v
_ Int
_) = do
nFilled <- (Int -> (k, v) -> ST s Int) -> Int -> HashTable s k v -> ST s Int
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM Int -> (k, v) -> ST s Int
forall {m :: * -> *} {a} {p}. (Monad m, Num a) => a -> p -> m a
f Int
0 HashTable s k v
htRef
let oh = (Int
totSz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
hashCodesPerWord)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
totSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nFilled)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12
return $! fromIntegral (oh::Int) / fromIntegral nFilled
where
hashCodesPerWord :: Int
hashCodesPerWord = (Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: Int)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16
totSz :: Int
totSz = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
f :: a -> p -> m a
f !a
a p
_ = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
1
delete :: (Hashable k, Eq k) =>
HashTable s k v
-> k
-> ST s ()
delete :: forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s ()
delete HashTable s k v
htRef k
k = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s ()
forall {s} {v}. HashTable_ s k v -> ST s ()
go
where
go :: HashTable_ s k v -> ST s ()
go ht :: HashTable_ s k v
ht@(HashTable Int
sz BitStream s
_ IntArray s
_ MutableArray s k
_ MutableArray s v
_ Int
_) = do
_ <- HashTable_ s k v
-> Bool -> k -> Int -> Int -> Int -> Int -> ST s (Int, Elem)
forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v
-> Bool -> k -> Int -> Int -> Int -> Int -> ST s (Int, Elem)
delete' HashTable_ s k v
ht Bool
False k
k Int
b1 Int
b2 Int
h1 Int
h2
return ()
where
h1 :: Int
h1 = k -> Int
forall k. Hashable k => k -> Int
hash1 k
k
h2 :: Int
h2 = k -> Int
forall k. Hashable k => k -> Int
hash2 k
k
b1 :: Int
b1 = Int -> Int -> Int
whichLine Int
h1 Int
sz
b2 :: Int
b2 = Int -> Int -> Int
whichLine Int
h2 Int
sz
lookup :: (Eq k, Hashable k) =>
HashTable s k v
-> k
-> ST s (Maybe v)
lookup :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup HashTable s k v
htRef k
k = do
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
lookup' ht k
{-# INLINE lookup #-}
lookup' :: (Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> ST s (Maybe v)
lookup' :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> ST s (Maybe v)
lookup' (HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) !k
k = do
idx1 <- MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
forall k s.
Eq k =>
MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
searchOne MutableArray s k
keys IntArray s
hashes k
k Int
b1 Elem
he1
if idx1 >= 0
then do
v <- readArray values idx1
return $! Just v
else do
idx2 <- searchOne keys hashes k b2 he2
if idx2 >= 0
then do
v <- readArray values idx2
return $! Just v
else
return Nothing
where
h1 :: Int
h1 = k -> Int
forall k. Hashable k => k -> Int
hash1 k
k
h2 :: Int
h2 = k -> Int
forall k. Hashable k => k -> Int
hash2 k
k
he1 :: Elem
he1 = Int -> Elem
hashToElem Int
h1
he2 :: Elem
he2 = Int -> Elem
hashToElem Int
h2
b1 :: Int
b1 = Int -> Int -> Int
whichLine Int
h1 Int
sz
b2 :: Int
b2 = Int -> Int -> Int
whichLine Int
h2 Int
sz
{-# INLINE lookup' #-}
searchOne :: (Eq k) =>
MutableArray s k
-> U.IntArray s
-> k
-> Int
-> Elem
-> ST s Int
searchOne :: forall k s.
Eq k =>
MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
searchOne !MutableArray s k
keys !IntArray s
hashes !k
k !Int
b0 !Elem
h = Int -> ST s Int
go Int
b0
where
go :: Int -> ST s Int
go !Int
b = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"searchOne: go/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Elem -> String
forall a. Show a => a -> String
show Elem
h
idx <- IntArray s -> Int -> Elem -> ST s Int
forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b Elem
h
debug $ "searchOne: cacheLineSearch returned " ++ show idx
case idx of
-1 -> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
Int
_ -> do
k' <- MutableArray (PrimState (ST s)) k -> Int -> ST s k
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
MutableArray (PrimState (ST s)) k
keys Int
idx
if k == k'
then return idx
else do
let !idx' = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
if isCacheLineAligned idx'
then return (-1)
else go idx'
{-# INLINE searchOne #-}
foldM :: (a -> (k,v) -> ST s a)
-> a
-> HashTable s k v
-> ST s a
foldM :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM a -> (k, v) -> ST s a
f a
seed0 HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s a) -> ST s a
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> (k, v) -> ST s a) -> a -> HashTable_ s k v -> ST s a
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable_ s k v -> ST s a
foldMWork a -> (k, v) -> ST s a
f a
seed0
{-# INLINE foldM #-}
foldMWork :: (a -> (k,v) -> ST s a)
-> a
-> HashTable_ s k v
-> ST s a
foldMWork :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable_ s k v -> ST s a
foldMWork a -> (k, v) -> ST s a
f a
seed0 (HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) = Int -> a -> ST s a
go Int
0 a
seed0
where
totSz :: Int
totSz = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
go :: Int -> a -> ST s a
go !Int
i !a
seed | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totSz = a -> ST s a
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if h /= emptyMarker
then do
k <- readArray keys i
v <- readArray values i
!seed' <- f seed (k,v)
go (i+1) seed'
else
go (i+1) seed
{-# INLINE foldMWork #-}
mapM_ :: ((k,v) -> ST s a)
-> HashTable s k v
-> ST s ()
mapM_ :: forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_ (k, v) -> ST s a
f HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((k, v) -> ST s a) -> HashTable_ s k v -> ST s ()
forall k v s a. ((k, v) -> ST s a) -> HashTable_ s k v -> ST s ()
mapMWork (k, v) -> ST s a
f
{-# INLINE mapM_ #-}
mapMWork :: ((k,v) -> ST s a)
-> HashTable_ s k v
-> ST s ()
mapMWork :: forall k v s a. ((k, v) -> ST s a) -> HashTable_ s k v -> ST s ()
mapMWork (k, v) -> ST s a
f (HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) = Int -> ST s ()
go Int
0
where
totSz :: Int
totSz = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
go :: Int -> ST s ()
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totSz = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if h /= emptyMarker
then do
k <- readArray keys i
v <- readArray values i
_ <- f (k,v)
go (i+1)
else
go (i+1)
{-# INLINE mapMWork #-}
newSizedReal :: Int -> ST s (HashTable_ s k v)
newSizedReal :: forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
nbuckets = do
let !ntotal :: Int
ntotal = Int
nbuckets Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numElemsInCacheLine
let !maxAttempts :: Int
maxAttempts = Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word -> Int
log2 (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
nbuckets)
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"creating cuckoo hash table with " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
nbuckets String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" buckets having " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
ntotal String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" total slots"
rng <- ST s (BitStream s)
forall s. ST s (BitStream s)
newBitStream
hashes <- U.newArray ntotal
keys <- newArray ntotal undefined
values <- newArray ntotal undefined
return $! HashTable nbuckets rng hashes keys values maxAttempts
insert' :: (Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> v
-> ST s (HashTable_ s k v)
insert' :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
insert' HashTable_ s k v
ht k
k v
v = do
String -> ST s ()
forall s. String -> ST s ()
debug String
"insert': begin"
mbX <- HashTable_ s k v -> k -> v -> ST s (Maybe (k, v))
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (Maybe (k, v))
updateOrFail HashTable_ s k v
ht k
k v
v
z <- maybe (return ht)
(\(k
k',v
v') -> HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
grow HashTable_ s k v
ht k
k' v
v')
mbX
debug "insert': end"
return z
{-# INLINE insert #-}
mutate' :: (Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s (HashTable_ s k v, a)
mutate' :: forall k s v a.
(Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s (HashTable_ s k v, a)
mutate' ht :: HashTable_ s k v
ht@(HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) !k
k !Maybe v -> ST s (Maybe v, a)
f = do
!(maybeVal, idx, _hashCode) <- ST s (Maybe v, Int, Int)
lookupSlot
!fRes <- f maybeVal
case (maybeVal, fRes) of
(Maybe v
Nothing, (Maybe v
Nothing, a
a)) -> (HashTable_ s k v, a) -> ST s (HashTable_ s k v, a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashTable_ s k v
ht, a
a)
(Just v
_v, (Just v
v', a
a)) -> do
MutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
MutableArray (PrimState (ST s)) v
values Int
idx v
v'
(HashTable_ s k v, a) -> ST s (HashTable_ s k v, a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashTable_ s k v
ht, a
a)
(Just v
_v, (Maybe v
Nothing, a
a)) -> do
HashTable_ s k v -> Int -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
idx
(HashTable_ s k v, a) -> ST s (HashTable_ s k v, a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashTable_ s k v
ht, a
a)
(Maybe v
Nothing, (Just v
v', a
a)) -> do
newHt <- v -> ST s (HashTable_ s k v)
insertNew v
v'
return (newHt, a)
where
h1 :: Int
h1 = k -> Int
forall k. Hashable k => k -> Int
hash1 k
k
h2 :: Int
h2 = k -> Int
forall k. Hashable k => k -> Int
hash2 k
k
b1 :: Int
b1 = Int -> Int -> Int
whichLine Int
h1 Int
sz
b2 :: Int
b2 = Int -> Int -> Int
whichLine Int
h2 Int
sz
he1 :: Elem
he1 = Int -> Elem
hashToElem Int
h1
he2 :: Elem
he2 = Int -> Elem
hashToElem Int
h2
lookupSlot :: ST s (Maybe v, Int, Int)
lookupSlot = do
idx1 <- MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
forall k s.
Eq k =>
MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
searchOne MutableArray s k
keys IntArray s
hashes k
k Int
b1 Elem
he1
if idx1 >= 0
then do
v <- readArray values idx1
return (Just v, idx1, h1)
else do
idx2 <- searchOne keys hashes k b2 he2
if idx2 >= 0
then do
v <- readArray values idx2
return (Just v, idx2, h2)
else do
return (Nothing, -1, -1)
insertNew :: v -> ST s (HashTable_ s k v)
insertNew v
v = do
idxE1 <- IntArray s -> Int -> Elem -> ST s Int
forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b1 Elem
emptyMarker
if idxE1 >= 0
then do
insertIntoSlot ht idxE1 he1 k v
return ht
else do
idxE2 <- cacheLineSearch hashes b2 emptyMarker
if idxE2 >= 0
then do
insertIntoSlot ht idxE2 he2 k v
return ht
else do
result <- cuckooOrFail ht h1 h2 b1 b2 k v
maybe (return ht)
(\(k
k', v
v') -> do
newHt <- HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
grow HashTable_ s k v
ht k
k' v
v'
return newHt)
result
{-# INLINE mutate' #-}
deleteFromSlot :: (Eq k, Hashable k) =>
HashTable_ s k v
-> Int
-> ST s ()
deleteFromSlot :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> ST s ()
deleteFromSlot _ht :: HashTable_ s k v
_ht@(HashTable Int
_ BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) Int
idx = do
IntArray s -> Int -> Elem -> ST s ()
forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
emptyMarker
MutableArray (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
MutableArray (PrimState (ST s)) k
keys Int
idx k
forall a. HasCallStack => a
undefined
MutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
MutableArray (PrimState (ST s)) v
values Int
idx v
forall a. HasCallStack => a
undefined
{-# INLINE deleteFromSlot #-}
insertIntoSlot :: (Eq k, Hashable k) =>
HashTable_ s k v
-> Int
-> Elem
-> k
-> v
-> ST s ()
insertIntoSlot :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot _ht :: HashTable_ s k v
_ht@(HashTable Int
_ BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) Int
idx Elem
he k
k v
v = do
IntArray s -> Int -> Elem -> ST s ()
forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
MutableArray (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
MutableArray (PrimState (ST s)) k
keys Int
idx k
k
MutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
MutableArray (PrimState (ST s)) v
values Int
idx v
v
{-# INLINE insertIntoSlot #-}
updateOrFail :: (Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> v
-> ST s (Maybe (k,v))
updateOrFail :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (Maybe (k, v))
updateOrFail ht :: HashTable_ s k v
ht@(HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) k
k v
v = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"updateOrFail: begin: sz = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
" h1=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", h2=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h2
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", b1=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", b2=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b2
(didx, hashCode) <- HashTable_ s k v
-> Bool -> k -> Int -> Int -> Int -> Int -> ST s (Int, Elem)
forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v
-> Bool -> k -> Int -> Int -> Int -> Int -> ST s (Int, Elem)
delete' HashTable_ s k v
ht Bool
True k
k Int
b1 Int
b2 Int
h1 Int
h2
debug $ "delete' returned (" ++ show didx ++ "," ++ show hashCode ++ ")"
if didx >= 0
then do
U.writeArray hashes didx hashCode
writeArray keys didx k
writeArray values didx v
return Nothing
else cuckoo
where
h1 :: Int
h1 = k -> Int
forall k. Hashable k => k -> Int
hash1 k
k
h2 :: Int
h2 = k -> Int
forall k. Hashable k => k -> Int
hash2 k
k
b1 :: Int
b1 = Int -> Int -> Int
whichLine Int
h1 Int
sz
b2 :: Int
b2 = Int -> Int -> Int
whichLine Int
h2 Int
sz
cuckoo :: ST s (Maybe (k, v))
cuckoo = do
String -> ST s ()
forall s. String -> ST s ()
debug String
"cuckoo: calling cuckooOrFail"
result <- HashTable_ s k v
-> Int -> Int -> Int -> Int -> k -> v -> ST s (Maybe (k, v))
forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v
-> Int -> Int -> Int -> Int -> k -> v -> ST s (Maybe (k, v))
cuckooOrFail HashTable_ s k v
ht Int
h1 Int
h2 Int
b1 Int
b2 k
k v
v
debug $ "cuckoo: cuckooOrFail returned " ++
(if isJust result then "Just _" else "Nothing")
maybe (return Nothing)
(return . Just)
result
{-# INLINE updateOrFail #-}
delete' :: (Hashable k, Eq k) =>
HashTable_ s k v
-> Bool
-> k
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Elem)
delete' :: forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v
-> Bool -> k -> Int -> Int -> Int -> Int -> ST s (Int, Elem)
delete' (HashTable Int
_ BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) !Bool
updating !k
k Int
b1 Int
b2 Int
h1 Int
h2 = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"delete' b1=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b1
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b2=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b2
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h1=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h1
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h2=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h2
IntArray s -> Int -> ST s ()
forall s. IntArray s -> Int -> ST s ()
prefetchWrite IntArray s
hashes Int
b2
let !he1 :: Elem
he1 = Int -> Elem
hashToElem Int
h1
let !he2 :: Elem
he2 = Int -> Elem
hashToElem Int
h2
idx1 <- MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
forall k s.
Eq k =>
MutableArray s k -> IntArray s -> k -> Int -> Elem -> ST s Int
searchOne MutableArray s k
keys IntArray s
hashes k
k Int
b1 Elem
he1
if idx1 < 0
then do
idx2 <- searchOne keys hashes k b2 he2
if idx2 < 0
then if updating
then do
debug $ "delete': looking for empty element"
idxE1 <- cacheLineSearch hashes b1 emptyMarker
debug $ "delete': idxE1 was " ++ show idxE1
if idxE1 >= 0
then return (idxE1, he1)
else do
idxE2 <- cacheLineSearch hashes b2 emptyMarker
debug $ "delete': idxE2 was " ++ show idxE1
if idxE2 >= 0
then return (idxE2, he2)
else return (-1, 0)
else return (-1, 0)
else deleteIt idx2 he2
else deleteIt idx1 he1
where
deleteIt :: Int -> b -> ST s (Int, b)
deleteIt !Int
idx !b
h = do
if Bool -> Bool
not Bool
updating
then do
IntArray s -> Int -> Elem -> ST s ()
forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
emptyMarker
MutableArray (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
MutableArray (PrimState (ST s)) k
keys Int
idx k
forall a. HasCallStack => a
undefined
MutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
MutableArray (PrimState (ST s)) v
values Int
idx v
forall a. HasCallStack => a
undefined
else () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Int, b) -> ST s (Int, b)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, b) -> ST s (Int, b)) -> (Int, b) -> ST s (Int, b)
forall a b. (a -> b) -> a -> b
$! (Int
idx, b
h)
{-# INLINE delete' #-}
cuckooOrFail :: (Hashable k, Eq k) =>
HashTable_ s k v
-> Int
-> Int
-> Int
-> Int
-> k
-> v
-> ST s (Maybe (k,v))
cuckooOrFail :: forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v
-> Int -> Int -> Int -> Int -> k -> v -> ST s (Maybe (k, v))
cuckooOrFail (HashTable Int
sz BitStream s
rng IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
maxAttempts0)
!Int
h1_0 !Int
h2_0 !Int
b1_0 !Int
b2_0 !k
k0 !v
v0 = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"cuckooOrFail h1_0=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h1_0
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h2_0=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h2_0
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b1_0=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b1_0
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b2_0=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b2_0
!lineChoice <- BitStream s -> ST s Word
forall s. BitStream s -> ST s Word
getNextBit BitStream s
rng
debug $ "chose line " ++ show lineChoice
let (!b, !h) = if lineChoice == 0 then (b1_0, h1_0) else (b2_0, h2_0)
go b h k0 v0 maxAttempts0
where
randomIdx :: b -> ST s b
randomIdx !b
b = do
!z <- Int -> BitStream s -> ST s Word
forall s. Int -> BitStream s -> ST s Word
getNBits Int
cacheLineIntBits BitStream s
rng
return $! b + fromIntegral z
bumpIdx :: Int -> Int -> k -> v -> ST s (Elem, k, v)
bumpIdx !Int
idx !Int
h !k
k !v
v = do
let !he :: Elem
he = Int -> Elem
hashToElem Int
h
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"bumpIdx idx=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" he=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Elem -> String
forall a. Show a => a -> String
show Elem
he
!he' <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
debug $ "bumpIdx: he' was " ++ show he'
!k' <- readArray keys idx
v' <- readArray values idx
U.writeArray hashes idx he
writeArray keys idx k
writeArray values idx v
debug $ "bumped key with he'=" ++ show he'
return $! (he', k', v')
otherHash :: Elem -> p -> Int
otherHash Elem
he p
k = if Int -> Elem
hashToElem Int
h1 Elem -> Elem -> Bool
forall a. Eq a => a -> a -> Bool
== Elem
he then Int
h2 else Int
h1
where
h1 :: Int
h1 = p -> Int
forall k. Hashable k => k -> Int
hash1 p
k
h2 :: Int
h2 = p -> Int
forall k. Hashable k => k -> Int
hash2 p
k
tryWrite :: Int -> Int -> k -> v -> a -> ST s (Maybe (k, v))
tryWrite !Int
b !Int
h k
k v
v a
maxAttempts = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"tryWrite b=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h
idx <- IntArray s -> Int -> Elem -> ST s Int
forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b Elem
emptyMarker
debug $ "cacheLineSearch returned " ++ show idx
if idx >= 0
then do
U.writeArray hashes idx $! hashToElem h
writeArray keys idx k
writeArray values idx v
return Nothing
else go b h k v $! maxAttempts - 1
go :: Int -> Int -> k -> v -> a -> ST s (Maybe (k, v))
go !Int
b !Int
h !k
k v
v !a
maxAttempts | a
maxAttempts a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Maybe (k, v) -> ST s (Maybe (k, v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (k, v) -> ST s (Maybe (k, v)))
-> Maybe (k, v) -> ST s (Maybe (k, v))
forall a b. (a -> b) -> a -> b
$! (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
k,v
v)
| Bool
otherwise = do
idx <- Int -> ST s Int
forall {b}. Num b => b -> ST s b
randomIdx Int
b
(!he0', !k', v') <- bumpIdx idx h k v
let !h' = Elem -> k -> Int
forall {p}. Hashable p => Elem -> p -> Int
otherHash Elem
he0' k
k'
let !b' = Int -> Int -> Int
whichLine Int
h' Int
sz
tryWrite b' h' k' v' maxAttempts
grow :: (Eq k, Hashable k) =>
HashTable_ s k v
-> k
-> v
-> ST s (HashTable_ s k v)
grow :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (HashTable_ s k v)
grow (HashTable Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_) k
k0 v
v0 = do
newHt <- Int -> ST s (HashTable_ s k v)
grow' (Int -> ST s (HashTable_ s k v)) -> Int -> ST s (HashTable_ s k v)
forall a b. (a -> b) -> a -> b
$! Double -> Int -> Int
bumpSize Double
bumpFactor Int
sz
mbR <- updateOrFail newHt k0 v0
maybe (return newHt)
(\(k, v)
_ -> Int -> ST s (HashTable_ s k v)
grow' (Int -> ST s (HashTable_ s k v)) -> Int -> ST s (HashTable_ s k v)
forall a b. (a -> b) -> a -> b
$ Double -> Int -> Int
bumpSize Double
bumpFactor (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HashTable_ s k v -> Int
forall s k v. HashTable_ s k v -> Int
_size HashTable_ s k v
newHt)
mbR
where
grow' :: Int -> ST s (HashTable_ s k v)
grow' Int
newSz = do
String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"growing table, oldsz = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", newsz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
newSz
newHt <- Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
newSz
rehash newSz newHt
rehash :: Int -> HashTable_ s k v -> ST s (HashTable_ s k v)
rehash !Int
newSz !HashTable_ s k v
newHt = Int -> ST s (HashTable_ s k v)
go Int
0
where
totSz :: Int
totSz = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
go :: Int -> ST s (HashTable_ s k v)
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totSz = HashTable_ s k v -> ST s (HashTable_ s k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
newHt
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if (h /= emptyMarker)
then do
k <- readArray keys i
v <- readArray values i
mbR <- updateOrFail newHt k v
maybe (go $ i + 1)
(\(k, v)
_ -> Int -> ST s (HashTable_ s k v)
grow' (Int -> ST s (HashTable_ s k v)) -> Int -> ST s (HashTable_ s k v)
forall a b. (a -> b) -> a -> b
$ Double -> Int -> Int
bumpSize Double
bumpFactor Int
newSz)
mbR
else go $ i + 1
hashPrime :: Int
hashPrime :: Int
hashPrime = if Int
wordSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 then Int
hashPrime32 else Int
hashPrime64
where
hashPrime32 :: Int
hashPrime32 = Int
0xedf2a025
hashPrime64 :: Int
hashPrime64 = Int
0x3971ca9c8b3722e9
hash1 :: Hashable k => k -> Int
hash1 :: forall k. Hashable k => k -> Int
hash1 = k -> Int
forall k. Hashable k => k -> Int
H.hash
{-# INLINE hash1 #-}
hash2 :: Hashable k => k -> Int
hash2 :: forall k. Hashable k => k -> Int
hash2 = Int -> k -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
hashPrime
{-# INLINE hash2 #-}
hashToElem :: Int -> Elem
hashToElem :: Int -> Elem
hashToElem !Int
h = Elem
out
where
!(I# Int#
lo#) = Int
h Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
U.elemMask
!m# :: Word#
m# = Int# -> Int# -> Word#
maskw# Int#
lo# Int#
0#
!nm# :: Word#
nm# = Word# -> Word#
not# Word#
m#
!r# :: Word#
r# = ((Int# -> Word#
int2Word# Int#
1#) Word# -> Word# -> Word#
`and#` Word#
m#) Word# -> Word# -> Word#
`or#` (Int# -> Word#
int2Word# Int#
lo# Word# -> Word# -> Word#
`and#` Word#
nm#)
!out :: Elem
out = Word# -> Elem
U.primWordToElem Word#
r#
{-# INLINE hashToElem #-}
emptyMarker :: Elem
emptyMarker :: Elem
emptyMarker = Elem
0
maxLoad :: Double
maxLoad :: Double
maxLoad = Double
0.88
bumpFactor :: Double
bumpFactor :: Double
bumpFactor = Double
0.73
debug :: String -> ST s ()
#ifdef DEBUG
debug s = unsafeIOToST (putStrLn s >> hFlush stdout)
#else
debug :: forall s. String -> ST s ()
debug String
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
{-# INLINE debug #-}
whichLine :: Int -> Int -> Int
whichLine :: Int -> Int -> Int
whichLine !Int
h !Int
sz = Int -> Int -> Int
whichBucket Int
h Int
sz Int -> Int -> Int
`iShiftL` Int
cacheLineIntBits
{-# INLINE whichLine #-}
newRef :: HashTable_ s k v -> ST s (HashTable s k v)
newRef :: forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef = (STRef s (HashTable_ s k v) -> HashTable s k v)
-> ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM STRef s (HashTable_ s k v) -> HashTable s k v
forall s k v. STRef s (HashTable_ s k v) -> HashTable s k v
HT (ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v))
-> (HashTable_ s k v -> ST s (STRef s (HashTable_ s k v)))
-> HashTable_ s k v
-> ST s (HashTable s k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashTable_ s k v -> ST s (STRef s (HashTable_ s k v))
forall a s. a -> ST s (STRef s a)
newSTRef
{-# INLINE newRef #-}
writeRef :: HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef :: forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef (HT STRef s (HashTable_ s k v)
ref) HashTable_ s k v
ht = STRef s (HashTable_ s k v) -> HashTable_ s k v -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (HashTable_ s k v)
ref HashTable_ s k v
ht
{-# INLINE writeRef #-}
readRef :: HashTable s k v -> ST s (HashTable_ s k v)
readRef :: forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef (HT STRef s (HashTable_ s k v)
ref) = STRef s (HashTable_ s k v) -> ST s (HashTable_ s k v)
forall s a. STRef s a -> ST s a
readSTRef STRef s (HashTable_ s k v)
ref
{-# INLINE readRef #-}
lookupIndex :: (Hashable k, Eq k) => HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex :: forall k s v.
(Hashable k, Eq k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex HashTable s k v
htRef k
k =
do HashTable sz _ hashes keys _ _ <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
let !h1 = k -> Int
forall k. Hashable k => k -> Int
hash1 k
k
!h2 = k -> Int
forall k. Hashable k => k -> Int
hash2 k
k
!he1 = Int -> Elem
hashToElem Int
h1
!he2 = Int -> Elem
hashToElem Int
h2
!b1 = Int -> Int -> Int
whichLine Int
h1 Int
sz
!b2 = Int -> Int -> Int
whichLine Int
h2 Int
sz
idx1 <- searchOne keys hashes k b1 he1
if idx1 >= 0
then return $! (Just $! fromIntegral idx1)
else do idx2 <- searchOne keys hashes k b2 he2
if idx2 >= 0
then return $! (Just $! fromIntegral idx2)
else return Nothing
nextByIndex :: HashTable s k v -> Word -> ST s (Maybe (Word,k,v))
nextByIndex :: forall s k v. HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex HashTable s k v
htRef Word
i0 =
do HashTable sz _ hashes keys values _ <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
let totSz = Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
go Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totSz = Maybe (a, k, v) -> ST s (Maybe (a, k, v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, k, v)
forall a. Maybe a
Nothing
| Bool
otherwise =
do h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if h == emptyMarker
then go (i+1)
else do k <- readArray keys i
v <- readArray values i
let !i' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
return (Just (i',k,v))
go (fromIntegral i0)