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

{-|

A basic open-addressing hash table using linear probing. Use this hash table if
you...

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

  * don't care about wasting a little bit of memory to get it.

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

  * have a workload which is not heavy with deletes; deletes clutter the table
    with deleted markers and force the table to be completely rehashed fairly
    often.

Of the hash tables in this collection, this hash table has the best lookup
performance, while maintaining competitive insert performance.

/Space overhead/

This table is not especially memory-efficient; firstly, the table has a maximum
load factor of 0.83 and will be resized if load exceeds this value. Secondly,
to improve insert and lookup performance, we store a 16-bit hash code for each
key in the table.

Each hash table entry requires at least 2.25 words (on a 64-bit machine), two
for the pointers to the key and value and one quarter word for the hash code.
We don't count key and value pointers as overhead, because they have to be
there -- so the overhead for a full slot is at least one quarter word -- but
empty slots in the hash table count for a full 2.25 words of overhead. Define
@m@ as the number of slots in the table, @n@ as the number of key value
mappings, and @ws@ as the machine word size in /bytes/. If the load factor is
@k=n\/m@, the amount of space /wasted/ per mapping in words is:

@
w(n) = (m*(2*ws + 2) - n*(2*ws)) / ws
@

Since @m=n\/k@,

@
w(n) = n\/k * (2*ws + 2) - n*(2*ws)
     = (n * (2 + 2*ws*(1-k)) / k) / ws
@

Solving for @k=0.83@, the maximum load factor, gives a /minimum/ overhead of
0.71 words per mapping on a 64-bit machine, or 1.01 words per mapping on a
32-bit machine. If @k=0.5@, which should be under normal usage the /maximum/
overhead situation, then the overhead would be 2.5 words per mapping on a
64-bit machine, or 3.0 words per mapping on a 32-bit machine.

/Space overhead: experimental results/

In randomized testing on a 64-bit machine (see
@test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean
overhead (that is, the number of words needed to store the key-value mapping
over and above the two words necessary for the key and the value pointers) is
approximately 1.24 machine words per key-value mapping with a standard
deviation of about 0.30 words, and 1.70 words per mapping at the 95th
percentile.

/Expensive resizes/

If enough elements are inserted into the table to make it exceed the maximum
load factor, the table is resized. A resize involves a complete rehash of all
the elements in the table, which means that any given call to 'insert' might
take /O(n)/ time in the size of the table, with a large constant factor. If a
long pause waiting for the table to resize is unacceptable for your
application, you should choose the included linear hash table instead.


/References:/

  * Knuth, Donald E. /The Art of Computer Programming/, vol. 3 Sorting and
    Searching. Addison-Wesley Publishing Company, 1973.
-}

module Data.HashTable.ST.Basic
  ( HashTable
  , new
  , newSized
  , size
  , delete
  , lookup
  , insert
  , mutate
  , mutateST
  , mapM_
  , foldM
  , computeOverhead
  ) where


------------------------------------------------------------------------------
#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative
#endif
import           Control.Exception                 (assert)
import           Control.Monad                     hiding (foldM, mapM_)
import           Control.Monad.ST                  (ST)
import           Data.Bits
import           Data.Hashable                     (Hashable)
import qualified Data.Hashable                     as H
import           Data.Maybe
import           Data.Monoid
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
import qualified Data.Primitive.ByteArray          as A
import           Data.STRef
import           GHC.Exts
import           Prelude                           hiding (lookup, mapM_, read)
------------------------------------------------------------------------------
import qualified Data.HashTable.Class              as C
import           Data.HashTable.Internal.Array
import           Data.HashTable.Internal.CacheLine
import           Data.HashTable.Internal.IntArray  (Elem)
import qualified Data.HashTable.Internal.IntArray  as U
import           Data.HashTable.Internal.Utils


------------------------------------------------------------------------------
-- | An open addressing hash table using linear probing.
newtype HashTable s k v = HT (STRef s (HashTable_ s k v))

type SizeRefs s = A.MutableByteArray s

intSz :: Int
intSz :: Int
intSz = (forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0::Int) forall a. Integral a => a -> a -> a
`div` Int
8)

readLoad :: SizeRefs s -> ST s Int
readLoad :: forall s. SizeRefs s -> ST s Int
readLoad = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
A.readByteArray Int
0

writeLoad :: SizeRefs s -> Int -> ST s ()
writeLoad :: forall s. SizeRefs s -> Int -> ST s ()
writeLoad = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
A.writeByteArray Int
0

readDelLoad :: SizeRefs s -> ST s Int
readDelLoad :: forall s. SizeRefs s -> ST s Int
readDelLoad = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
A.readByteArray Int
1

