{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
{-# LANGUAGE MagicHash    #-}

{-|

A hash table using the cuckoo strategy. (See
<http://en.wikipedia.org/wiki/Cuckoo_hashing>). Use this hash table if you...

  * want the fastest possible inserts, and very fast lookups.

  * are conscious of memory usage; this table has less space overhead than
    "Data.HashTable.ST.Basic" or "Data.HashTable.ST.Linear".

  * don't care that a table resize might pause for a long time to rehash all
    of the key-value mappings.


/Details:/

The basic idea of cuckoo hashing, first introduced by Pagh and Rodler in 2001,
is to use /d/ hash functions instead of only one; in this implementation d=2
and the strategy we use is to split up a flat array of slots into @k@ buckets,
each cache-line-sized:

@
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+----------+
|x0|x1|x2|x3|x4|x5|x6|x7|y0|y1|y2|y3|y4|y5|y6|y7|z0|z1|z2........|
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+----------+
[  ^^^  bucket 0  ^^^  ][  ^^^  bucket 1  ^^^  ]...
@

There are actually three parallel arrays: one unboxed array of 'Int's for hash
codes, one boxed array for keys, and one boxed array for values. When looking
up a key-value mapping, we hash the key using two hash functions and look in
both buckets in the hash code array for the key. Each bucket is cache-line
sized, with its keys in no particular order. Because the hash code array is
unboxed, we can search it for the key using a highly-efficient branchless
strategy in C code, using SSE instructions if available.

On insert, if both buckets are full, we knock out a randomly-selected entry
from one of the buckets (using a random walk ensures that \"key cycles\" are
broken with maximum probability) and try to repeat the insert procedure. This
process may not succeed; if all items have not successfully found a home after
some number of tries, we give up and rehash all of the elements into a larger
table.

/Space overhead: experimental results/

The implementation of cuckoo hash given here is almost as fast for lookups as
the basic open-addressing hash table using linear probing, and on average is
more space-efficient: in randomized testing on my 64-bit machine (see
@test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean
overhead is 0.77 machine words per key-value mapping, with a standard deviation
of 0.29 words, and 1.23 words per mapping at the 95th percentile.

/References:/

  * A. Pagh and F. Rodler. Cuckoo hashing. In /Proceedings of the 9th
    Annual European Symposium on Algorithms/, pp. 121-133, 2001.
-}


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


------------------------------------------------------------------------------
-- | A cuckoo hash table.
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     -- ^ in buckets, total size is
                                              --   numElemsInCacheLine * _size
    , 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             = forall s k v. ST s (HashTable s k v)
new
    newSized :: forall s k v. Int -> ST s (HashTable s k v)
newSized        = 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          = 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          = 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          = 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           = 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_           = 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     = 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     = 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 = 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          = 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        = 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>"


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.new'.
new :: ST s (HashTable s k v)
new :: forall s k v. ST s (HashTable s k v)
new = forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef
{-# INLINE new #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.newSized'.
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 forall a. Num a => a -> a -> a
+ Int
numElemsInCacheLine forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
numElemsInCacheLine
    let k :: Int
k = Int -> Int
nextBestPrime forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' forall a. Fractional a => a -> a -> a
/ Double
maxLoad
    forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef
{-# INLINE newSized #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.insert'.
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 = forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
ht forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashTable_ s k v
h -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = 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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
    HashTable_ s k v
ht <- forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    (HashTable_ s k v
newHt, a
a) <- 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' HashTable_ s k v
ht k
k Maybe v -> ST s (Maybe v, a)
f
    forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
htRef HashTable_ s k v
newHt
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE mutateST #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.computeOverhead'.
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 = forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        Int
nFilled <- forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM forall {m :: * -> *} {a} {p}. (Monad m, Num a) => a -> p -> m a
f Int
0 HashTable s k v
htRef

        let oh :: Int
oh = (Int
totSz forall a. Integral a => a -> a -> a
`div` Int
hashCodesPerWord)  -- one half or quarter word
                                                 -- per element in hashes
               forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* (Int
totSz forall a. Num a => a -> a -> a
- Int
nFilled)           -- two words per non-filled entry
               forall a. Num a => a -> a -> a
+ Int
12                              -- fixed overhead

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
oh::Int) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nFilled

      where
        hashCodesPerWord :: Int
hashCodesPerWord = (forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: Int)) forall a. Integral a => a -> a -> a
`div` Int
16
        totSz :: Int
totSz = Int
numElemsInCacheLine forall a. Num a => a -> a -> a
* Int
sz

        f :: a -> p -> m a
f !a
a p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
aforall a. Num a => a -> a -> a
+a
1


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.delete'.
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 = forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        (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
        forall (m :: * -> *) a. Monad m => a -> m a
return ()

      where
        h1 :: Int
h1 = forall k. Hashable k => k -> Int
hash1 k
k
        h2 :: Int
h2 = 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


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.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 s k v
htRef k
k = do
    HashTable_ s k v
ht <- forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> ST s (Maybe v)
lookup' HashTable_ s k v
ht k
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
    -- Unlike the write case, prefetch doesn't seem to help here for lookup.
    -- prefetchRead hashes b2
    Int
idx1 <- 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 Int
idx1 forall a. Ord a => a -> a -> Bool
>= Int
0
      then do
        v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
idx1
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just v
v
      else do
        Int
idx2 <- 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
b2 Elem
he2
        if Int
idx2 forall a. Ord a => a -> a -> Bool
>= Int
0
          then do
            v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
idx2
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just v
v
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where
    h1 :: Int
h1 = forall k. Hashable k => k -> Int
hash1 k
k
    h2 :: Int
h2 = 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
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"searchOne: go/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
h
        Int
idx <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b Elem
h
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"searchOne: cacheLineSearch returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx

        case Int
idx of
          -1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
          Int
_  -> do
              k
k' <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
idx
              if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                then forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
                else do
                  let !idx' :: Int
idx' = Int
idx forall a. Num a => a -> a -> a
+ Int
1
                  if Int -> Bool
isCacheLineAligned Int
idx'
                    then forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
                    else Int -> ST s Int
go Int
idx'
{-# INLINE searchOne #-}



------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.foldM'.
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 = forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a. Num a => a -> a -> a
* Int
sz

    go :: Int -> a -> ST s a
go !Int
i !a
seed | Int
i forall a. Ord a => a -> a -> Bool
>= Int
totSz = forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
                | Bool
otherwise  = do
        Elem
h <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
        if Elem
h forall a. Eq a => a -> a -> Bool
/= Elem
emptyMarker
          then do
            k
k <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
i
            v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
i
            !a
seed' <- a -> (k, v) -> ST s a
f a
seed (k
k,v
v)
            Int -> a -> ST s a
go (Int
iforall a. Num a => a -> a -> a
+Int
1) a
seed'

          else
            Int -> a -> ST s a
go (Int
iforall a. Num a => a -> a -> a
+Int
1) a
seed
{-# INLINE foldMWork #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.mapM_'.
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 = forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a. Num a => a -> a -> a
* Int
sz

    go :: Int -> ST s ()
go !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
totSz = forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise  = do
        Elem
h <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
        if Elem
h forall a. Eq a => a -> a -> Bool
/= Elem
emptyMarker
          then do
            k
k <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
i
            v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
i
            a
_ <- (k, v) -> ST s a
f (k
k,v
v)
            Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
          else
            Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE mapMWork #-}


---------------------------------
-- Private declarations follow --
---------------------------------


------------------------------------------------------------------------------
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 forall a. Num a => a -> a -> a
* Int
numElemsInCacheLine
    let !maxAttempts :: Int
maxAttempts = Int
12 forall a. Num a => a -> a -> a
+ (Word -> Int
log2 forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
nbuckets)

    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"creating cuckoo hash table with " forall a. [a] -> [a] -> [a]
++
            forall a. Show a => a -> String
show Int
nbuckets forall a. [a] -> [a] -> [a]
++ String
" buckets having " forall a. [a] -> [a] -> [a]
++
            forall a. Show a => a -> String
show Int
ntotal forall a. [a] -> [a] -> [a]
++ String
" total slots"

    BitStream s
rng    <- forall s. ST s (BitStream s)
newBitStream
    IntArray s
hashes <- forall s. Int -> ST s (IntArray s)
U.newArray Int
ntotal
    MutableArray s k
keys   <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
ntotal forall a. HasCallStack => a
undefined
    MutableArray s v
values <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
ntotal forall a. HasCallStack => a
undefined

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s k v.
Int
-> BitStream s
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> Int
-> HashTable_ s k v
HashTable Int
nbuckets BitStream s
rng IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
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
    forall s. String -> ST s ()
debug String
"insert': begin"
    Maybe (k, v)
mbX <- 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
    HashTable_ s k v
z <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht)
               (\(k
k',v
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')
               Maybe (k, v)
mbX
    forall s. String -> ST s ()
debug String
"insert': end"
    forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
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
    !(Maybe v
maybeVal, Int
idx, Int
_hashCode) <- ST s (Maybe v, Int, Int)
lookupSlot
    !(Maybe v, a)
fRes <- Maybe v -> ST s (Maybe v, a)
f Maybe v
maybeVal
    case (Maybe v
maybeVal, (Maybe v, a)
fRes) of
        (Maybe v
Nothing, (Maybe v
Nothing, a
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
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
idx v
v'
            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
            forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
idx
            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
            HashTable_ s k v
newHt <- v -> ST s (HashTable_ s k v)
insertNew v
v'
            forall (m :: * -> *) a. Monad m => a -> m a
return (HashTable_ s k v
newHt, a
a)

  where
    h1 :: Int
h1 = forall k. Hashable k => k -> Int
hash1 k
k
    h2 :: Int
h2 = 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
        Int
idx1 <- 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 Int
idx1 forall a. Ord a => a -> a -> Bool
>= Int
0
          then do
            v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
idx1
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v
v, Int
idx1, Int
h1)
          else do
            Int
idx2 <- 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
b2 Elem
he2
            if Int
idx2 forall a. Ord a => a -> a -> Bool
>= Int
0
              then do
                v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
idx2
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v
v, Int
idx2, Int
h2)
              else do
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, -Int
1, -Int
1)

    insertNew :: v -> ST s (HashTable_ s k v)
insertNew v
v = do
        Int
idxE1 <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b1 Elem
emptyMarker
        if Int
idxE1 forall a. Ord a => a -> a -> Bool
>= Int
0
          then do
            forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot HashTable_ s k v
ht Int
idxE1 Elem
he1 k
k v
v
            forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht
          else do
            Int
idxE2 <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b2 Elem
emptyMarker
            if Int
idxE2 forall a. Ord a => a -> a -> Bool
>= Int
0
              then do
                forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot HashTable_ s k v
ht Int
idxE2 Elem
he2 k
k v
v
                forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht
              else do
                Maybe (k, v)
result <- 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
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht)
                      (\(k
k', v
v') -> do
                          HashTable_ s k v
newHt <- 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'
                          forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
newHt)
                      Maybe (k, v)
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
    forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
emptyMarker
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
idx forall a. HasCallStack => a
undefined
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
idx 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
    forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
idx k
k
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray 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
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"updateOrFail: begin: sz = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"   h1=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h1 forall a. [a] -> [a] -> [a]
++ String
", h2=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h2
            forall a. [a] -> [a] -> [a]
++ String
", b1=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b1 forall a. [a] -> [a] -> [a]
++ String
", b2=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b2
    (Int
didx, Elem
hashCode) <- 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

    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"delete' returned (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
didx forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
hashCode forall a. [a] -> [a] -> [a]
++ String
")"

    if Int
didx forall a. Ord a => a -> a -> Bool
>= Int
0
      then do
        forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
didx Elem
hashCode
        forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
didx k
k
        forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
didx v
v
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else ST s (Maybe (k, v))
cuckoo

  where
    h1 :: Int
h1 = forall k. Hashable k => k -> Int
hash1 k
k
    h2 :: Int
h2 = 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
        forall s. String -> ST s ()
debug String
"cuckoo: calling cuckooOrFail"
        Maybe (k, v)
result <- 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
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"cuckoo: cuckooOrFail returned " forall a. [a] -> [a] -> [a]
++
                  (if forall a. Maybe a -> Bool
isJust Maybe (k, v)
result then String
"Just _" else String
"Nothing")

        -- if cuckoo failed we need to grow the table.
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
              (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
              Maybe (k, v)
result
{-# INLINE updateOrFail #-}


------------------------------------------------------------------------------
-- Returns either (-1, 0) (not found, and both buckets full ==> trigger
-- cuckoo), or the slot in the array where it would be safe to write the given
-- key, and the hashcode to use there
delete' :: (Hashable k, Eq k) =>
           HashTable_ s k v     -- ^ hash table
        -> Bool                 -- ^ are we updating?
        -> k                    -- ^ key
        -> Int                  -- ^ cache line start address 1
        -> Int                  -- ^ cache line start address 2
        -> Int                  -- ^ hash1
        -> Int                  -- ^ hash2
        -> 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
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"delete' b1=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b1
              forall a. [a] -> [a] -> [a]
++ String
" b2=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b2
              forall a. [a] -> [a] -> [a]
++ String
" h1=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h1
              forall a. [a] -> [a] -> [a]
++ String
" h2=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h2
    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
    Int
idx1 <- 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 Int
idx1 forall a. Ord a => a -> a -> Bool
< Int
0
      then do
        Int
idx2 <- 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
b2 Elem
he2
        if Int
idx2 forall a. Ord a => a -> a -> Bool
< Int
0
          then if Bool
updating
                 then do
                   forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"delete': looking for empty element"
                   -- if we're updating, we look for an empty element
                   Int
idxE1 <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b1 Elem
emptyMarker
                   forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"delete': idxE1 was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idxE1
                   if Int
idxE1 forall a. Ord a => a -> a -> Bool
>= Int
0
                     then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
idxE1, Elem
he1)
                     else do
                       Int
idxE2 <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b2 Elem
emptyMarker
                       forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"delete': idxE2 was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idxE1
                       if Int
idxE2 forall a. Ord a => a -> a -> Bool
>= Int
0
                         then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
idxE2, Elem
he2)
                         else forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, Elem
0)
                 else forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, Elem
0)
          else forall {b}. Int -> b -> ST s (Int, b)
deleteIt Int
idx2 Elem
he2
      else forall {b}. Int -> b -> ST s (Int, b)
deleteIt Int
idx1 Elem
he1

  where
    deleteIt :: Int -> b -> ST s (Int, b)
deleteIt !Int
idx !b
h = do
        if Bool -> Bool
not Bool
updating
          then do
            forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
emptyMarker
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
idx forall a. HasCallStack => a
undefined
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
idx forall a. HasCallStack => a
undefined
          else forall (m :: * -> *) a. Monad m => a -> m a
return ()
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
idx, b
h)
{-# INLINE delete' #-}


------------------------------------------------------------------------------
cuckooOrFail :: (Hashable k, Eq k) =>
                HashTable_ s k v  -- ^ hash table
             -> Int               -- ^ hash code 1
             -> Int               -- ^ hash code 2
             -> Int               -- ^ cache line 1
             -> Int               -- ^ cache line 2
             -> k                 -- ^ key
             -> v                 -- ^ value
             -> 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
    -- at this point we know:
    --
    --   * there is no empty slot in either cache line
    --
    --   * the key doesn't already exist in the table
    --
    -- next things to do:
    --
    --   * decide which element to bump
    --
    --   * read that element, and write (k,v) in there
    --
    --   * attempt to write the bumped element into its other cache slot
    --
    --   * if it fails, recurse.

    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"cuckooOrFail h1_0=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h1_0
              forall a. [a] -> [a] -> [a]
++ String
" h2_0=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h2_0
              forall a. [a] -> [a] -> [a]
++ String
" b1_0=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b1_0
              forall a. [a] -> [a] -> [a]
++ String
" b2_0=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b2_0

    !Word
lineChoice <- forall s. BitStream s -> ST s Word
getNextBit BitStream s
rng

    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"chose line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
lineChoice
    let (!Int
b, !Int
h) = if Word
lineChoice forall a. Eq a => a -> a -> Bool
== Word
0 then (Int
b1_0, Int
h1_0) else (Int
b2_0, Int
h2_0)
    forall {a}.
(Eq a, Num a) =>
Int -> Int -> k -> v -> a -> ST s (Maybe (k, v))
go Int
b Int
h k
k0 v
v0 Int
maxAttempts0


  where
    randomIdx :: b -> ST s b
randomIdx !b
b = do
        !Word
z <- forall s. Int -> BitStream s -> ST s Word
getNBits Int
cacheLineIntBits BitStream s
rng
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! b
b forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
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
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"bumpIdx idx=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx forall a. [a] -> [a] -> [a]
++ String
" h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h
                  forall a. [a] -> [a] -> [a]
++ String
" he=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
he
        !Elem
he' <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"bumpIdx: he' was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
he'
        !k
k' <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
idx
        v
v'  <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
idx
        forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
        forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
idx k
k
        forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
idx v
v
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"bumped key with he'=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
he'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Elem
he', k
k', v
v')

    otherHash :: Elem -> p -> Int
otherHash Elem
he p
k = if Int -> Elem
hashToElem Int
h1 forall a. Eq a => a -> a -> Bool
== Elem
he then Int
h2 else Int
h1
      where
        h1 :: Int
h1 = forall k. Hashable k => k -> Int
hash1 p
k
        h2 :: Int
h2 = 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
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"tryWrite b=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++ String
" h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h
        Int
idx <- forall s. IntArray s -> Int -> Elem -> ST s Int
cacheLineSearch IntArray s
hashes Int
b Elem
emptyMarker
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"cacheLineSearch returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx

        if Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0
          then do
            forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx forall a b. (a -> b) -> a -> b
$! Int -> Elem
hashToElem Int
h
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s k
keys Int
idx k
k
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s v
values Int
idx v
v
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else Int -> Int -> k -> v -> a -> ST s (Maybe (k, v))
go Int
b Int
h k
k v
v forall a b. (a -> b) -> a -> b
$! a
maxAttempts forall a. Num a => a -> a -> a
- a
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 forall a. Eq a => a -> a -> Bool
== a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just (k
k,v
v)
                               | Bool
otherwise = do
        Int
idx <- forall {b}. Num b => b -> ST s b
randomIdx Int
b
        (!Elem
he0', !k
k', v
v') <- Int -> Int -> k -> v -> ST s (Elem, k, v)
bumpIdx Int
idx Int
h k
k v
v
        let !h' :: Int
h' = forall {p}. Hashable p => Elem -> p -> Int
otherHash Elem
he0' k
k'
        let !b' :: Int
b' = Int -> Int -> Int
whichLine Int
h' Int
sz

        Int -> Int -> k -> v -> a -> ST s (Maybe (k, v))
tryWrite Int
b' Int
h' k
k' v
v' a
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
    HashTable_ s k v
newHt <- Int -> ST s (HashTable_ s k v)
grow' forall a b. (a -> b) -> a -> b
$! Double -> Int -> Int
bumpSize Double
bumpFactor Int
sz

    Maybe (k, v)
mbR <- forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (Maybe (k, v))
updateOrFail HashTable_ s k v
newHt k
k0 v
v0
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
newHt)
          (\(k, v)
_ -> Int -> ST s (HashTable_ s k v)
grow' forall a b. (a -> b) -> a -> b
$ Double -> Int -> Int
bumpSize Double
bumpFactor forall a b. (a -> b) -> a -> b
$ forall s k v. HashTable_ s k v -> Int
_size HashTable_ s k v
newHt)
          Maybe (k, v)
mbR

  where
    grow' :: Int -> ST s (HashTable_ s k v)
grow' Int
newSz = do
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"growing table, oldsz = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++
                String
", newsz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
newSz
        HashTable_ s k v
newHt <- forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
newSz
        Int -> HashTable_ s k v -> ST s (HashTable_ s k v)
rehash Int
newSz HashTable_ s k v
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 forall a. Num a => a -> a -> a
* Int
sz

        go :: Int -> ST s (HashTable_ s k v)
go !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
totSz = forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
newHt
              | Bool
otherwise  = do
            Elem
h <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
            if (Elem
h forall a. Eq a => a -> a -> Bool
/= Elem
emptyMarker)
              then do
                k
k <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
i
                v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
i

                Maybe (k, v)
mbR <- forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> k -> v -> ST s (Maybe (k, v))
updateOrFail HashTable_ s k v
newHt k
k v
v
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> ST s (HashTable_ s k v)
go forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1)
                      (\(k, v)
_ -> Int -> ST s (HashTable_ s k v)
grow' forall a b. (a -> b) -> a -> b
$ Double -> Int -> Int
bumpSize Double
bumpFactor Int
newSz)
                      Maybe (k, v)
mbR
              else Int -> ST s (HashTable_ s k v)
go forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1


------------------------------------------------------------------------------
hashPrime :: Int
hashPrime :: Int
hashPrime = if Int
wordSize 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 = forall k. Hashable k => k -> Int
H.hash
{-# INLINE hash1 #-}


hash2 :: Hashable k => k -> Int
hash2 :: forall k. Hashable k => k -> Int
hash2 = 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 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
_ = 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall s k v. STRef s (HashTable_ s k v) -> HashTable s k v
HT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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) = forall s a. STRef s a -> ST s a
readSTRef STRef s (HashTable_ s k v)
ref
{-# INLINE readRef #-}


------------------------------------------------------------------------------

-- | Find index of given key in the hashtable.
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 Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
_ Int
_ <- forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef

     let !h1 :: Int
h1  = forall k. Hashable k => k -> Int
hash1 k
k
         !h2 :: Int
h2  = 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

     Int
idx1 <- 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 Int
idx1 forall a. Ord a => a -> a -> Bool
>= Int
0
       then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx1)
       else do Int
idx2 <- 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
b2 Elem
he2
               if Int
idx2 forall a. Ord a => a -> a -> Bool
>= Int
0
                 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx2)
                 else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Find the next entry in the hashtable starting at the given index.
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 Int
sz BitStream s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values Int
_ <- forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
     let totSz :: Int
totSz = Int
numElemsInCacheLine forall a. Num a => a -> a -> a
* Int
sz
         go :: Int -> ST s (Maybe (a, k, v))
go Int
i
           | Int
i forall a. Ord a => a -> a -> Bool
>= Int
totSz = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
           | Bool
otherwise =
               do Elem
h <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
                  if Elem
h forall a. Eq a => a -> a -> Bool
== Elem
emptyMarker
                    then Int -> ST s (Maybe (a, k, v))
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
                    else do k
k <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s k
keys Int
i
                            v
v <- forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray s v
values Int
i
                            let !i' :: a
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
i',k
k,v
v))

     forall {a}. Num a => Int -> ST s (Maybe (a, k, v))
go (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i0)