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

module Data.HashTable.Internal.Linear.Bucket
( Bucket,
  newBucketArray,
  newBucketSize,
  emptyWithSize,
  growBucketTo,
  snoc,
  size,
  lookup,
  lookupIndex,
  elemAt,
  delete,
  mutate,
  mutateST,
  toList,
  fromList,
  mapM_,
  foldM,
  expandBucketArray,
  expandArray,
  nelemsAndOverheadInWords,
  bucketSplitSize
) where


------------------------------------------------------------------------------
#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative
#endif
import           Control.Monad                        hiding (foldM, mapM_)
import qualified Control.Monad
import           Control.Monad.ST                     (ST)
#ifdef DEBUG
import           Data.HashTable.Internal.Utils        (unsafeIOToST)
#endif
import           Data.HashTable.Internal.Array
import           Data.Maybe                           (fromMaybe)
import           Data.STRef
import           Prelude                              hiding (lookup, mapM_)
------------------------------------------------------------------------------
import           Data.HashTable.Internal.UnsafeTricks


#ifdef DEBUG
import           System.IO
#endif


type Bucket s k v = Key (Bucket_ s k v)

------------------------------------------------------------------------------
data Bucket_ s k v = Bucket { forall s k v. Bucket_ s k v -> Int
_bucketSize :: {-# UNPACK #-} !Int
                            , forall s k v. Bucket_ s k v -> STRef s Int
_highwater  :: {-# UNPACK #-} !(STRef s Int)
                            , forall s k v. Bucket_ s k v -> MutableArray s k
_keys       :: {-# UNPACK #-} !(MutableArray s k)
                            , forall s k v. Bucket_ s k v -> MutableArray s v
_values     :: {-# UNPACK #-} !(MutableArray s v)
                            }


------------------------------------------------------------------------------
bucketSplitSize :: Int
bucketSplitSize :: Int
bucketSplitSize = Int
16


------------------------------------------------------------------------------
newBucketArray :: Int -> ST s (MutableArray s (Bucket s k v))
newBucketArray :: forall s k v. Int -> ST s (MutableArray s (Bucket s k v))
newBucketArray Int
k = forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
k forall a. Bucket s k v
emptyRecord

------------------------------------------------------------------------------
nelemsAndOverheadInWords :: Bucket s k v -> ST s (Int,Int)
nelemsAndOverheadInWords :: forall s k v. Bucket s k v -> ST s (Int, Int)
nelemsAndOverheadInWords Bucket s k v
bKey = do
    if (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bKey)
      then do
        !Int
hw <- forall s a. STRef s a -> ST s a
readSTRef forall {s}. STRef s Int
hwRef
        let !w :: Int
w = Int
sz forall a. Num a => a -> a -> a
- Int
hw
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw, Int
constOverhead forall a. Num a => a -> a -> a
+ Int
2forall a. Num a => a -> a -> a
*Int
w)
      else
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
0)

  where
    constOverhead :: Int
constOverhead = Int
8
    b :: a
b             = forall a. Bucket s k v -> a
fromKey Bucket s k v
bKey
    sz :: Int
sz            = forall s k v. Bucket_ s k v -> Int
_bucketSize forall {a}. a
b
    hwRef :: STRef s Int
hwRef         = forall s k v. Bucket_ s k v -> STRef s Int
_highwater forall {a}. a
b


------------------------------------------------------------------------------
emptyWithSize :: Int -> ST s (Bucket s k v)
emptyWithSize :: forall s k v. Int -> ST s (Bucket s k v)
emptyWithSize !Int
sz = do
    !MutableArray s (Bucket s k v)
keys   <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
sz forall a. HasCallStack => a
undefined
    !MutableArray s (Bucket s k v)
values <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
sz forall a. HasCallStack => a
undefined
    !STRef s Int
ref    <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Bucket s k v
toKey forall a b. (a -> b) -> a -> b
$ forall s k v.
Int
-> STRef s Int
-> MutableArray s k
-> MutableArray s v
-> Bucket_ s k v
Bucket Int
sz STRef s Int
ref MutableArray s (Bucket s k v)
keys MutableArray s (Bucket s k v)
values


------------------------------------------------------------------------------
newBucketSize :: Int
newBucketSize :: Int
newBucketSize = Int
4


------------------------------------------------------------------------------
expandArray  :: a                  -- ^ default value
             -> Int                -- ^ new size
             -> Int                -- ^ number of elements to copy
             -> MutableArray s a   -- ^ old array
             -> ST s (MutableArray s a)
expandArray :: forall a s.
a -> Int -> Int -> MutableArray s a -> ST s (MutableArray s a)
expandArray a
def !Int
sz !Int
hw !MutableArray s a
arr = do
    MutableArray s a
newArr <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
sz a
def
    MutableArray s a -> ST s (MutableArray s a)
cp MutableArray s a
newArr

  where
    cp :: MutableArray s a -> ST s (MutableArray s a)
cp !MutableArray s a
newArr = Int -> ST s (MutableArray s a)
go Int
0
      where
        go :: Int -> ST s (MutableArray s a)
go !Int
i
          | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hw = forall (m :: * -> *) a. Monad m => a -> m a
return MutableArray s a
newArr
          | Bool
otherwise = do
                forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s a
arr Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s a
newArr Int
i
                Int -> ST s (MutableArray s a)
go (Int
iforall a. Num a => a -> a -> a
+Int
1)


------------------------------------------------------------------------------
expandBucketArray :: Int
                  -> Int
                  -> MutableArray s (Bucket s k v)
                  -> ST s (MutableArray s (Bucket s k v))
expandBucketArray :: forall s k v.
Int
-> Int
-> MutableArray s (Bucket s k v)
-> ST s (MutableArray s (Bucket s k v))
expandBucketArray = forall a s.
a -> Int -> Int -> MutableArray s a -> ST s (MutableArray s a)
expandArray forall a. Bucket s k v
emptyRecord


------------------------------------------------------------------------------
growBucketTo :: Int -> Bucket s k v -> ST s (Bucket s k v)
growBucketTo :: forall s k v. Int -> Bucket s k v -> ST s (Bucket s k v)
growBucketTo !Int
sz Bucket s k v
bk | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bk = forall s k v. Int -> ST s (Bucket s k v)
emptyWithSize Int
sz
                    | Bool
otherwise = do
    if Int
osz forall a. Ord a => a -> a -> Bool
>= Int
sz
      then forall (m :: * -> *) a. Monad m => a -> m a
return Bucket s k v
bk
      else do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef forall {s}. STRef s Int
hwRef
        MutableArray s (Bucket s k v)
k' <- forall a s.
a -> Int -> Int -> MutableArray s a -> ST s (MutableArray s a)
expandArray forall a. HasCallStack => a
undefined Int
sz Int
hw forall {s} {k}. MutableArray s k
keys
        MutableArray s (Bucket s k v)
v' <- forall a s.
a -> Int -> Int -> MutableArray s a -> ST s (MutableArray s a)
expandArray forall a. HasCallStack => a
undefined Int
sz Int
hw forall {s} {k}. MutableArray s k
values
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Bucket s k v
toKey forall a b. (a -> b) -> a -> b
$ forall s k v.
Int
-> STRef s Int
-> MutableArray s k
-> MutableArray s v
-> Bucket_ s k v
Bucket Int
sz forall {s}. STRef s Int
hwRef MutableArray s (Bucket s k v)
k' MutableArray s (Bucket s k v)
v'

  where
    bucket :: a
bucket = forall a. Bucket s k v -> a
fromKey Bucket s k v
bk
    osz :: Int
osz    = forall s k v. Bucket_ s k v -> Int
_bucketSize forall {a}. a
bucket
    hwRef :: STRef s Int
hwRef  = forall s k v. Bucket_ s k v -> STRef s Int
_highwater forall {a}. a
bucket
    keys :: MutableArray s k
keys   = forall s k v. Bucket_ s k v -> MutableArray s k
_keys forall {a}. a
bucket
    values :: MutableArray s v
values = forall s k v. Bucket_ s k v -> MutableArray s v
_values forall {a}. a
bucket


------------------------------------------------------------------------------
{-# INLINE snoc #-}
-- Just return == new bucket object
snoc :: Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc :: forall s k v.
Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc Bucket s k v
bucket | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucket = forall {a} {k} {v} {s}.
Num a =>
k -> v -> ST s (a, Maybe (Bucket s k v))
mkNew
            | Bool
otherwise         = forall {s} {k} {v}.
Bucket_ s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc' (forall a. Bucket s k v -> a
fromKey Bucket s k v
bucket)
  where
    mkNew :: k -> v -> ST s (a, Maybe (Bucket s k v))
mkNew !k
k !v
v = do
        forall s. String -> ST s ()
debug String
"Bucket.snoc: mkNew"
        MutableArray s k
keys   <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
newBucketSize forall a. HasCallStack => a
undefined
        MutableArray s v
values <- forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
newBucketSize forall a. HasCallStack => a
undefined

        forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
0 k
k
        forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
0 v
v
        STRef s Int
ref <- forall a s. a -> ST s (STRef s a)
newSTRef Int
1
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
1, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Bucket s k v
toKey forall a b. (a -> b) -> a -> b
$ forall s k v.
Int
-> STRef s Int
-> MutableArray s k
-> MutableArray s v
-> Bucket_ s k v
Bucket Int
newBucketSize STRef s Int
ref MutableArray s k
keys MutableArray s v
values)

    snoc' :: Bucket_ s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc' (Bucket Int
bsz STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) !k
k !v
v =
        forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ST s (Int, Maybe (Bucket s k v))
check
      where
        check :: Int -> ST s (Int, Maybe (Bucket s k v))
check !Int
hw
          | Int
hw forall a. Ord a => a -> a -> Bool
< Int
bsz  = forall {a}. Int -> ST s (Int, Maybe a)
bump Int
hw
          | Bool
otherwise = forall {s}. Int -> ST s (Int, Maybe (Bucket s k v))
spill Int
hw

        bump :: Int -> ST s (Int, Maybe a)
bump Int
hw = do
          forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.snoc: bumping hw, bsz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
bsz forall a. [a] -> [a] -> [a]
++ String
", hw="
                    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
hw

          forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
hw k
k
          forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
hw v
v
          let !hw' :: Int
hw' = Int
hw forall a. Num a => a -> a -> a
+ Int
1
          forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
hwRef Int
hw'
          forall s. String -> ST s ()
debug String
"Bucket.snoc: finished"
          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', forall a. Maybe a
Nothing)

        doublingThreshold :: Int
