{-# 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 = (Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)

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

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

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

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

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


data HashTable_ s k v = HashTable
    { HashTable_ s k v -> Int
_size   :: {-# UNPACK #-} !Int
    , HashTable_ s k v -> SizeRefs s
_load   :: !(SizeRefs s)   -- ^ 2-element array, stores how many entries
                                  -- and deleted entries are in the table.
    , HashTable_ s k v -> IntArray s
_hashes :: !(U.IntArray s)
    , HashTable_ s k v -> MutableArray s k
_keys   :: {-# UNPACK #-} !(MutableArray s k)
    , HashTable_ s k v -> MutableArray s v
_values :: {-# UNPACK #-} !(MutableArray s v)
    }


------------------------------------------------------------------------------
instance C.HashTable HashTable where
    new :: ST s (HashTable s k v)
new             = ST s (HashTable s k v)
forall s k v. ST s (HashTable s k v)
new
    newSized :: Int -> ST s (HashTable s k v)
newSized        = Int -> ST s (HashTable s k v)
forall s k v. Int -> ST s (HashTable s k v)
newSized
    insert :: HashTable s k v -> k -> v -> ST s ()
insert          = HashTable s k v -> k -> v -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert
    delete :: HashTable s k v -> k -> ST s ()
delete          = HashTable s k v -> k -> ST s ()
forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s ()
delete
    lookup :: HashTable s k v -> k -> ST s (Maybe v)
lookup          = HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup
    foldM :: (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM           = (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM
    mapM_ :: ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_           = ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_
    lookupIndex :: HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex     = HashTable s k v -> k -> ST s (Maybe Word)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex
    nextByIndex :: HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex     = HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
forall s k v. HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex
    computeOverhead :: HashTable s k v -> ST s Double
computeOverhead = HashTable s k v -> ST s Double
forall s k v. HashTable s k v -> ST s Double
computeOverhead
    mutate :: HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate          = HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate
    mutateST :: HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST        = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST


------------------------------------------------------------------------------
instance Show (HashTable s k v) where
    show :: HashTable s k v -> String
show HashTable s k v
_ = String
"<HashTable>"


------------------------------------------------------------------------------
-- | See the documentation for this function in
-- 'Data.HashTable.Class.new'.
new :: ST s (HashTable s k v)
new :: ST s (HashTable s k v)
new = Int -> ST s (HashTable s k v)
forall s k v. Int -> ST s (HashTable s k v)
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 :: Int -> ST s (HashTable s k v)
newSized Int
n = do
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"entering: newSized " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    let m :: Int
m = Int -> Int
nextBestPrime (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxLoad)
    HashTable_ s k v
ht <- Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
m
    HashTable_ s k v -> ST s (HashTable s k v)
forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef HashTable_ s k v
ht
{-# INLINE newSized #-}

------------------------------------------------------------------------------
newSizedReal :: Int -> ST s (HashTable_ s k v)
newSizedReal :: 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numElemsInCacheLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numElemsInCacheLine)
             Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numElemsInCacheLine
    IntArray s
h  <- Int -> ST s (IntArray s)
forall s. Int -> ST s (IntArray s)
U.newArray Int
m'
    MutableArray s k
k  <- Int -> k -> ST s (MutableArray s k)
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
m k
forall a. HasCallStack => a
undefined
    MutableArray s v
v  <- Int -> v -> ST s (MutableArray s v)
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
m v
forall a. HasCallStack => a
undefined
    SizeRefs s
ld <- ST s (SizeRefs s)
forall s. ST s (SizeRefs s)
newSizeRefs
    HashTable_ s k v -> ST s (HashTable_ s k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashTable_ s k v -> ST s (HashTable_ s k v))
-> HashTable_ s k v -> ST s (HashTable_ s k v)
forall a b. (a -> b) -> a -> b
$! Int
-> SizeRefs s
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> HashTable_ s k v
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 :: 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
_ <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    SizeRefs s -> ST s Int
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 :: HashTable s k v -> k -> ST s ()
delete HashTable s k v
htRef k
k = do
    HashTable_ s k v
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    SlotFindResponse
slots <- HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
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
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
trueInt (SlotFindResponse -> Int
_slotFound SlotFindResponse
slots)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ HashTable_ s k v -> Int -> ST s ()
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 = k -> Int
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 :: HashTable s k v -> k -> ST s (Maybe v)
lookup HashTable s k v
htRef !k
k = do
    HashTable_ s k v
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    HashTable_ s k v -> ST s (Maybe v)
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
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"lookup h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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  = k -> Int
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
            String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"lookup'/go: "
                           , Int -> String
forall a. Show a => a -> String
show Int
b
                           , String
"/"
                           , Int -> String
forall a. Show a => a -> String
show Int
start
                           , String
"/"
                           , Int -> String
forall a. Show a => a -> String
show Int
end
                           ]
            Int
idx <- IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forall s. IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forwardSearch2 IntArray s
hashes Int
b Int
end Elem
he Elem
emptyMarker
            String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"forwardSearch2 returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx
            if (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start Bool -> Bool -> Bool
|| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end)
               then Maybe v -> ST s (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
               else do
                 Elem
h0  <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
                 String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"h0 was " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Elem -> String
forall a. Show a => a -> String
show Elem
h0

                 if Elem -> Bool
recordIsEmpty Elem
h0
                   then do
                       String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"record empty, returning Nothing"
                       Maybe v -> ST s (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
                   else do
                     k
k' <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
idx
                     if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'
                       then do
                         String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"value found at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx
                         v
v <- MutableArray s v -> Int -> ST s v
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
idx
                         Maybe v -> ST s (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> ST s (Maybe v)) -> Maybe v -> ST s (Maybe v)
forall a b. (a -> b) -> a -> b
$! v -> Maybe v
forall a. a -> Maybe a
Just v
v
                       else do
                         String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"value not found, recursing"
                         if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
b
                           then Int -> Int -> Int -> ST s (Maybe v)
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
b
                           else Int -> Int -> Int -> ST s (Maybe v)
go (Int
idx Int -> Int -> Int
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 :: HashTable s k v -> k -> v -> ST s ()
insert HashTable s k v
htRef !k
k !v
v = do
    HashTable_ s k v
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"insert: h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h
    slots :: SlotFindResponse
slots@(SlotFindResponse Int
foundInt Int
b0 Int
b1) <- HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
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
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"insert: findSafeSlots returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SlotFindResponse -> String
forall a. Show a => a -> String
show SlotFindResponse
slots
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
found Bool -> Bool -> Bool
&& (Int
b0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b1)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ HashTable_ s k v -> Int -> ST s ()
forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
b1
    HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
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' <- HashTable_ s k v -> ST s (HashTable_ s k v)
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> ST s (HashTable_ s k v)
checkOverflow HashTable_ s k v
ht
    HashTable s k v -> HashTable_ s k v -> ST s ()
forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
htRef HashTable_ s k v
ht'

  where
    !h :: Int
h = k -> Int
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 :: HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate HashTable s k v
htRef !k
k !Maybe v -> (Maybe v, a)
f = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST HashTable s k v
htRef k
k ((Maybe v, a) -> ST s (Maybe v, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe v, a) -> ST s (Maybe v, a))
-> (Maybe v -> (Maybe v, a)) -> Maybe v -> ST s (Maybe v, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> (Maybe v, a)
f)
{-# INLINE mutate #-}


------------------------------------------------------------------------------
-- | 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 :: 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 <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    let values :: MutableArray s v
values = HashTable_ s k v -> MutableArray s v
forall s k v. HashTable_ s k v -> MutableArray s v
_values HashTable_ s k v
ht
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"mutate h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h
    slots :: SlotFindResponse
slots@(SlotFindResponse Int
foundInt Int
b0 Int
b1) <- HashTable_ s k v -> k -> Int -> ST s SlotFindResponse
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
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"findSafeSlots returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SlotFindResponse -> String
forall a. Show a => a -> String
show SlotFindResponse
slots
    !Maybe v
mv <- if Bool
found
              then (v -> Maybe v) -> ST s v -> ST s (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Maybe v
forall a. a -> Maybe a
Just (ST s v -> ST s (Maybe v)) -> ST s v -> ST s (Maybe v)
forall a b. (a -> b) -> a -> b
$ MutableArray s v -> Int -> ST s v
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
b1
              else Maybe v -> ST s (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
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) -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Just v
_, Maybe v
Nothing)  -> do
            HashTable_ s k v -> Int -> ST s ()
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
            HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
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' <- HashTable_ s k v -> ST s (HashTable_ s k v)
forall k s v.
(Eq k, Hashable k) =>
HashTable_ s k v -> ST s (HashTable_ s k v)
checkOverflow HashTable_ s k v
ht
            HashTable s k v -> HashTable_ s k v -> ST s ()
forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef HashTable s k v
htRef HashTable_ s k v
ht'
        (Just v
_, Just v
v')  -> do
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
b0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                HashTable_ s k v -> Int -> ST s ()
forall s k v. HashTable_ s k v -> Int -> ST s ()
deleteFromSlot HashTable_ s k v
ht Int
b1
            HashTable_ s k v -> Int -> Elem -> k -> v -> ST s ()
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'
    a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    !h :: Int
h     = k -> Int
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 :: (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM a -> (k, v) -> ST s a
f a
seed0 HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s a) -> ST s a
forall (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz = a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
                    | Bool
otherwise = do
            Elem
h <- IntArray s -> Int -> ST s Elem
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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
seed
              else do
                k
k <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- MutableArray s v -> Int -> ST s 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
iInt -> Int -> Int
forall 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_ :: ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_ (k, v) -> ST s b
f HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              | Bool
otherwise = do
            Elem
h <- IntArray s -> Int -> ST s Elem
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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              else do
                k
k <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- MutableArray s v -> Int -> ST s 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
iInt -> Int -> Int
forall 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 :: HashTable s k v -> ST s Double
computeOverhead HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s Double) -> ST s Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s Double
forall b s k v. Fractional b => HashTable_ s k v -> ST s b
work
  where
    work :: HashTable_ s k v -> ST s b
work (HashTable Int
sz' SizeRefs s
loadRef IntArray s
_ MutableArray s k
_ MutableArray s v
_) = do
        !Int
ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
loadRef
        let k :: b
k = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ld b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
sz
        b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ST s b) -> b -> ST s b
forall a b. (a -> b) -> a -> b
$ b
constOverheadb -> b -> b
forall a. Fractional a => a -> a -> a
/b
sz b -> b -> b
forall a. Num a => a -> a -> a
+ (b
2 b -> b -> b
forall a. Num a => a -> a -> a
+ b
2b -> b -> b
forall a. Num a => a -> a -> a
*b
wsb -> b -> b
forall a. Num a => a -> a -> a
*(b
1b -> b -> b
forall a. Num a => a -> a -> a
-b
k)) b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
k b -> b -> b
forall a. Num a => a -> a -> a
* b
ws)
      where
        ws :: b
ws = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$! Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        sz :: b
sz = Int -> b
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 :: 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
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"insertRecord sz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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 <- IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forall s. IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int
forwardSearch2 IntArray s
hashes Int
i Int
sz Elem
emptyMarker Elem
deletedMarker
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"forwardSearch2 returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx
        Bool -> ST s () -> ST s ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
            IntArray s -> Int -> Elem -> ST s ()
forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
            MutableArray s k -> Int -> k -> ST s ()
forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
idx k
key
            MutableArray s v -> Int -> v -> ST s ()
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 :: 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 <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ldRef
    !Int
dl <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readDelLoad SizeRefs s
ldRef

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

    if Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
ld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dl) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
maxLoad
      then if Int
dl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ld Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
             then HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
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 HashTable_ s k v -> ST s (HashTable_ s k v)
forall k s v.
Hashable k =>
HashTable_ s k v -> ST s (HashTable_ s k v)
growTable HashTable_ s k v
ht
      else HashTable_ s k v -> ST s (HashTable_ s k v)
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 :: 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
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"rehashing: old size " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", new size " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz'
    HashTable_ s k v
ht' <- Int -> ST s (HashTable_ s k v)
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'
    SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
loadRef ST s Int -> (Int -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SizeRefs s -> Int -> ST s ()
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
    HashTable_ s k v -> ST s (HashTable_ s k v)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz   = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              | Bool
otherwise = {-# SCC "growTable/rehash" #-} do
                    Elem
h0 <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
                    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Elem -> Bool
recordIsEmpty Elem
h0 Bool -> Bool -> Bool
|| Elem -> Bool
recordIsDeleted Elem
h0)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
                        k
k <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                        v
v <- MutableArray s v -> Int -> ST s v
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
                        Int
-> IntArray s
-> MutableArray s k
-> MutableArray s v
-> Int
-> k
-> v
-> ST s ()
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
                                     (k -> Int
forall k. Hashable k => k -> Int
hash k
k) k
k v
v
                    Int -> ST s ()
go (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1


------------------------------------------------------------------------------
growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v)
growTable :: 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
    HashTable_ s k v -> Int -> ST s (HashTable_ s k v)
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
(Int -> Slot -> ShowS)
-> (Slot -> String) -> ([Slot] -> ShowS) -> Show Slot
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
forall a. Monoid a => a -> a -> a
mappend
#endif

instance Monoid Slot where
    mempty :: Slot
mempty = Int -> Slot
Slot Int
forall a. Bounded a => a
maxBound
    (Slot Int
x1) mappend :: Slot -> Slot -> Slot
`mappend` (Slot Int
x2) =
        let !m :: Int
m = Int -> Int -> Int
mask Int
x1 Int
forall a. Bounded a => a
maxBound
        in Int -> Slot
Slot (Int -> Slot) -> Int -> Slot
forall a b. (a -> b) -> a -> b
$! (Int -> Int
forall a. Bits a => a -> a
complement Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
x1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
m Int -> Int -> Int
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
(Int -> SlotFindResponse -> ShowS)
-> (SlotFindResponse -> String)
-> ([SlotFindResponse] -> ShowS)
-> Show SlotFindResponse
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 :: 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
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"findSafeSlots: h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" he=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Elem -> String
forall a. Show a => a -> String
show Elem
he
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b0=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b0
    SlotFindResponse
response <- Slot -> Int -> Bool -> ST s SlotFindResponse
go Slot
forall a. Monoid a => a
mempty Int
b0 Bool
False
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"go returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SlotFindResponse -> String
forall a. Show a => a -> String
show SlotFindResponse
response
    SlotFindResponse -> ST s SlotFindResponse
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound
                                    then Bool
False
                                    else Int
b Int -> Int -> Bool
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
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"go: fp="
                       , Slot -> String
forall a. Show a => a -> String
show Slot
fp
                       , String
" b="
                       , Int -> String
forall a. Show a => a -> String
show Int
b
                       , String
", wrap="
                       , Bool -> String
forall a. Show a => a -> String
show Bool
wrap
                       , String
", he="
                       , Elem -> String
forall a. Show a => a -> String
show Elem
he
                       , String
", emptyMarker="
                       , Elem -> String
forall a. Show a => a -> String
show Elem
emptyMarker
                       , String
", deletedMarker="
                       , Elem -> String
forall a. Show a => a -> String
show Elem
deletedMarker ]

        !Int
idx <- IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int
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
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"forwardSearch3 returned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with sz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", b=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b

        if Bool
wrap Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
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 Slot -> Slot -> Slot
forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot (String -> Int
forall a. HasCallStack => String -> a
error String
"impossible"))
            SlotFindResponse -> ST s SlotFindResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotFindResponse -> ST s SlotFindResponse)
-> SlotFindResponse -> ST s SlotFindResponse
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.
            Bool -> ST s () -> ST s ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Elem
h0 <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
            String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"h0 was " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Elem -> String
forall a. Show a => a -> String
show Elem
h0

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


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


------------------------------------------------------------------------------
{-# INLINE insertIntoSlot #-}
insertIntoSlot :: (HashTable_ s k v) -> Int -> Elem -> k -> v -> ST s ()
insertIntoSlot :: 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 <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
    let !heInt :: Int
heInt    = Elem -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
heOld :: Int
        !delInt :: Int
delInt   = Elem -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
deletedMarker :: Int
        !emptyInt :: Int
emptyInt = Elem -> Int
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
mask Int
heInt Int
emptyInt
        !loadBump :: Int
loadBump = Int
mLoad Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1 -- 1 if heInt == delInt || heInt == emptyInt,
                                -- 0 otherwise
    SizeRefs s -> Int -> ST s ()
forall s. SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
loadRef Int
delBump
    SizeRefs s -> Int -> ST s ()
forall s. SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
loadRef Int
loadBump
    IntArray s -> Int -> Elem -> ST s ()
forall s. IntArray s -> Int -> Elem -> ST s ()
U.writeArray IntArray s
hashes Int
idx Elem
he
    MutableArray s k -> Int -> k -> ST s ()
forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
idx k
k
    MutableArray s v -> Int -> v -> ST s ()
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 :: SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
ref Int
i = do
    !Int
ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ref
    SizeRefs s -> Int -> ST s ()
forall s. SizeRefs s -> Int -> ST s ()
writeLoad SizeRefs s
ref (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$! Int
ld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i


------------------------------------------------------------------------------
{-# INLINE bumpDelLoad #-}
bumpDelLoad :: (SizeRefs s) -> Int -> ST s ()
bumpDelLoad :: SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
ref Int
i = do
    !Int
ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readDelLoad SizeRefs s
ref
    SizeRefs s -> Int -> ST s ()
forall s. SizeRefs s -> Int -> ST s ()
writeDelLoad SizeRefs s
ref (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$! Int
ld Int -> Int -> Int
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#) = Int# -> Bool
forall a. Int# -> a
tagToEnum# Int#
i#


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


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


------------------------------------------------------------------------------
{-# INLINE recordIsFilled #-}
recordIsFilled :: Elem -> Bool
recordIsFilled :: Elem -> Bool
recordIsFilled !Elem
el = Int# -> Bool
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 :: k -> Int
hash = k -> Int
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 Int -> Int -> Int
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 :: HashTable_ s k v -> ST s (HashTable s k v)
newRef = (STRef s (HashTable_ s k v) -> HashTable s k v)
-> ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM STRef s (HashTable_ s k v) -> HashTable s k v
forall s k v. STRef s (HashTable_ s k v) -> HashTable s k v
HT (ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v))
-> (HashTable_ s k v -> ST s (STRef s (HashTable_ s k v)))
-> HashTable_ s k v
-> ST s (HashTable s k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashTable_ s k v -> ST s (STRef s (HashTable_ s k v))
forall a s. a -> ST s (STRef s a)
newSTRef
{-# INLINE newRef #-}

writeRef :: HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef :: HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef (HT STRef s (HashTable_ s k v)
ref) HashTable_ s k v
ht = STRef s (HashTable_ s k v) -> HashTable_ s k v -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (HashTable_ s k v)
ref HashTable_ s k v
ht
{-# INLINE writeRef #-}

readRef :: HashTable s k v -> ST s (HashTable_ s k v)
readRef :: HashTable s k v -> ST s (HashTable_ s k v)
readRef (HT STRef s (HashTable_ s k v)
ref) = STRef s (HashTable_ s k v) -> ST s (HashTable_ s k v)
forall s a. STRef s a -> ST s a
readSTRef STRef s (HashTable_ s k v)
ref
{-# INLINE readRef #-}


------------------------------------------------------------------------------
{-# INLINE debug #-}
debug :: String -> ST s ()
#ifdef DEBUG
debug s = unsafeIOToST (putStrLn s)
#else
debug :: String -> ST s ()
debug String
_ = () -> ST s ()
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 :: HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex HashTable s k v
htRef !k
k = do
    HashTable_ s k v
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
    HashTable_ s k v -> ST s (Maybe Word)
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
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"lookup h=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sz=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" b=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b
        Int -> Int -> Int -> ST s (Maybe a)
forall a. Num a => Int -> Int -> Int -> ST s (Maybe a)
go Int
b Int
0 Int
sz

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

                 if Elem -> Bool
recordIsEmpty Elem
h0
                   then do
                       String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"record empty, returning Nothing"
                       Maybe a -> ST s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                   else do
                     k
k' <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
idx
                     if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'
                       then do
                         String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"value found at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx
                         Maybe a -> ST s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ST s (Maybe a)) -> Maybe a -> ST s (Maybe a)
forall a b. (a -> b) -> a -> b
$! (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)
                       else do
                         String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"value not found, recursing"
                         if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
b
                           then Int -> Int -> Int -> ST s (Maybe a)
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
b
                           else Int -> Int -> Int -> ST s (Maybe a)
go (Int
idx Int -> Int -> Int
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 :: HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex HashTable s k v
htRef Word
i0 = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s (Maybe (Word, k, v)))
-> ST s (Maybe (Word, k, v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s (Maybe (Word, k, v))
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) = Int -> ST s (Maybe (a, k, v))
forall a. Num a => Int -> ST s (Maybe (a, k, v))
go (Word -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz = Maybe (a, k, v) -> ST s (Maybe (a, k, v))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, k, v)
forall a. Maybe a
Nothing
             | Bool
otherwise = do
            Elem
h <- IntArray s -> Int -> ST s Elem
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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              else do
                k
k <- MutableArray s k -> Int -> ST s k
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                v
v <- MutableArray s v -> Int -> ST s v
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
                let !i' :: a
i' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
                Maybe (a, k, v) -> ST s (Maybe (a, k, v))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, k, v) -> Maybe (a, k, v)
forall a. a -> Maybe a
Just (a
i', k
k, v
v))
{-# INLINE nextByIndex #-}