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

  where
    constOverhead :: Int
constOverhead = Int
8
    b :: a
b             = Bucket s k v -> a
forall a. Bucket s k v -> a
fromKey Bucket s k v
bKey
    sz :: Int
sz            = Bucket_ (Bucket s k v) (Bucket s k v) (Bucket s k v) -> Int
forall s k v. Bucket_ s k v -> Int
_bucketSize Bucket_ (Bucket s k v) (Bucket s k v) (Bucket s k v)
forall {a}. a
b
    hwRef :: STRef s Int
hwRef         = Bucket_ s (Bucket s k v) (Bucket s k v) -> STRef s Int
forall s k v. Bucket_ s k v -> STRef s Int
_highwater Bucket_ s (Bucket s k v) (Bucket s k v)
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   <- Int -> Bucket s k v -> ST s (MutableArray s (Bucket s k v))
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
sz Bucket s k v
forall a. HasCallStack => a
undefined
    !MutableArray s (Bucket s k v)
values <- Int -> Bucket s k v -> ST s (MutableArray s (Bucket s k v))
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
sz Bucket s k v
forall a. HasCallStack => a
undefined
    !STRef s Int
ref    <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0

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

  where
    bucket :: a
bucket = Bucket s k v -> a
forall a. Bucket s k v -> a
fromKey Bucket s k v
bk
    osz :: Int
osz    = Bucket_ (Bucket s k v) (Bucket s k v) (Bucket s k v) -> Int
forall s k v. Bucket_ s k v -> Int
_bucketSize Bucket_ (Bucket s k v) (Bucket s k v) (Bucket s k v)
forall {a}. a
bucket
    hwRef :: STRef s Int
hwRef  = Bucket_ s (Bucket s k v) (Bucket s k v) -> STRef s Int
forall s k v. Bucket_ s k v -> STRef s Int
_highwater Bucket_ s (Bucket s k v) (Bucket s k v)
forall {a}. a
bucket
    keys :: MutableArray s k
keys   = Bucket_ s k (Bucket s k v) -> MutableArray s k
forall s k v. Bucket_ s k v -> MutableArray s k
_keys Bucket_ s k (Bucket s k v)
forall {a}. a
bucket
    values :: MutableArray s v
values = Bucket_ s (Bucket s k v) v -> MutableArray s v
forall s k v. Bucket_ s k v -> MutableArray s v
_values Bucket_ s (Bucket s k v) v
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 | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucket = k -> v -> ST s (Int, Maybe (Bucket s k v))
forall {a} {k} {v} {s}.
Num a =>
k -> v -> ST s (a, Maybe (Bucket s k v))
mkNew
            | Bool
otherwise         = Bucket_ s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
forall {s} {k} {v}.
Bucket_ s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
snoc' (Bucket s k v -> Bucket_ s k v
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
        String -> ST s ()
forall s. String -> ST s ()
debug String
"Bucket.snoc: mkNew"
        MutableArray s k
keys   <- Int -> k -> ST s (MutableArray s k)
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
newBucketSize k
forall a. HasCallStack => a
undefined
        MutableArray s v
values <- Int -> v -> ST s (MutableArray s v)
forall a s. Int -> a -> ST s (MutableArray s a)
newArray Int
newBucketSize v
forall a. HasCallStack => a
undefined

        MutableArray s k -> Int -> k -> ST s ()
forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s k
keys Int
0 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
0 v
v
        STRef s Int