doublingThreshold = Int
bucketSplitSize forall a. Integral a => a -> a -> a
`div` Int
2
        growFactor :: Double
growFactor = Double
1.5 :: Double
        newSize :: Int -> Int
newSize Int
z | Int
z forall a. Eq a => a -> a -> Bool
== Int
0 = Int
newBucketSize
                  | Int
z forall a. Ord a => a -> a -> Bool
< Int
doublingThreshold = Int
z forall a. Num a => a -> a -> a
* Int
2
                  | Bool
otherwise = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ Double
growFactor forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z

        spill :: Int -> ST s (Int, Maybe (Bucket s k v))
spill !Int
hw = do
            let sz :: Int
sz = Int -> Int
newSize Int
bsz
            forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.snoc: spilling, old size=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
bsz forall a. [a] -> [a] -> [a]
++ String
", new size="
                      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz

            Bucket s k v
bk <- forall s k v. Int -> Bucket s k v -> ST s (Bucket s k v)
growBucketTo Int
sz Bucket s k v
bucket

            forall s. String -> ST s ()
debug String
"Bucket.snoc: spill finished, snoccing element"
            let (Bucket Int
_ STRef s Int
hwRef' MutableArray s k
keys' MutableArray s v
values') = forall a. Bucket s k v -> a
fromKey Bucket s k v
bk

            let !hw' :: Int
hw' = Int
hwforall a. Num a => a -> a -> a
+Int
1
            forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray forall {s} {k}. MutableArray s k
keys' Int
hw k
k
            forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray forall {s} {k}. MutableArray s k
values' Int
hw v
v
            forall s a. STRef s a -> a -> ST s ()
writeSTRef forall {s}. STRef s Int
hwRef' Int
hw'

            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', forall a. a -> Maybe a
Just Bucket s k v
bk)