writeDelLoad :: SizeRefs s -> Int -> ST s ()
writeDelLoad :: forall s. SizeRefs s -> Int -> ST s ()
writeDelLoad = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
A.writeByteArray Int
1

newSizeRefs :: ST s (SizeRefs s)
newSizeRefs :: forall s. ST s (SizeRefs s)
newSizeRefs = do
    let asz :: Int
asz = Int
2 forall a. Num a => a -> a -> a
* Int
intSz
    SizeRefs s
a <- forall (m :: * -> *).
PrimMonad m =>
Int -> Int -> m (MutableByteArray (PrimState m))
A.newAlignedPinnedByteArray Int
asz Int
intSz
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
A.fillByteArray SizeRefs s
a Int
0 Int
asz Word8
0
    forall (m :: * -> *) a. Monad m => a -> m a
return SizeRefs s
a


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 -> SizeRefs s
_load   :: !(SizeRefs s)   -- ^ 2-element array, stores how many entries
                                  -- and deleted entries are in the table.
    , forall s k v. HashTable_ s k v -> IntArray s
_hashes :: !(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)
    }


------------------------------------------------------------------------------
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.
(Eq k, Hashable 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)
newSized Int
1
{-# 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
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"entering: newSized " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
    let m :: Int
m = Int -> Int
nextBestPrime forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ Double
maxLoad)
    HashTable_ s k v
ht <- forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
m
    forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef HashTable_ s k v
ht
{-# INLINE newSized #-}

------------------------------------------------------------------------------
newSizedReal :: Int -> ST s (HashTable_ s k v)
newSizedReal :: forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
m = do
    -- make sure the hash array is a multiple of cache-line sized so we can
    -- always search a whole cache line at once
    let m' :: Int
m' = ((Int
m 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)
             forall a. Num a => a -> a -> a
* Int
numElemsInCacheLine
    IntArray s
h  <- forall s. Int -> ST s (IntArray s)
U.newArray Int
m'
    MutableArray s k
k  <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
m forall a. HasCallStack => a
undefined
    MutableArray s v
v  <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
m forall a. HasCallStack => a
undefined
    SizeRefs s
ld <- forall s. ST s (SizeRefs s)
newSizeRefs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s k v.
Int
-> SizeRefs s
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> HashTable_ s k v
HashTable Int
m SizeRefs s
ld IntArray s
h MutableArray s k
k MutableArray s v
v

------------------------------------------------------------------------------
-- | Returns the number of mappings currently stored in this table. /O(1)/
size :: HashTable s k v -> ST s Int
size :: forall s k v. HashTable s k v -> ST s Int
size HashTable s k v
htRef = do
    HashTable Int
_ SizeRefs s
sizeRefs IntArray s
_ MutableArray s k
_ MutableArray s v
_ <- forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
sizeRefs
{-# INLINE size #-}


------------------------------------------------------------------------------
-- | 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 = 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
    SlotFindResponse
slots <- forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
findSafeSlots HashTable_ s k v
ht k
k Int
h
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
trueInt (SlotFindResponse -> Int
_slotFound SlotFindResponse
slots)) forall a b. (a -> b) -> a -> b
$ forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht (SlotFindResponse -> Int
_slotB1 SlotFindResponse
slots)
  where
    !h :: Int
h = forall k. Hashable k => k -> Int
hash k
k
{-# INLINE delete #-}


------------------------------------------------------------------------------
-- | 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 {s} {v}. HashTable_ s k v -> ST s (Maybe v)
lookup' HashTable_ s k v
ht
  where
    lookup' :: HashTable_ s k v -> ST s (Maybe v)
lookup' (HashTable Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values) = do
        let !b :: Int
b = Int -> Int -> Int
whichBucket Int
h Int
sz
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"lookup h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h forall a. [a] -> [a] -> [a]
++ String
" sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++ String
" b=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b
        Int -> Int -> Int -> ST s (Maybe v)
go Int
b Int
0 Int
sz

      where
        !h :: Int
h  = forall k. Hashable k => k -> Int
hash k
k
        !he :: Elem
he = Int -> Elem
hashToElem Int
h

        go :: Int -> Int -> Int -> ST s (Maybe v)
go !Int
b !Int
start !Int
end = {-# SCC "lookup/go" #-} do
            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"lookup'/go: "
                           , forall a. Show a => a -> String
show Int
b
                           , String
"/"
                           , forall a. Show a => a -> String
show Int
start
                           , String
"/"
                           , forall a. Show a => a -> String
show Int
end
                           ]
            Int
idx <- forall s. IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forwardSearch2 IntArray s
hashes Int
b Int
end Elem
he Elem
emptyMarker
            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"forwardSearch2 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 Bool -> Bool -> Bool
|| Int
idx forall a. Ord a => a -> a -> Bool
< Int
start Bool -> Bool -> Bool
|| Int
idx forall a. Ord a => a -> a -> Bool
>= Int
end)
               then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
               else do
                 Elem
