{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
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
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 :: forall s. 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
MutableByteArray (PrimState (ST 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 :: forall s. 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 ()
MutableByteArray (PrimState (ST 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 :: forall s. 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
MutableByteArray (PrimState (ST 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 :: forall s. 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 ()
MutableByteArray (PrimState (ST 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 :: forall s. ST s (SizeRefs s)
newSizeRefs = do
let asz :: Int
asz = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
intSz
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
A.fillByteArray a 0 asz 0
return 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)
, 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 = ST s (HashTable s k v)
forall s k v. ST s (HashTable s k v)
new
newSized :: forall s k v. Int -> ST s (HashTable s k v)
newSized = Int -> ST s (HashTable s k v)
forall s k v. Int -> ST s (HashTable s k v)
newSized
insert :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert = HashTable s k v -> k -> v -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
insert
delete :: forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> ST s ()
delete = HashTable s k v -> k -> ST s ()
forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s ()
delete
lookup :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup = HashTable s k v -> k -> ST s (Maybe v)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup
foldM :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM = (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM
mapM_ :: forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_ = ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
mapM_
lookupIndex :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe Word)
lookupIndex = HashTable s k v -> k -> ST s (Maybe Word)
forall k s v.
(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 = HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
forall s k v. HashTable s k v -> Word -> ST s (Maybe (Word, k, v))
nextByIndex
computeOverhead :: forall s k v. HashTable s k v -> ST s Double
computeOverhead = HashTable s k v -> ST s Double
forall s k v. HashTable s k v -> ST s Double
computeOverhead
mutate :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate = HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate
mutateST :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST
instance Show (HashTable s k v) where
show :: HashTable s k v -> String
show HashTable s k v
_ = String
"<HashTable>"
new :: ST s (HashTable s k v)
new :: forall s k v. ST s (HashTable s k v)
new = Int -> ST s (HashTable s k v)
forall s k v. Int -> ST s (HashTable s k v)
newSized Int
1
{-# INLINE new #-}
newSized :: Int -> ST s (HashTable s k v)
newSized :: forall s k v. Int -> ST s (HashTable s k v)
newSized Int
n = do
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 b. Integral b => Double -> b
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)
ht <- Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
m
newRef 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
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
h <- Int -> ST s (IntArray s)
forall s. Int -> ST s (IntArray s)
U.newArray Int
m'
k <- newArray m undefined
v <- newArray m undefined
ld <- newSizeRefs
return $! HashTable m ld h k v
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 _ sizeRefs _ _ _ <- 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
readLoad sizeRefs
{-# INLINE size #-}
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
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
slots <- findSafeSlots ht k h
when (trueInt (_slotFound slots)) $ deleteFromSlot ht (_slotB1 slots)
where
!h :: Int
h = k -> Int
forall k. Hashable k => k -> Int
hash k
k
{-# INLINE delete #-}
lookup :: (Eq k, Hashable k) => (HashTable s k v) -> k -> ST s (Maybe v)
lookup :: forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
lookup HashTable s k v
htRef !k
k = do
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
lookup' ht
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
]
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
debug $ "forwardSearch2 returned " ++ show idx
if (idx < 0 || idx < start || idx >= end)
then return Nothing
else do
h0 <- U.readArray hashes idx
debug $ "h0 was " ++ show h0
if recordIsEmpty h0
then do
debug $ "record empty, returning Nothing"
return Nothing
else do
k' <- readArray keys idx
if k == k'
then do
debug $ "value found at " ++ show idx
v <- readArray values idx
return $! Just v
else do
debug $ "value not found, recursing"
if idx < b
then go (idx + 1) (idx + 1) b
else go (idx + 1) start end
{-# INLINE lookup #-}
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
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
debug $ "insert: h=" ++ show h
slots@(SlotFindResponse foundInt b0 b1) <- findSafeSlots ht k h
let found = Int -> Bool
trueInt Int
foundInt
debug $ "insert: findSafeSlots returned " ++ show slots
when (found && (b0 /= b1)) $ deleteFromSlot ht b1
insertIntoSlot ht b0 he k v
ht' <- checkOverflow ht
writeRef htRef 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 #-}
mutate :: (Eq k, Hashable k) =>
(HashTable s k v)
-> k
-> (Maybe v -> (Maybe v, a))
-> ST s a
mutate :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate HashTable s k v
htRef !k
k !Maybe v -> (Maybe v, a)
f = HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST HashTable s k v
htRef k
k ((Maybe v, a) -> ST s (Maybe v, a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe v, a) -> ST s (Maybe v, a))
-> (Maybe v -> (Maybe v, a)) -> Maybe v -> ST s (Maybe v, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> (Maybe v, a)
f)
{-# INLINE mutate #-}
mutateST :: (Eq k, Hashable k) =>
(HashTable s k v)
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s a
mutateST :: forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> ST s (Maybe v, a)) -> ST s a
mutateST HashTable s k v
htRef !k
k !Maybe v -> ST s (Maybe v, a)
f = do
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
let 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
debug $ "mutate h=" ++ show h
slots@(SlotFindResponse foundInt b0 b1) <- findSafeSlots ht k h
let found = Int -> Bool
trueInt Int
foundInt
debug $ "findSafeSlots returned " ++ show slots
!mv <- if found
then fmap Just $ readArray values b1
else return Nothing
(!mv', !result) <- f mv
case (mv, mv') of
(Maybe v
Nothing, Maybe v
Nothing) -> () -> ST s ()
forall a. a -> ST s a
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'
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
writeRef htRef 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'
return 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 #-}
foldM :: (a -> (k,v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM a -> (k, v) -> ST s a
f a
seed0 HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s a) -> ST s a
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if recordIsEmpty h || recordIsDeleted h
then go (i+1) seed
else do
k <- readArray keys i
v <- readArray values i
!seed' <- f seed (k, v)
go (i+1) seed'
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 = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v) -> (HashTable_ s k v -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s ()
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if recordIsEmpty h || recordIsDeleted h
then go (i+1)
else do
k <- readArray keys i
v <- readArray values i
_ <- f (k, v)
go (i+1)
computeOverhead :: HashTable s k v -> ST s Double
computeOverhead :: forall s k v. HashTable s k v -> ST s Double
computeOverhead HashTable s k v
htRef = HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef ST s (HashTable_ s k v)
-> (HashTable_ s k v -> ST s Double) -> ST s Double
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s Double
forall {b} {s} {k} {v}. Fractional b => HashTable_ s k v -> ST s b
work
where
work :: HashTable_ s k v -> ST s b
work (HashTable Int
sz' SizeRefs s
loadRef IntArray s
_ MutableArray s k
_ MutableArray s v
_) = do
!ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
loadRef
let 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
return $ constOverhead/sz + (2 + 2*ws*(1-k)) / (k * 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'
constOverhead :: b
constOverhead = b
14
{-# 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
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
!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
debug $ "forwardSearch2 returned " ++ show idx
assert (idx >= 0) $ do
U.writeArray hashes idx he
writeArray keys idx key
writeArray values idx 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
!ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ldRef
!dl <- readDelLoad ldRef
debug $ concat [ "checkOverflow: sz="
, show sz
, " entries="
, show ld
, " deleted="
, show dl ]
if fromIntegral (ld + dl) / fromIntegral sz > maxLoad
then if dl > ld `div` 2
then rehashAll ht sz
else growTable ht
else return 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
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'
ht' <- Int -> ST s (HashTable_ s k v)
forall s k v. Int -> ST s (HashTable_ s k v)
newSizedReal Int
sz'
let (HashTable _ loadRef' newHashes newKeys newValues) = ht'
readLoad loadRef >>= writeLoad loadRef'
rehash newHashes newKeys newValues
return 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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = {-# SCC "growTable/rehash" #-} do
h0 <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
when (not (recordIsEmpty h0 || recordIsDeleted h0)) $ do
k <- readArray keys i
v <- readArray values i
insertRecord sz' newHashes newKeys newValues
(hash k) k v
go $ i+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
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'
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
$cshowsPrec :: Int -> Slot -> ShowS
showsPrec :: Int -> Slot -> ShowS
$cshow :: Slot -> String
show :: Slot -> String
$cshowList :: [Slot] -> ShowS
showList :: [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 Int
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 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)
data SlotFindResponse = SlotFindResponse {
SlotFindResponse -> Int
_slotFound :: {-# UNPACK #-} !Int
, 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
$cshowsPrec :: Int -> SlotFindResponse -> ShowS
showsPrec :: Int -> SlotFindResponse -> ShowS
$cshow :: SlotFindResponse -> String
show :: SlotFindResponse -> String
$cshowList :: [SlotFindResponse] -> ShowS
showList :: [SlotFindResponse] -> ShowS
Show)
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
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
response <- Slot -> Int -> Bool -> ST s SlotFindResponse
go Slot
forall a. Monoid a => a
mempty Int
b0 Bool
False
debug $ "go returned " ++ show response
return 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
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 ]
!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
debug $ "forwardSearch3 returned " ++ show idx
++ " with sz=" ++ show sz ++ ", b=" ++ show b
if wrap && idx >= b0
then do
let !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"))
return $! SlotFindResponse 0 (_slot sl) (_slot sl)
else do
assert (idx >= 0) $ return ()
h0 <- U.readArray hashes idx
debug $ "h0 was " ++ show h0
if recordIsEmpty h0
then do
let pl = Slot
fp Slot -> Slot -> Slot
forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
debug $ "empty, returning " ++ show pl
return $! SlotFindResponse 0 (_slot pl) (_slot pl)
else do
let !wrap' = Slot -> Int -> Bool
haveWrapped Slot
fp Int
idx
if recordIsDeleted h0
then do
let !pl = Slot
fp Slot -> Slot -> Slot
forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
debug $ "deleted, cont with pl=" ++ show pl
go pl (idx + 1) wrap'
else
if he == h0
then do
debug $ "found he == h0 == " ++ show h0
k' <- readArray keys idx
if k == k'
then do
debug $ "found at " ++ show idx
let !sl = Slot
fp Slot -> Slot -> Slot
forall a. Monoid a => a -> a -> a
`mappend` (Int -> Slot
Slot Int
idx)
return $! SlotFindResponse 1 (_slot sl) idx
else go fp (idx + 1) wrap'
else go fp (idx + 1) 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
!he <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
when (recordIsFilled he) $ do
bumpDelLoad loadRef 1
bumpLoad loadRef (-1)
U.writeArray hashes idx deletedMarker
writeArray keys idx undefined
writeArray values idx 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
!heOld <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
idx
let !heInt = Elem -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
heOld :: Int
!delInt = Elem -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
deletedMarker :: Int
!emptyInt = Elem -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Elem
emptyMarker :: Int
!delBump = Int -> Int -> Int
mask Int
heInt Int
delInt
!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
mLoad Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1
bumpDelLoad loadRef delBump
bumpLoad loadRef loadBump
U.writeArray hashes idx he
writeArray keys idx k
writeArray values idx v
{-# INLINE bumpLoad #-}
bumpLoad :: (SizeRefs s) -> Int -> ST s ()
bumpLoad :: forall s. SizeRefs s -> Int -> ST s ()
bumpLoad SizeRefs s
ref Int
i = do
!ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readLoad SizeRefs s
ref
writeLoad ref $! ld + i
{-# INLINE bumpDelLoad #-}
bumpDelLoad :: (SizeRefs s) -> Int -> ST s ()
bumpDelLoad :: forall s. SizeRefs s -> Int -> ST s ()
bumpDelLoad SizeRefs s
ref Int
i = do
!ld <- SizeRefs s -> ST s Int
forall s. SizeRefs s -> ST s Int
readDelLoad SizeRefs s
ref
writeDelLoad ref $! ld + 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 :: forall k. Hashable k => 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 :: forall s k v. HashTable_ s k v -> ST s (HashTable s k v)
newRef = (STRef s (HashTable_ s k v) -> HashTable s k v)
-> ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM STRef s (HashTable_ s k v) -> HashTable s k v
forall s k v. STRef s (HashTable_ s k v) -> HashTable s k v
HT (ST s (STRef s (HashTable_ s k v)) -> ST s (HashTable s k v))
-> (HashTable_ s k v -> ST s (STRef s (HashTable_ s k v)))
-> HashTable_ s k v
-> ST s (HashTable s k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashTable_ s k v -> ST s (STRef s (HashTable_ s k v))
forall a s. a -> ST s (STRef s a)
newSTRef
{-# INLINE newRef #-}
writeRef :: HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef :: forall s k v. HashTable s k v -> HashTable_ s k v -> ST s ()
writeRef (HT STRef s (HashTable_ s k v)
ref) HashTable_ s k v
ht = STRef s (HashTable_ s k v) -> HashTable_ s k v -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (HashTable_ s k v)
ref HashTable_ s k v
ht
{-# INLINE writeRef #-}
readRef :: HashTable s k v -> ST s (HashTable_ s k v)
readRef :: forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef (HT STRef s (HashTable_ s k v)
ref) = STRef s (HashTable_ s k v) -> ST s (HashTable_ s k v)
forall s a. STRef s a -> ST s a
readSTRef STRef s (HashTable_ s k v)
ref
{-# INLINE readRef #-}
{-# INLINE debug #-}
debug :: String -> ST s ()
#ifdef DEBUG
debug s = unsafeIOToST (putStrLn s)
#else
debug :: forall s. String -> ST s ()
debug String
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
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
ht <- HashTable s k v -> ST s (HashTable_ s k v)
forall s k v. HashTable s k v -> ST s (HashTable_ s k v)
readRef HashTable s k v
htRef
lookup' ht
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
]
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
debug $ "forwardSearch2 returned " ++ show idx
if (idx < 0 || idx < start || idx >= end)
then return Nothing
else do
h0 <- U.readArray hashes idx
debug $ "h0 was " ++ show h0
if recordIsEmpty h0
then do
debug $ "record empty, returning Nothing"
return Nothing
else do
k' <- readArray keys idx
if k == k'
then do
debug $ "value found at " ++ show idx
return $! (Just $! fromIntegral idx)
else do
debug $ "value not found, recursing"
if idx < b
then go (idx + 1) (idx + 1) b
else go (idx + 1) start 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 = 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 a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashTable_ s k v -> ST s (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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, k, v)
forall a. Maybe a
Nothing
| Bool
otherwise = do
h <- IntArray s -> Int -> ST s Elem
forall s. IntArray s -> Int -> ST s Elem
U.readArray IntArray s
hashes Int
i
if recordIsEmpty h || recordIsDeleted h
then go (i+1)
else do
k <- readArray keys i
v <- readArray values i
let !i' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
return (Just (i', k, v))
{-# INLINE nextByIndex #-}