------------------------------------------------------------------------------
{-# INLINE size #-}
size :: Bucket s k v -> ST s Int
size :: forall s k v. Bucket s k v -> ST s Int
size Bucket s k v
b | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
b = forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
       | Bool
otherwise = forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ forall s k v. Bucket_ s k v -> STRef s Int
_highwater forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
b


------------------------------------------------------------------------------
-- note: search in reverse order! We prefer recently snoc'd keys.
lookup :: (Eq k) => Bucket s k v -> k -> ST s (Maybe v)
lookup :: forall k s v. Eq k => Bucket s k v -> k -> ST s (Maybe v)
lookup Bucket s k v
bucketKey !k
k | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                    | Bool
otherwise = forall {s} {v}. Bucket_ s k v -> ST s (Maybe v)
lookup' forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    lookup' :: Bucket_ s k v -> ST s (Maybe v)
lookup' (Bucket Int
_ STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int -> ST s (Maybe v)
go (Int
hwforall a. Num a => a -> a -> a
-Int
1)
      where
        go :: Int -> ST s (Maybe v)
go !Int
i
            | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            | Bool
otherwise = do
                k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                  then do
                    !v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just v
v
                  else Int -> ST s (Maybe v)
go (Int
iforall a. Num a => a -> a -> a
-Int
1)

------------------------------------------------------------------------------
-- note: search in reverse order! We prefer recently snoc'd keys.
lookupIndex :: (Eq k) => Bucket s k v -> k -> ST s (Maybe Int)
lookupIndex :: forall k s v. Eq k => Bucket s k v -> k -> ST s (Maybe Int)
lookupIndex Bucket s k v
bucketKey !k
k
  | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  | Bool
otherwise = forall {s} {v}. Bucket_ s k v -> ST s (Maybe Int)
lookup' forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    lookup' :: Bucket_ s k v -> ST s (Maybe Int)
lookup' (Bucket Int
_ STRef s Int
hwRef MutableArray s k
keys MutableArray s v
_values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int -> ST s (Maybe Int)
go (Int
hwforall a. Num a => a -> a -> a
-Int
1)
      where
        go :: Int -> ST s (Maybe Int)
go !Int
i
            | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            | Bool
otherwise = do
                k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                  then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
i)
                  else Int -> ST s (Maybe Int)