ref <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
1
        (a, Maybe (Bucket s k v)) -> ST s (a, Maybe (Bucket s k v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
1, Bucket s k v -> Maybe (Bucket s k v)
forall a. a -> Maybe a
Just (Bucket s k v -> Maybe (Bucket s k v))
-> Bucket s k v -> Maybe (Bucket s k v)
forall a b. (a -> b) -> a -> b
$ Bucket_ s k v -> Bucket s k v
forall a. a -> Bucket s k v
toKey (Bucket_ s k v -> Bucket s k v) -> Bucket_ s k v -> Bucket s k v
forall a b. (a -> b) -> a -> b
$ Int
-> STRef s Int
-> MutableArray s k
-> MutableArray s v
-> Bucket_ s k v
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 =
        STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef ST s Int
-> (Int -> ST s (Int, Maybe (Bucket s k v)))
-> ST s (Int, Maybe (Bucket s 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
>>= 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bsz  = Int -> ST s (Int, Maybe (Bucket s k v))
forall {a}. Int -> ST s (Int, Maybe a)
bump Int
hw
          | Bool
otherwise = Int -> ST s (Int, Maybe (Bucket s k v))
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
          String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.snoc: bumping hw, bsz=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bsz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", hw="
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hw

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

        doublingThreshold :: Int
doublingThreshold = Int
bucketSplitSize Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
newBucketSize
                  | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
doublingThreshold = Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
                  | Bool
otherwise = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
growFactor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
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
            String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.snoc: spilling, old size=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bsz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", new size="
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz

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

            String -> ST s ()
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') = Bucket s k v -> Bucket_ s k v
forall a. Bucket s k v -> a
fromKey Bucket s k v
bk

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

            (Int, Maybe (Bucket s k v)) -> ST s (Int, Maybe (Bucket s k v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', Bucket s k v -> Maybe (Bucket s k v)
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 | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
b = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
       | Bool
otherwise = STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Bucket_ s (Bucket s k v) (Bucket s k v) -> STRef s Int
forall s k v. Bucket_ s k v -> STRef s Int
_highwater (Bucket_ s (Bucket s k v) (Bucket s k v) -> STRef s Int)
-> Bucket_ s (Bucket s k v) (Bucket s k v) -> STRef s Int
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s (Bucket s k v) (Bucket s k v)
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 | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = Maybe v -> ST s (Maybe v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
                    | Bool
otherwise = Bucket_ s k v -> ST s (Maybe v)
forall {s} {v}. Bucket_ s k v -> ST s (Maybe v)
lookup' (Bucket_ s k v -> ST s (Maybe v))
-> Bucket_ s k v -> ST s (Maybe v)
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int -> ST s (Maybe v)
go (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      where
        go :: Int -> ST s (Maybe v)
go !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe v -> ST s (Maybe v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
            | Bool
otherwise = 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
                if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'
                  then do
                    !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
                    Maybe v -> ST s (Maybe v)
forall a. a -> ST s a
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 Int -> ST s (Maybe v)
go (Int
iInt -> Int -> Int
forall 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
  | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = Maybe Int -> ST s (Maybe Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  | Bool
otherwise = Bucket_ s k (Bucket s k v) -> ST s (Maybe Int)
forall {s} {v}. Bucket_ s k v -> ST s (Maybe Int)
lookup' (Bucket_ s k (Bucket s k v) -> ST s (Maybe Int))
-> Bucket_ s k (Bucket s k v) -> ST s (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k (Bucket s k v)
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int -> ST s (Maybe Int)
go (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      where
        go :: Int -> ST s (Maybe Int)
go !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe Int -> ST s (Maybe Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            | Bool
otherwise = 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
                if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'
                  then Maybe Int -> ST s (Maybe Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i)
                  else Int -> ST s (Maybe Int)
go (Int
iInt -> Int -> Int
forall 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
  | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = Maybe (k, v) -> ST s (Maybe (k, v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (k, v)
forall a. Maybe a
Nothing
  | Bool
otherwise = Bucket_ s k v -> ST s (Maybe (k, v))
forall {s} {a} {b}. Bucket_ s a b -> ST s (Maybe (a, b))
lookup' (Bucket_ s k v -> ST s (Maybe (k, v)))
-> Bucket_ s k v -> ST s (Maybe (k, v))
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ix Bool -> Bool -> Bool
&& Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hw
          then do a
k <- MutableArray s a -> Int -> ST s a
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s a
keys Int
ix
                  b
v <- MutableArray s b -> Int -> ST s b
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s b
values Int
ix
                  Maybe (a, b) -> ST s (Maybe (a, b))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
k,b
v))
          else Maybe (a, b) -> ST s (Maybe (a, b))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
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 | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = [(k, v)] -> ST s [(k, v)]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                 | Bool
otherwise = Bucket_ s k v -> ST s [(k, v)]
forall {s} {k} {v}. Bucket_ s k v -> ST s [(k, v)]
toList' (Bucket_ s k v -> ST s [(k, v)]) -> Bucket_ s k v -> ST s [(k, v)]
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hw   = [(k, v)] -> ST s [(k, v)]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return [(k, v)]
l
                     | Bool
otherwise = 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
            [(k, v)] -> Int -> Int -> ST s [(k, v)]
go ((k
k,v
v)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
l) Int
hw (Int -> ST s [(k, v)]) -> Int -> ST s [(k, v)]
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall 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 = (Bucket s k v -> (k, v) -> ST s (Bucket s k v))
-> Bucket s k v -> [(k, v)] -> ST s (Bucket s k v)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Control.Monad.foldM Bucket s k v -> (k, v) -> ST s (Bucket s k v)
forall {k} {v} {s}. Bucket s k v -> (k, v) -> ST s (Bucket s k v)
f Bucket s k v
forall a. Bucket s k v
emptyRecord ([(k, v)] -> [(k, v)]
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) <- Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
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
        Bucket s k v -> ST s (Bucket s k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket s k v -> ST s (Bucket s k v))
-> Bucket s k v -> ST s (Bucket s k v)
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Maybe (Bucket s k v) -> Bucket s k v
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 | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = do
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.delete: empty bucket"
    Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                    | Bool
otherwise = do
    String -> ST s ()
forall s. String -> ST s ()
debug String
"Bucket.delete: start"
    Bucket_ s k (Bucket s k v) -> ST s Bool
forall {s} {v}. Bucket_ s k v -> ST s Bool
del (Bucket_ s k (Bucket s k v) -> ST s Bool)
-> Bucket_ s k (Bucket s k v) -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k (Bucket s k v)
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.delete: hw=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hw String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", sz=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz
        Int -> Int -> ST s Bool
go Int
hw (Int -> ST s Bool) -> Int -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Int
hw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

      where
        go :: Int -> Int -> ST s Bool
go !Int
hw !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  | Bool
otherwise = 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
            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 entry to delete at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
                  Int -> Int -> MutableArray s k -> ST s ()
forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i MutableArray s k
keys
                  Int -> Int -> MutableArray s v -> ST s ()
forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i MutableArray s v
values
                  let !hw' :: Int
hw' = Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
hwRef Int
hw'
                  Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              else Int -> Int -> ST s Bool
go Int
hw (Int
iInt -> Int -> Int
forall 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 = Bucket s k v
-> k
-> (Maybe v -> ST s (Maybe v, a))
-> ST s (Int, Maybe (Bucket s k v), a)
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, 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) =>
            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
    | Bucket s k v -> Bool
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 Maybe v
forall a. Maybe a
Nothing
        case (Maybe v, a)
fRes of
            (Maybe v
Nothing, a
a) -> (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Maybe (Bucket s k v)
forall a. Maybe a
Nothing, a
a)
            (Just v
v', a
a) -> do
                (!Int
hw', Maybe (Bucket s k v)
mbk) <- Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
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'
                (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
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' (Bucket_ s k v -> ST s (Int, Maybe (Bucket s k v), a))
-> Bucket_ s k v -> ST s (Int, Maybe (Bucket s k v), a)
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        Int
pos <- Int -> Int -> ST s Int
forall {t}. t -> Int -> ST s Int
findPosition Int
hw (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        Maybe v
mv <- do
            if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                then Maybe v -> ST s (Maybe v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
                else MutableArray s v -> Int -> ST s v
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s v
values Int
pos ST s v -> (v -> ST s (Maybe v)) -> ST s (Maybe 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
>>= Maybe v -> ST s (Maybe v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> ST s (Maybe v))
-> (v -> Maybe v) -> v -> ST s (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
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)) -> (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw, Maybe (Bucket s k v)
forall a. Maybe a
Nothing, a
a)
            (Maybe v
Nothing, (Just v
v', a
a)) -> do
                (!Int
hw', Maybe (Bucket s k v)
mbk) <- Bucket s k v -> k -> v -> ST s (Int, Maybe (Bucket s k v))
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'
                (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
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
                MutableArray s v -> Int -> v -> ST s ()
forall s a. MutableArray s a -> Int -> a -> ST s ()
writeArray MutableArray s v
values Int
pos v
v'
                (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw, Maybe (Bucket s k v)
forall a. Maybe a
Nothing, a
a)
            (Just v
_v, (Maybe v
Nothing, a
a)) -> do
                Int -> Int -> MutableArray s k -> ST s ()
forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
pos MutableArray s k
keys
                Int -> Int -> MutableArray s v -> ST s ()
forall s a. Int -> Int -> MutableArray s a -> ST s ()
move (Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
pos MutableArray s v
values
                let !hw' :: Int
hw' = Int
hwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
hwRef Int
hw'
                (Int, Maybe (Bucket s k v), a)
-> ST s (Int, Maybe (Bucket s k v), a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
hw', Maybe (Bucket s k v)
forall a. Maybe a
Nothing, a
a)
      where
        findPosition :: t -> Int -> ST s Int
findPosition !t
hw !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
            | Bool
otherwise = 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
                if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'
                  then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
                  else t -> Int -> ST s Int
findPosition t
hw (Int
iInt -> Int -> Int
forall 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
    | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = do
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.mapM_: bucket was empty"
        () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = Bucket_ s k v -> ST s ()
doMap (Bucket_ s k v -> ST s ()) -> Bucket_ s k v -> ST s ()
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
hwRef
        String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"Bucket.mapM_: hw was " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hw String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", sz was " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hw = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  | Bool
otherwise = 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
_ <- (k, v) -> ST s a
f (k
k,v
v)
            Int -> Int -> ST s ()
go Int
hw (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


------------------------------------------------------------------------------
{-# 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
    | Bucket s k v -> Bool
forall a. Bucket s k v -> Bool
keyIsEmpty Bucket s k v
bucketKey = a -> ST s a
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
seed0
    | Bool
otherwise = Bucket_ s k v -> ST s a
doMap (Bucket_ s k v -> ST s a) -> Bucket_ s k v -> ST s a
forall a b. (a -> b) -> a -> b
$ Bucket s k v -> Bucket_ s k v
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 <- STRef s Int -> ST s Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hw = a -> ST s a
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
seed
                        | Bool
otherwise = 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 -> Int -> ST s a
go Int
hw a
seed' (Int
iInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j    = do
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"move " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
    () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             | Bool
otherwise = do
    String -> ST s ()
forall s. String -> ST s ()
debug (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"move " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
    MutableArray s a -> Int -> ST s a
forall s a. MutableArray s a -> Int -> ST s a
readArray MutableArray s a
arr Int
i ST s a -> (a -> 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
>>= MutableArray s a -> Int -> a -> ST s ()
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
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
#endif