h0  <- 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
"h0 was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
h0

                 if Elem -> Bool
recordIsEmpty Elem
h0
                   then do
                       forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"record empty, returning Nothing"
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                   else do
                     k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
idx
                     if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                       then do
                         forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"value found at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx
                         v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
idx
                         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
                         forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"value not found, recursing"
                         if Int
idx forall a. Ord a => a -> a -> Bool
< Int
b
                           then Int -> Int -> Int -> ST s (Maybe v)
go (Int
idx forall a. Num a => a -> a -> a
+ Int
1) (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Int
b
                           else Int -> Int -> Int -> ST s (Maybe v)
go (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Int
start Int
end
{-# INLINE lookup #-}


------------------------------------------------------------------------------
-- | 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
htRef !k
k !v
v = 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 s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"insert: h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h
    slots :: SlotFindResponse
slots@(SlotFindResponse Int
foundInt Int
b0 Int
b1) <- forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
findSafeSlots HashTable_ s k v
ht k
k Int
h
    let found :: Bool
found = Int -> Bool
trueInt Int
foundInt
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"insert: findSafeSlots returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SlotFindResponse
slots
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
found Bool -> Bool -> Bool
&& (Int
b0 forall a. Eq a => a -> a -> Bool
/= Int
b1)) forall a b. (a -> b) -> a -> b
$ forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
b1
    forall s k v. HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot HashTable_ s k v
ht Int
b0 Elem
he k
k v
v
    HashTable_ s k v
ht' <- forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> ST s (HashTable_ s k v)
checkOverflow HashTable_ s k v
ht
    forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
htRef HashTable_ s k v
ht'

  where
    !h :: Int
h = forall k. Hashable k => k -> Int
hash k
k
    !he :: Elem
he = Int -> Elem
hashToElem Int
h
{-# INLINE insert #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.mutate'.
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 #-}


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.mutateST'.
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
    let values :: MutableArray s v
values = forall s k v. HashTable_ s k v -> MutableArray s v
_values HashTable_ s k v
ht
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"mutate h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h
    slots :: SlotFindResponse
slots@(SlotFindResponse Int
foundInt Int
b0 Int
b1) <- forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
findSafeSlots HashTable_ s k v
ht k
k Int
h
    let found :: Bool
found = Int -> Bool
trueInt Int
foundInt
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"findSafeSlots returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SlotFindResponse
slots
    !Maybe v
mv <- if Bool
found
              then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
b1
              else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    (!Maybe v
mv', !a
result) <- Maybe v -> ST s (Maybe v, a)
f Maybe v
mv
    case (Maybe v
mv, Maybe v
mv') of
        (Maybe v
Nothing, Maybe v
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Just v
_, Maybe v
Nothing)  -> do
            forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
b1
        (Maybe v
Nothing, Just v
v') -> do
            forall s k v. HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot HashTable_ s k v
ht Int
b0 Elem
he k
k v
v'
            HashTable_ s k v
ht' <- forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> ST s (HashTable_ s k v)
checkOverflow HashTable_ s k v
ht
            forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
htRef HashTable_ s k v
ht'
        (Just v
_, Just v
v')  -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
b0 forall a. Eq a => a -> a -> Bool
/= Int
b1) forall a b. (a -> b) -> a -> b
$
                forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
b1
            forall s k v. HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot HashTable_ s k v
ht Int
b0 Elem
he k
k v
v'
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    !h :: Int
h     = forall k. Hashable k => k -> Int
hash k
k
    !he :: Elem
he    = Int -> Elem
hashToElem Int
h
{-# INLINE mutateST #-}


------------------------------------------------------------------------------
-- | 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
>>= HashTable_ s k v -> ST s a
work
  where
    work :: HashTable_ s k v -> ST s a
work (HashTable Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values) = Int -> a -> ST s a
go Int
0 a
seed0
      where
        go :: Int -> a -> ST s a
go !Int
i !a
seed | Int
i forall a. Ord a => a -> a -> Bool
>= Int
sz = 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 -> Bool
recordIsEmpty Elem
h Bool -> Bool -> Bool
|| Elem -> Bool
recordIsDeleted Elem
h
              then Int -> a -> ST s a
go (Int
iforall a. Num a => a -> a -> a
+Int
1) a
seed
              else do
                k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- forall s a. MutableArray s a -> Int -> ST s 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'


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.mapM_'.
mapM_ :: ((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_ (k, v) -> ST s b
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
>>= HashTable_ s k v -> ST s ()
work
  where
    work :: HashTable_ s k v -> ST s ()
work (HashTable Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values) = Int -> ST s ()
go Int
0
      where
        go :: Int -> ST s ()
go !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
sz = 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 -> Bool
recordIsEmpty Elem
h Bool -> Bool -> Bool
|| Elem -> Bool
recordIsDeleted Elem
h
              then Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
              else do
                k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
                b
_ <- (k, v) -> ST s b
f (k
k, v
v)
                Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)


------------------------------------------------------------------------------
-- | 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' SizeRefs s
loadRef IntArray s
_ MutableArray s k
_ MutableArray s v
_) = do
        !Int
ld <- forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
loadRef
        let k :: b
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ld forall a. Fractional a => a -> a -> a
/ b
sz
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b
constOverheadforall a. Fractional a => a -> a -> a
/b
sz forall a. Num a => a -> a -> a
+ (b
2 forall a. Num a => a -> a -> a
+ b
2forall a. Num a => a -> a -> a
*b
wsforall a. Num a => a -> a -> a
*(b
1forall a. Num a => a -> a -> a
-b
k)) forall a. Fractional a => a -> a -> a
/ (b
k forall a. Num a => a -> a -> a
* b
ws)
      where
        ws :: b
ws = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0::Int) forall a. Integral a => a -> a -> a
`div` Int
8
        sz :: b
sz = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz'
        -- Change these if you change the representation
        constOverhead :: b
constOverhead = b
14


------------------------------
-- Private functions follow --
------------------------------


------------------------------------------------------------------------------
{-# INLINE insertRecord #-}
insertRecord :: Int
             -> U.IntArray s
             -> MutableArray s k
             -> MutableArray s v
             -> Int
             -> k
             -> v
             -> ST s ()
insertRecord :: forall s k v.
Int
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> Int
-> k
-> v
-> ST s ()
insertRecord !Int
sz !IntArray s
hashes !MutableArray s k
keys !MutableArray s v
values !Int
h !k
key !v
value = do
    let !b :: Int
b = Int -> Int -> Int
whichBucket Int
h Int
sz
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"insertRecord sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz 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
" b=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b
    Int -> ST s ()
probe Int
b

  where
    he :: Elem
he = Int -> Elem
hashToElem Int
h

    probe :: Int -> ST s ()
probe !Int
i = {-# SCC "insertRecord/probe" #-} do
        !Int
idx <- forall s. IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forwardSearch2 IntArray s
hashes Int
i Int
sz Elem
emptyMarker Elem
deletedMarker
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"forwardSearch2 returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx
        forall a. HasCallStack => Bool -> a -> a
assert (Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
            forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
            forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
idx k
key
            forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
idx v
value


------------------------------------------------------------------------------
checkOverflow :: (Eq k, Hashable k) =>
                 (HashTable_ s k v)
              -> ST s (HashTable_ s k v)
checkOverflow :: forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> ST s (HashTable_ s k v)
checkOverflow ht :: HashTable_ s k v
ht@(HashTable Int
sz SizeRefs s
ldRef IntArray s
_ MutableArray s k
_ MutableArray s v
_) = do
    !Int
ld <- forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ldRef
    !Int
dl <- forall s. SizeRefs s -> ST s Int
readDelLoad SizeRefs s
ldRef

    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"checkOverflow: sz="
                   , forall a. Show a => a -> String
show Int
sz
                   , String
" entries="
                   , forall a. Show a => a -> String
show Int
ld
                   , String
" deleted="
                   , forall a. Show a => a -> String
show Int
dl ]

    if forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
ld forall a. Num a => a -> a -> a
+ Int
dl) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz forall a. Ord a => a -> a -> Bool
> Double
maxLoad
      then if Int
dl forall a. Ord a => a -> a -> Bool
> Int
ld forall a. Integral a => a -> a -> a
`div` Int
2
             then forall k s v.
Hashable k =>
HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
rehashAll HashTable_ s k v
ht Int
sz
             else forall k s v.
Hashable k =>
HashTable_ s k v -> ST s (HashTable_ s k v)
growTable HashTable_ s k v
ht
      else forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht


------------------------------------------------------------------------------
rehashAll :: Hashable k => HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
rehashAll :: forall k s v.
Hashable k =>
HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
rehashAll (HashTable Int
sz SizeRefs s
loadRef IntArray s
hashes MutableArray s k
keys MutableArray s v
values) Int
sz' = do
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"rehashing: old size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++ String
", new size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz'
    HashTable_ s k v
ht' <- forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
sz'
    let (HashTable Int
_ SizeRefs s
loadRef' IntArray s
newHashes MutableArray s k
newKeys MutableArray s v
newValues) = HashTable_ s k v
ht'
    forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
loadRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. SizeRefs s -> Int -> ST s ()
writeLoad SizeRefs s
loadRef'
    IntArray s -> MutableArray s k -> MutableArray s v -> ST s ()
rehash IntArray s
newHashes MutableArray s k
newKeys MutableArray s v
newValues
    forall (m :: * -> *) a. Monad m => a -> m a
return HashTable_ s k v
ht'

  where
    rehash :: IntArray s -> MutableArray s k -> MutableArray s v -> ST s ()
rehash IntArray s
newHashes MutableArray s k
newKeys MutableArray s v
newValues = Int -> ST s ()
go Int
0
      where
        go :: Int -> ST s ()
go !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
sz   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
              | Bool
otherwise = {-# SCC "growTable/rehash" #-} do
                    Elem
h0 <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Elem -> Bool
recordIsEmpty Elem
h0 Bool -> Bool -> Bool
|| Elem -> Bool
recordIsDeleted Elem
h0)) forall a b. (a -> b) -> a -> b
$ do
                        k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                        v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
                        forall s k v.
Int
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> Int
-> k
-> v
-> ST s ()
insertRecord Int
sz' IntArray s
newHashes MutableArray s k
newKeys MutableArray s v
newValues
                                     (forall k. Hashable k => k -> Int
hash k
k) k
k v
v
                    Int -> ST s ()
go forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1


------------------------------------------------------------------------------
growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v)
growTable :: forall k s v.
Hashable k =>
HashTable_ s k v -> ST s (HashTable_ s k v)
growTable ht :: HashTable_ s k v
ht@(HashTable Int
sz SizeRefs s
_ IntArray s
_ MutableArray s k
_ MutableArray s v
_) = do
    let !sz' :: Int
sz' = Double -> Int -> Int
bumpSize Double
maxLoad Int
sz
    forall k s v.
Hashable k =>
HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
rehashAll HashTable_ s k v
ht Int
sz'


------------------------------------------------------------------------------
-- Helper data structure for findSafeSlots
newtype Slot = Slot { Slot -> Int
_slot :: Int } deriving (Int -> Slot -> ShowS
[Slot] -> ShowS
Slot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slot] -> ShowS
$cshowList :: [Slot] -> ShowS
show :: Slot -> String
$cshow :: Slot -> String
showsPrec :: Int -> Slot -> ShowS
$cshowsPrec :: Int -> Slot -> ShowS
Show)


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

#if MIN_VERSION_base(4,9,0)
instance Semigroup Slot where
  <> :: Slot -> Slot -> Slot
(<>) = Slot -> Slot -> Slot
slotMappend
#endif

instance Monoid Slot where
  mempty :: Slot
mempty = Int -> Slot
Slot forall a. Bounded a => a
maxBound
#if ! MIN_VERSION_base(4,11,0)
  mappend = slotMappend
#endif

slotMappend :: Slot -> Slot -> Slot
slotMappend :: Slot -> Slot -> Slot
slotMappend (Slot Int
x1) (Slot Int
x2) =
  let !m :: Int
m = Int -> Int -> Int
mask Int
x1 forall a. Bounded a => a
maxBound
  in Int -> Slot
Slot forall a b. (a -> b) -> a -> b
$! (forall a. Bits a => a -> a
complement Int
m forall a. Bits a => a -> a -> a
.&. Int
x1) forall a. Bits a => a -> a -> a
.|. (Int
m forall a. Bits a => a -> a -> a
.&. Int
x2)

------------------------------------------------------------------------------
-- findSafeSlots return type
data SlotFindResponse = SlotFindResponse {
    SlotFindResponse -> Int
_slotFound :: {-# UNPACK #-} !Int -- we use Int because Bool won't unpack
  , SlotFindResponse -> Int
_slotB0    :: {-# UNPACK #-} !Int
  , SlotFindResponse -> Int
_slotB1    :: {-# UNPACK #-} !Int
} deriving (Int -> SlotFindResponse -> ShowS
[SlotFindResponse] -> ShowS
SlotFindResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlotFindResponse] -> ShowS
$cshowList :: [SlotFindResponse] -> ShowS
show :: SlotFindResponse -> String
$cshow :: SlotFindResponse -> String
showsPrec :: Int -> SlotFindResponse -> ShowS
$cshowsPrec :: Int -> SlotFindResponse -> ShowS
Show)


------------------------------------------------------------------------------
-- Returns ST s (SlotFoundResponse found b0 b1),
-- where
--     * found :: Int  - 1 if key-value mapping is already in the table,
--                       0 otherwise.
--     * b0    :: Int  - The index of a slot where it would be safe to write
--                       the given key (if the key is already in the mapping,
--                       you have to delete it before using this slot).
--     * b1    :: Int  - The index of a slot where the key currently resides.
--                       Or, if the key is not in the table, b1 is a slot
--                       where it is safe to write the key (b1 == b0).
findSafeSlots :: (Hashable k, Eq k) =>
                 (HashTable_ s k v)
              -> k
              -> Int
              -> ST s SlotFindResponse
findSafeSlots :: forall k s v.
(Hashable k, Eq k) =>
HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
findSafeSlots (HashTable !Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
_) k
k Int
h = do
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"findSafeSlots: 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
            forall a. [a] -> [a] -> [a]
++ String
" sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++ String
" b0=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b0
    SlotFindResponse
response <- Slot -> Int -> Bool -> ST s SlotFindResponse
go forall a. Monoid a => a
mempty Int
b0 Bool
False
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"go returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SlotFindResponse
response
    forall (m :: * -> *) a. Monad m => a -> m a
return SlotFindResponse
response

  where
    !he :: Elem
he = Int -> Elem
hashToElem Int
h
    !b0 :: Int
b0 = Int -> Int -> Int
whichBucket Int
h Int
sz
    haveWrapped :: Slot -> Int -> Bool
haveWrapped !(Slot Int
fp) !Int
b = if Int
fp forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound
                                    then Bool
False
                                    else Int
b forall a. Ord a => a -> a -> Bool
<= Int
fp

    -- arguments:

    --   * fp    maintains the slot in the array where it would be safe to
    --           write the given key
    --   * b     search the buckets array starting at this index.
    --   * wrap  True if we've wrapped around, False otherwise

    go :: Slot -> Int -> Bool -> ST s SlotFindResponse
go !Slot
fp !Int
b !Bool
wrap = do
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"go: fp="
                       , forall a. Show a => a -> String
show Slot
fp
                       , String
" b="
                       , forall a. Show a => a -> String
show Int
b
                       , String
", wrap="
                       , forall a. Show a => a -> String
show Bool
wrap
                       , String
", he="
                       , forall a. Show a => a -> String
show Elem
he
                       , String
", emptyMarker="
                       , forall a. Show a => a -> String
show Elem
emptyMarker
                       , String
", deletedMarker="
                       , forall a. Show a => a -> String
show Elem
deletedMarker ]

        !Int
idx <- forall s.
IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int
forwardSearch3 IntArray s
hashes Int
b Int
sz Elem
he Elem
emptyMarker Elem
deletedMarker
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"forwardSearch3 returned " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx
                forall a. [a] -> [a] -> [a]
++ String
" with sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++ String
", b=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b

        if Bool
wrap Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
>= Int
b0
          -- we wrapped around in the search and didn't find our hash code;
          -- this means that the table is full of deleted elements. Just return
          -- the first place we'd be allowed to insert.
          --
          -- TODO: if we get in this situation we should probably just rehash
          -- the table, because every insert is going to be O(n).
          then do
            let !sl :: Slot
sl = Slot
fp forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot (forall a. HasCallStack => String -> a
error String
"impossible"))
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int -> SlotFindResponse
SlotFindResponse Int
0 (Slot -> Int
_slot Slot
sl) (Slot -> Int
_slot Slot
sl)
          else do
            -- because the table isn't full, we know that there must be either
            -- an empty or a deleted marker somewhere in the table. Assert this
            -- here.
            forall a. HasCallStack => Bool -> a -> a
assert (Int
idx forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Elem
h0 <- 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
"h0 was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
h0

            if Elem -> Bool
recordIsEmpty Elem
h0
              then do
                  let pl :: Slot
pl = Slot
fp forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
                  forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"empty, returning " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Slot
pl
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int -> SlotFindResponse
SlotFindResponse Int
0 (Slot -> Int
_slot Slot
pl) (Slot -> Int
_slot Slot
pl)
              else do
                let !wrap' :: Bool
wrap' = Slot -> Int -> Bool
haveWrapped Slot
fp Int
idx
                if Elem -> Bool
recordIsDeleted Elem
h0
                  then do
                      let !pl :: Slot
pl = Slot
fp forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
                      forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"deleted, cont with pl=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Slot
pl
                      Slot -> Int -> Bool -> ST s SlotFindResponse
go Slot
pl (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Bool
wrap'
                  else
                    if Elem
he forall a. Eq a => a -> a -> Bool
== Elem
h0
                      then do
                        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"found he == h0 == " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
h0
                        k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
idx
                        if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                          then do
                            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"found at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx
                            let !sl :: Slot
sl = Slot
fp forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int -> SlotFindResponse
SlotFindResponse Int
1 (Slot -> Int
_slot Slot
sl) Int
idx
                          else Slot -> Int -> Bool -> ST s SlotFindResponse
go Slot
fp (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Bool
wrap'
                      else Slot -> Int -> Bool -> ST s SlotFindResponse
go Slot
fp (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Bool
wrap'


------------------------------------------------------------------------------
{-# INLINE deleteFromSlot #-}
deleteFromSlot :: (HashTable_ s k v) -> Int -> ST s ()
deleteFromSlot :: forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot (HashTable Int
_ SizeRefs s
loadRef IntArray s
hashes MutableArray s k
keys MutableArray s v
values) Int
idx = do
    !Elem
he <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Elem -> Bool
recordIsFilled Elem
he) forall a b. (a -> b) -> a -> b
$ do
        forall s. SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
loadRef Int
1
        forall s. SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
loadRef (-Int
1)
        forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
deletedMarker
        forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
idx forall a. HasCallStack => a
undefined
        forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
idx forall a. HasCallStack => a
undefined


------------------------------------------------------------------------------
{-# INLINE insertIntoSlot #-}
insertIntoSlot :: (HashTable_ s k v) -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot :: forall s k v. HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot (HashTable Int
_ SizeRefs s
loadRef IntArray s
hashes MutableArray s k
keys MutableArray s v
values) Int
idx Elem
he k
k v
v = do
    !Elem
heOld <- forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
    let !heInt :: Int
heInt    = forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
heOld :: Int
        !delInt :: Int
delInt   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
deletedMarker :: Int
        !emptyInt :: Int
emptyInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
emptyMarker :: Int
        !delBump :: Int
delBump  = Int -> Int -> Int
mask Int
heInt Int
delInt -- -1 if heInt == delInt,
                                      --  0  otherwise
        !mLoad :: Int
mLoad    = Int -> Int -> Int
mask Int
heInt Int
delInt forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
mask Int
heInt Int
emptyInt
        !loadBump :: Int
loadBump = Int
mLoad forall a. Bits a => a -> a -> a
.&. Int
1 -- 1 if heInt == delInt || heInt == emptyInt,
                                -- 0 otherwise
    forall s. SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
loadRef Int
delBump
    forall s. SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
loadRef Int
loadBump
    forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
    forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
idx k
k
    forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
idx v
v


-------------------------------------------------------------------------------
{-# INLINE bumpLoad #-}
bumpLoad :: (SizeRefs s) -> Int -> ST s ()
bumpLoad :: forall s. SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
ref Int
i = do
    !Int
ld <- forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ref
    forall s. SizeRefs s -> Int -> ST s ()
writeLoad SizeRefs s
ref forall a b. (a -> b) -> a -> b
$! Int
ld forall a. Num a => a -> a -> a
+ Int
i


------------------------------------------------------------------------------
{-# INLINE bumpDelLoad #-}
bumpDelLoad :: (SizeRefs s) -> Int -> ST s ()
bumpDelLoad :: forall s. SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
ref Int
i = do
    !Int
ld <- forall s. SizeRefs s -> ST s Int
readDelLoad SizeRefs s
ref
    forall s. SizeRefs s -> Int -> ST s ()
writeDelLoad SizeRefs s
ref forall a b. (a -> b) -> a -> b
$! Int
ld forall a. Num a => a -> a -> a
+ Int
i


-----------------------------------------------------------------------------
maxLoad :: Double
maxLoad :: Double
maxLoad = Double
0.82


------------------------------------------------------------------------------
emptyMarker :: Elem
emptyMarker :: Elem
emptyMarker = Elem
0


------------------------------------------------------------------------------
deletedMarker :: Elem
deletedMarker :: Elem
deletedMarker = Elem
1


------------------------------------------------------------------------------
{-# INLINE trueInt #-}
trueInt :: Int -> Bool
trueInt :: Int -> Bool
trueInt (I# Int#
i#) = forall a. Int# -> a
tagToEnum# Int#
i#


------------------------------------------------------------------------------
{-# INLINE recordIsEmpty #-}
recordIsEmpty :: Elem -> Bool
recordIsEmpty :: Elem -> Bool
recordIsEmpty = (forall a. Eq a => a -> a -> Bool
== Elem
emptyMarker)


------------------------------------------------------------------------------
{-# INLINE recordIsDeleted #-}
recordIsDeleted :: Elem -> Bool
recordIsDeleted :: Elem -> Bool
recordIsDeleted = (forall a. Eq a => a -> a -> Bool
== Elem
deletedMarker)


------------------------------------------------------------------------------
{-# INLINE recordIsFilled #-}
recordIsFilled :: Elem -> Bool
recordIsFilled :: Elem -> Bool
recordIsFilled !Elem
el = forall a. Int# -> a
tagToEnum# Int#
isFilled#
  where
    !el# :: Int#
el# = Elem -> Int#
U.elemToInt# Elem
el
    !deletedMarker# :: Int#
deletedMarker# = Elem -> Int#
U.elemToInt# Elem
deletedMarker
    !emptyMarker# :: Int#
emptyMarker# = Elem -> Int#
U.elemToInt# Elem
emptyMarker
#if __GLASGOW_HASKELL__ >= 708
    !isFilled# :: Int#
isFilled# = (Int#
el# Int# -> Int# -> Int#
/=# Int#
deletedMarker#) Int# -> Int# -> Int#
`andI#` (Int#
el# Int# -> Int# -> Int#
/=# Int#
emptyMarker#)
#else
    !delOrEmpty# = mask# el# deletedMarker# `orI#` mask# el# emptyMarker#
    !isFilled# = 1# `andI#` notI# delOrEmpty#
#endif


------------------------------------------------------------------------------
{-# INLINE hash #-}
hash :: (Hashable k) => k -> Int
hash :: forall k. Hashable k => k -> Int
hash = forall k. Hashable k => k -> Int
H.hash


------------------------------------------------------------------------------
{-# INLINE hashToElem #-}
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# Word# -> Word# -> Word#
`or#` Int# -> Int# -> Word#
maskw# Int#
lo# Int#
1#
    !nm# :: Word#
nm# = Word# -> Word#
not# Word#
m#

    !r# :: Word#
r#  = ((Int# -> Word#
int2Word# Int#
2#) 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#


------------------------------------------------------------------------------
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 #-}


------------------------------------------------------------------------------
{-# INLINE debug #-}
debug :: String -> ST s ()
#ifdef DEBUG
debug s = unsafeIOToST (putStrLn s)
#else
debug :: forall s. String -> ST s ()
debug String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif

lookupIndex :: (Eq k, Hashable k) => HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex 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 {a} {s} {v}. Num a => HashTable_ s k v -> ST s (Maybe a)
lookup' HashTable_ s k v
ht
  where
    lookup' :: HashTable_ s k v -> ST s (Maybe a)
lookup' (HashTable Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
_values) = do
        let !b :: Int
b = Int -> Int -> Int
whichBucket Int
h Int
sz
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"lookup h=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h forall a. [a] -> [a] -> [a]
++ String
" sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++ String
" b=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b
        forall {a}. Num a => Int -> Int -> Int -> ST s (Maybe a)
go Int
b Int
0 Int
sz

      where
        !h :: Int
h  = forall k. Hashable k => k -> Int
hash k
k
        !he :: Elem
he = Int -> Elem
hashToElem Int
h

        go :: Int -> Int -> Int -> ST s (Maybe a)
go !Int
b !Int
start !Int
end = {-# SCC "lookupIndex/go" #-} do
            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"lookupIndex/go: "
                           , forall a. Show a => a -> String
show Int
b
                           , String
"/"
                           , forall a. Show a => a -> String
show Int
start
                           , String
"/"
                           , forall a. Show a => a -> String
show Int
end
                           ]
            Int
idx <- forall s. IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forwardSearch2 IntArray s
hashes Int
b Int
end Elem
he Elem
emptyMarker
            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"forwardSearch2 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 Bool -> Bool -> Bool
|| Int
idx forall a. Ord a => a -> a -> Bool
< Int
start Bool -> Bool -> Bool
|| Int
idx forall a. Ord a => a -> a -> Bool
>= Int
end)
               then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
               else do
                 Elem
h0  <- 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
"h0 was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Elem
h0

                 if Elem -> Bool
recordIsEmpty Elem
h0
                   then do
                       forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"record empty, returning Nothing"
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                   else do
                     k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
idx
                     if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                       then do
                         forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"value found at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx
                         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
idx)
                       else do
                         forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"value not found, recursing"
                         if Int
idx forall a. Ord a => a -> a -> Bool
< Int
b
                           then Int -> Int -> Int -> ST s (Maybe a)
go (Int
idx forall a. Num a => a -> a -> a
+ Int
1) (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Int
b
                           else Int -> Int -> Int -> ST s (Maybe a)
go (Int
idx forall a. Num a => a -> a -> a
+ Int
1) Int
start Int
end
{-# INLINE lookupIndex #-}

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 = 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} {s} {k} {v}.
Num a =>
HashTable_ s k v -> ST s (Maybe (a, k, v))
work
  where
    work :: HashTable_ s k v -> ST s (Maybe (a, k, v))
work (HashTable Int
sz SizeRefs s
_ IntArray s
hashes MutableArray s k
keys MutableArray s v
values) = forall {a}. Num a => Int -> ST s (Maybe (a, k, v))
go (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i0)
      where
        go :: Int -> ST s (Maybe (a, k, v))
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
sz = 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 -> Bool
recordIsEmpty Elem
h Bool -> Bool -> Bool
|| Elem -> Bool
recordIsDeleted Elem
h
              then Int -> ST s (Maybe (a, k, v))
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
              else do
                k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- forall s a. MutableArray s a -> Int -> ST s 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))
{-# INLINE nextByIndex #-}