go (Int
iforall a. Num a => a -> a -> a
-Int
1)

elemAt :: Bucket s k v -> Int -> ST s (Maybe (k,v))
elemAt :: forall s k v. Bucket s k v -> Int -> ST s (Maybe (k, v))
elemAt Bucket s k v
bucketKey Int
ix
  | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  | Bool
otherwise = forall {s} {a} {b}. Bucket_ s a b -> ST s (Maybe (a, b))
lookup' forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    lookup' :: Bucket_ s a b -> ST s (Maybe (a, b))
lookup' (Bucket Int
_ STRef s Int
hwRef MutableArray s a
keys MutableArray s b
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        if Int
0 forall a. Ord a => a -> a -> Bool
<= Int
ix Bool -> Bool -> Bool
&& Int
ix forall a. Ord a => a -> a -> Bool
< Int
hw
          then do a
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s a
keys Int
ix
                  b
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s b
values Int
ix
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
k,b
v))
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

------------------------------------------------------------------------------
{-# INLINE toList #-}
toList :: Bucket s k v -> ST s [(k,v)]
toList :: forall s k v. Bucket s k v -> ST s [(k, v)]
toList Bucket s k v
bucketKey | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = forall (m :: * -> *) a. Monad m => a -> m a
return []
                 | Bool
otherwise = forall {s} {k} {v}. Bucket_ s k v -> ST s [(k, v)]
toList' forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    toList' :: Bucket_ s k v -> ST s [(k, v)]
toList' (Bucket Int
_ STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        [(k, v)] -> Int -> Int -> ST s [(k, v)]
go [] Int
hw Int
0
      where
        go :: [(k, v)] -> Int -> Int -> ST s [(k, v)]
go ![(k, v)]
l !Int
hw !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hw   = forall (m :: * -> *) a. Monad m => a -> m a
return [(k, v)]
l
                     | Bool
otherwise = do
            k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
            v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
            [(k, v)] -> Int -> Int -> ST s [(k, v)]
go ((k
k,v
v)forall a. a -> [a] -> [a]
:[(k, v)]
l) Int
hw forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1


------------------------------------------------------------------------------
-- fromList needs to reverse the input in order to make fromList . toList == id
{-# INLINE fromList #-}
fromList :: [(k,v)] -> ST s (Bucket s k v)
fromList :: forall k v s. [(k, v)] -> ST s (Bucket s k v)
fromList [(k, v)]
l = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Control.Monad.foldM forall {k} {v} {s}. Bucket s k v -> (k, v) -> ST s (Bucket s k v)
f forall a. Bucket s k v
emptyRecord (forall a. [a] -> [a]
reverse [(k, v)]
l)
  where
    f :: Bucket s k v -> (k, v) -> ST s (Bucket s k v)
f Bucket s k v
bucket (k
k,v
v) = do
        (Int
_,Maybe (Bucket s k v)
m) <- forall s k v.
Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc Bucket s k v
bucket k
k v
v
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Bucket s k v
bucket Maybe (Bucket s k v)
m

------------------------------------------------------------------------------
delete :: (Eq k) => Bucket s k v -> k -> ST s Bool
delete :: forall k s v. Eq k => Bucket s k v -> k -> ST s Bool
delete Bucket s k v
bucketKey !k
k | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = do
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.delete: empty bucket"
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                    | Bool
otherwise = do
    forall s. String -> ST s ()
debug String
"Bucket.delete: start"
    forall {s} {v}. Bucket_ s k v -> ST s Bool
del forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    del :: Bucket_ s k v -> ST s Bool
del (Bucket Int
sz STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.delete: hw=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
hw forall a. [a] -> [a] -> [a]
++ String
", sz=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz
        Int -> Int -> ST s Bool
go Int
hw forall a b. (a -> b) -> a -> b
$ Int
hw forall a. Num a => a -> a -> a
- Int
1

      where
        go :: Int -> Int -> ST s Bool
go !Int
hw !Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  | Bool
otherwise = do
            k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
            if k
k forall a. Eq a => a -> a -> Bool
== k
k'
              then do
                  forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"found entry to delete at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
                  forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwforall a. Num a => a -> a -> a
-Int
1) Int
i MutableArray s k
keys
                  forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwforall a. Num a => a -> a -> a
-Int
1) Int
i MutableArray s v
values
                  let !hw' :: Int
hw' = Int
hwforall a. Num a => a -> a -> a
-Int
1
                  forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
hwRef Int
hw'
                  forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              else Int -> Int -> ST s Bool
go Int
hw (Int
iforall a. Num a => a -> a -> a
-Int
1)


------------------------------------------------------------------------------
mutate :: (Eq k) =>
          Bucket s k v
       -> k
       -> (Maybe v -> (Maybe v, a))
       -> ST s (Int, Maybe (Bucket s k v), a)
mutate :: forall k s v a.
Eq k =>
Bucket s k v
-> k
-> (Maybe v -> (Maybe v, a))
-> ST s (Int, Maybe (Bucket s k v), a)
mutate Bucket s k v
bucketKey !k
k !Maybe v -> (Maybe v, a)
f = forall k s v a.
Eq k =>
Bucket s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s (Int, Maybe (Bucket s k v), a)
mutateST Bucket s k v
bucketKey k
k (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> (Maybe v, a)
f)
{-# INLINE mutate #-}


------------------------------------------------------------------------------
mutateST :: (Eq k) =>
            Bucket s k v
         -> k
         -> (Maybe v -> ST s (Maybe v, a))
         -> ST s (Int, Maybe (Bucket s k v), a)
mutateST :: forall k s v a.
Eq k =>
Bucket s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s (Int, Maybe (Bucket s k v), a)
mutateST Bucket s k v
bucketKey !k
k !Maybe v -> ST s (Maybe v, a)
f
    | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = do
        (Maybe v, a)
fRes <- Maybe v -> ST s (Maybe v, a)
f forall a. Maybe a
Nothing
        case (Maybe v, a)
fRes of
            (Maybe v
Nothing, a
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, forall a. Maybe a
Nothing, a
a)
            (Just v
v', a
a) -> do
                (!Int
hw', Maybe (Bucket s k v)
mbk) <- forall s k v.
Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc Bucket s k v
bucketKey k
k v
v'
                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', Maybe (Bucket s k v)
mbk, a
a)
    | Bool
otherwise = Bucket_ s k v -> ST s (Int, Maybe (Bucket s k v), a)
mutate' forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    mutate' :: Bucket_ s k v -> ST s (Int, Maybe (Bucket s k v), a)
mutate' (Bucket Int
_sz STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int
pos <- forall {t}. t -> Int -> ST s Int
findPosition Int
hw (Int
hwforall a. Num a => a -> a -> a
-Int
1)
        Maybe v
mv <- do
            if Int
pos forall a. Ord a => a -> a -> Bool
< Int
0
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                else forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
pos forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
        (Maybe v, a)
fRes <- Maybe v -> ST s (Maybe v, a)
f Maybe v
mv
        case (Maybe v
mv, (Maybe v, a)
fRes) of
            (Maybe v
Nothing, (Maybe v
Nothing, a
a)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw, forall a. Maybe a
Nothing, a
a)
            (Maybe v
Nothing, (Just v
v', a
a)) -> do
                (!Int
hw', Maybe (Bucket s k v)
mbk) <- forall s k v.
Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc Bucket s k v
bucketKey k
k v
v'
                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', Maybe (Bucket s k v)
mbk, a
a)
            (Just v
_v, (Just v
v', a
a)) -> do
                forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
pos v
v'
                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw, forall a. Maybe a
Nothing, a
a)
            (Just v
_v, (Maybe v
Nothing, a
a)) -> do
                forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwforall a. Num a => a -> a -> a
-Int
1) Int
pos MutableArray s k
keys
                forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwforall a. Num a => a -> a -> a
-Int
1) Int
pos MutableArray s v
values
                let !hw' :: Int
hw' = Int
hwforall a. Num a => a -> a -> a
-Int
1
                forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
hwRef Int
hw'
                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', forall a. Maybe a
Nothing, a
a)
      where
        findPosition :: t -> Int -> ST s Int
findPosition !t
hw !Int
i
            | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
            | Bool
otherwise = do
                k
k' <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
                if k
k forall a. Eq a => a -> a -> Bool
== k
k'
                  then forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
                  else t -> Int -> ST s Int
findPosition t
hw (Int
iforall a. Num a => a -> a -> a
-Int
1)


------------------------------------------------------------------------------
{-# INLINE mapM_ #-}
mapM_ :: ((k,v) -> ST s a) -> Bucket s k v -> ST s ()
mapM_ :: forall k v s a. ((k, v) -> ST s a) -> Bucket s k v -> ST s ()
mapM_ (k, v) -> ST s a
f Bucket s k v
bucketKey
    | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = do
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.mapM_: bucket was empty"
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = Bucket_ s k v -> ST s ()
doMap forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    doMap :: Bucket_ s k v -> ST s ()
doMap (Bucket Int
sz STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"Bucket.mapM_: hw was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
hw forall a. [a] -> [a] -> [a]
++ String
", sz was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sz
        Int -> Int -> ST s ()
go Int
hw Int
0
      where
        go :: Int -> Int -> ST s ()
go !Int
hw !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hw = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  | Bool
otherwise = do
            k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
            v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
            a
_ <- (k, v) -> ST s a
f (k
k,v
v)
            Int -> Int -> ST s ()
go Int
hw forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1


------------------------------------------------------------------------------
{-# INLINE foldM #-}
foldM :: (a -> (k,v) -> ST s a) -> a -> Bucket s k v -> ST s a
foldM :: forall a k v s.
(a -> (k, v) -> ST s a) -> a -> Bucket s k v -> ST s a
foldM a -> (k, v) -> ST s a
f !a
seed0 Bucket s k v
bucketKey
    | forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = forall (m :: * -> *) a. Monad m => a -> m a
return a
seed0
    | Bool
otherwise = Bucket_ s k v -> ST s a
doMap forall a b. (a -> b) -> a -> b
$ forall a. Bucket s k v -> a
fromKey Bucket s k v
bucketKey
  where
    doMap :: Bucket_ s k v -> ST s a
doMap (Bucket Int
_ STRef s Int
hwRef MutableArray s k
keys MutableArray s v
values) = do
        Int
hw <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int -> a -> Int -> ST s a
go Int
hw a
seed0 Int
0
      where
        go :: Int -> a -> Int -> ST s a
go !Int
hw !a
seed !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
hw = forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
                        | Bool
otherwise = do
            k
k <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s k
keys Int
i
            v
v <- forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
i
            a
seed' <- a -> (k, v) -> ST s a
f a
seed (k
k,v
v)
            Int -> a -> Int -> ST s a
go Int
hw a
seed' (Int
iforall a. Num a => a -> a -> a
+Int
1)


------------------------------------------------------------------------------
-- move i into j
move :: Int -> Int -> MutableArray s a -> ST s ()
move :: forall s a. Int -> Int -> MutableArray s a -> ST s ()
move Int
i Int
j MutableArray s a
arr | Int
i forall a. Eq a => a -> a -> Bool
== Int
j    = do
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"move " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" into " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
j
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
             | Bool
otherwise = do
    forall s. String -> ST s ()
debug forall a b. (a -> b) -> a -> b
$ String
"move " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" into " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
j
    forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s a
arr Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s a
arr Int
j



{-# INLINE debug #-}
debug :: String -> ST s ()

#ifdef DEBUG
debug s = unsafeIOToST $ do
              putStrLn s
              hFlush stdout
#else
#ifdef TESTSUITE
debug !s = do
    let !_ = length s
    return $! ()
#else
debug :: forall s. String -> ST s ()
debug String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
#endif