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

    {-| An implementation of linear hash tables. (See
    <http://en.wikipedia.org/wiki/Linear_hashing>). Use this hash table if you...

      * don't care that inserts and lookups are slower than the other hash table
        implementations in this collection (this one is slightly faster than
        @Data.HashTable@ from the base library in most cases)

      * have a soft real-time or interactive application for which the risk of
        introducing a long pause on insert while all of the keys are rehashed is
        unacceptable.

    /Details:/

    Linear hashing allows for the expansion of the hash table one slot at a time,
    by moving a \"split\" pointer across an array of pointers to buckets. The
    number of buckets is always a power of two, and the bucket to look in is
    defined as:

    @
    bucket(level,key) = hash(key) mod (2^level)
    @

    The \"split pointer\" controls the expansion of the hash table. If the hash
    table is at level @k@ (i.e. @2^k@ buckets have been allocated), we first
    calculate @b=bucket(level-1,key)@. If @b < splitptr@, the destination bucket is
    calculated as @b'=bucket(level,key)@, otherwise the original value @b@ is used.

    The split pointer is incremented once an insert causes some bucket to become
    fuller than some predetermined threshold; the bucket at the split pointer
    (*not* the bucket which triggered the split!) is then rehashed, and half of its
    keys can be expected to be rehashed into the upper half of the table.

    When the split pointer reaches the middle of the bucket array, the size of the
    bucket array is doubled, the level increases, and the split pointer is reset to
    zero.

    Linear hashing, although not quite as fast for inserts or lookups as the
    implementation of linear probing included in this package, is well suited for
    interactive applications because it has much better worst case behaviour on
    inserts. Other hash table implementations can suffer from long pauses, because
    it is occasionally necessary to rehash all of the keys when the table grows.
    Linear hashing, on the other hand, only ever rehashes a bounded (effectively
    constant) number of keys when an insert forces a bucket split.

    /Space overhead: experimental results/

    In randomized testing (see @test\/compute-overhead\/ComputeOverhead.hs@ in the
    source distribution), mean overhead is approximately 1.51 machine words per
    key-value mapping with a very low standard deviation of about 0.06 words, 1.60
    words per mapping at the 95th percentile.

    /Unsafe tricks/

    Then the @unsafe-tricks@ flag is on when this package is built (and it is on by
    default), we use some unsafe tricks (namely 'unsafeCoerce#' and
    'reallyUnsafePtrEquality#') to save indirections in this table. These
    techniques rely on assumptions about the behaviour of the GHC runtime system
    and, although they've been tested and should be safe under normal conditions,
    are slightly dangerous. Caveat emptor. In particular, these techniques are
    incompatible with HPC code coverage reports.

    References:

      * W. Litwin. Linear hashing: a new tool for file and table addressing. In
        /Proc. 6th International Conference on Very Large Data Bases, Volume 6/,
        pp. 212-223, 1980.

      * P-A. Larson. Dynamic hash tables. /Communications of the ACM/ 31:
        446-457, 1988.
    -}

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

    ------------------------------------------------------------------------------
    #if !MIN_VERSION_base(4,8,0)
    import           Control.Applicative
    import           Data.Word
    #endif
    import           Control.Monad                         hiding (foldM, mapM_)
    import           Control.Monad.ST
    import           Data.Bits
    import           Data.Hashable
    import           Data.STRef
    import           Prelude                               hiding (lookup, mapM_)
    ------------------------------------------------------------------------------
    import qualified Data.HashTable.Class                  as C
    import           Data.HashTable.Internal.Array
    import           Data.HashTable.Internal.Linear.Bucket (Bucket)
    import qualified Data.HashTable.Internal.Linear.Bucket as Bucket
    import           Data.HashTable.Internal.Utils

    #ifdef DEBUG
    import           System.IO
    #endif

    ------------------------------------------------------------------------------
    -- | A linear hash table.
    newtype HashTable s k v = HT (STRef s (HashTable_ s k v))

    data HashTable_ s k v = HashTable
        { forall s k v. HashTable_ s k v -> Int
    _level    :: {-# UNPACK #-} !Int
        , forall s k v. HashTable_ s k v -> Int
    _splitptr :: {-# UNPACK #-} !Int
        , forall s k v. HashTable_ s k v -> MutableArray s (Bucket s k v)
    _buckets  :: {-# UNPACK #-} !(MutableArray s (Bucket s k 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>"

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:new".
    new :: ST s (HashTable s k v)
    new :: forall s k v. ST s (HashTable s k v)
    new = do
        v <- Int -> ST s (MutableArray s (Bucket s k v))
    forall s k v. Int -> ST s (MutableArray s (Bucket s k v))
    Bucket.newBucketArray Int
    2
        newRef $ HashTable 1 0 v

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:newSized".
    newSized :: Int -> ST s (HashTable s k v)
    newSized :: forall s k v. Int -> ST s (HashTable s k v)
    newSized Int
    n = do
        v <- Int -> ST s (MutableArray s (Bucket s k v))
    forall s k v. Int -> ST s (MutableArray s (Bucket s k v))
    Bucket.newBucketArray Int
    sz
        newRef $ HashTable lvl 0 v

      where
        k :: Word
    k   = Double -> Word
    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. Num a => a -> a -> a
    * Double
    fillFactor Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bucketSplitSize)
        lvl :: Int
    lvl = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Int -> Int
    forall a. Enum a => a -> Int
    fromEnum (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Word -> Int
    log2 Word
    k)
        sz :: Int
    sz  = Int -> Int
    power2 Int
    lvl

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:delete".
    delete :: (Hashable k, Eq k) =>
              (HashTable s k v)
           -> k
           -> ST s ()
    delete :: forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s ()
    delete HashTable s k v
    htRef !k
    k = 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 ()
    forall {s} {k} {v}. HashTable_ s k v -> ST s ()
    work
      where
        work :: HashTable_ s k v -> ST s ()
    work (HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
            let !h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
            String -> ST s ()
    forall s. String -> ST s ()
    debug (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "delete: size=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int -> Int
    power2 Int
    lvl) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", h0=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    h0
                      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "splitptr: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    splitptr
            MutableArray s (Bucket s k v) -> Int -> k -> ST s ()
    forall k s v.
    Eq k =>
    MutableArray s (Bucket s k v) -> Int -> k -> ST s ()
    delete' MutableArray s (Bucket s k v)
    buckets Int
    h0 k
    k
    {-# INLINE delete #-}

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:lookup".
    lookup :: (Eq k, Hashable k) => (HashTable s k v) -> k -> ST s (Maybe v)
    lookup :: forall k s v.
    (Eq k, Hashable k) =>
    HashTable s k v -> k -> ST s (Maybe v)
    lookup HashTable s k v
    htRef !k
    k = 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 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
    >>= HashTable_ s k v -> ST s (Maybe v)
    forall {s} {k} {v} {v}. HashTable_ s k v -> ST s (Maybe v)
    work
      where
        work :: HashTable_ s k v -> ST s (Maybe v)
    work (HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
            let h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
            bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h0
            Bucket.lookup bucket k
    {-# INLINE lookup #-}

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:insert".
    insert :: (Eq k, Hashable k) =>
              (HashTable s k v)
           -> k
           -> v
           -> ST s ()
    insert :: forall k s v.
    (Eq k, Hashable k) =>
    HashTable s k v -> k -> v -> ST s ()
    insert HashTable s k v
    htRef k
    k v
    v = do
        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 ST s (HashTable_ s k v)
    -> (HashTable_ s k v -> ST s (HashTable_ s k v))
    -> ST s (HashTable_ 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
    >>= HashTable_ s k v -> ST s (HashTable_ s k v)
    forall {k} {s} {v}.
    Hashable k =>
    HashTable_ s k v -> ST s (HashTable_ s k v)
    work
        writeRef htRef ht'
      where
        work :: HashTable_ s k v -> ST s (HashTable_ s k v)
    work ht :: HashTable_ s k v
    ht@(HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
            let !h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
            MutableArray s (Bucket s k v) -> Int -> k -> ST s ()
    forall k s v.
    Eq k =>
    MutableArray s (Bucket s k v) -> Int -> k -> ST s ()
    delete' MutableArray s (Bucket s k v)
    buckets Int
    h0 k
    k
            bsz <- MutableArray s (Bucket s k v) -> Int -> k -> v -> ST s Int
    forall s k v.
    MutableArray s (Bucket s k v) -> Int -> k -> v -> ST s Int
    primitiveInsert' MutableArray s (Bucket s k v)
    buckets Int
    h0 k
    k v
    v

            if checkOverflow bsz
              then do
                debug $ "insert: splitting"
                h <- split ht
                debug $ "insert: done splitting"
                return h
              else do
                debug $ "insert: done"
                return ht
    {-# 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, a) <- 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 (HashTable_ s k v, a))
    -> ST s (HashTable_ s k v, 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 (HashTable_ s k v, a)
    forall {k} {v}.
    Hashable k =>
    HashTable_ s k v -> ST s (HashTable_ s k v, a)
    work
        writeRef htRef ht
        return a
      where
        work :: HashTable_ s k v -> ST s (HashTable_ s k v, a)
    work ht :: HashTable_ s k v
    ht@(HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
            let !h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
            bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h0
            (!bsz, mbk, a) <- Bucket.mutateST bucket k f
            maybe (return ())
                  (writeArray buckets h0)
                  mbk
            if checkOverflow bsz
              then do
                ht' <- split ht
                return (ht', a)
              else return (ht, a)

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:mapM_".
    mapM_ :: ((k,v) -> ST s b) -> HashTable s k v -> ST s ()
    mapM_ :: forall k v s b. ((k, v) -> ST s b) -> HashTable s k v -> ST s ()
    mapM_ (k, v) -> ST s b
    f HashTable s k v
    htRef = 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 ()
    forall {k} {v}. HashTable_ s k v -> ST s ()
    work
      where
        work :: HashTable_ s k v -> ST s ()
    work (HashTable Int
    lvl Int
    _ MutableArray s (Bucket s k v)
    buckets) = Int -> ST s ()
    go Int
    0
          where
            !sz :: Int
    sz = Int -> Int
    power2 Int
    lvl

            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
                b <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    i
                Bucket.mapM_ f b
                go $ i+1

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:foldM".
    foldM :: (a -> (k,v) -> ST s a)
          -> a -> HashTable s k v
          -> ST s a
    foldM :: forall a k v s.
    (a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
    foldM a -> (k, v) -> ST s a
    f a
    seed0 HashTable s k v
    htRef = 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
    forall {k} {v}. HashTable_ s k v -> ST s a
    work
      where
        work :: HashTable_ s k v -> ST s a
    work (HashTable Int
    lvl Int
    _ MutableArray s (Bucket s k v)
    buckets) = a -> Int -> ST s a
    go a
    seed0 Int
    0
          where
            !sz :: Int
    sz = Int -> Int
    power2 Int
    lvl

            go :: a -> Int -> ST s a
    go !a
    seed !Int
    i | 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
                b <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    i
                !seed' <- Bucket.foldM f seed b
                go seed' $ i+1

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:computeOverhead".
    computeOverhead :: HashTable s k v -> ST s Double
    computeOverhead :: forall s k v. HashTable s k v -> ST s Double
    computeOverhead HashTable s k v
    htRef = 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
    lvl Int
    _ MutableArray s (Bucket s k v)
    buckets) = do
            (totElems, overhead) <- Int -> Int -> Int -> ST s (Int, Int)
    go Int
    0 Int
    0 Int
    0

            let n = Int -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    totElems
            let o = Int -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    overhead

            return $ (fromIntegral sz + constOverhead + o) / n

          where
            constOverhead :: b
    constOverhead = b
    5.0

            !sz :: Int
    sz = Int -> Int
    power2 Int
    lvl

            go :: Int -> Int -> Int -> ST s (Int, Int)
    go !Int
    nelems !Int
    overhead !Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sz = (Int, Int) -> ST s (Int, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    nelems, Int
    overhead)
                                    | Bool
    otherwise = do
                b <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    i
                (!n,!o) <- Bucket.nelemsAndOverheadInWords b
                let !n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    nelems
                let !o' = Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    overhead

                go n' o' (i+1)

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

    ------------------------------------------------------------------------------
    delete' :: Eq k =>
               MutableArray s (Bucket s k v)
            -> Int
            -> k
            -> ST s ()
    delete' :: forall k s v.
    Eq k =>
    MutableArray s (Bucket s k v) -> Int -> k -> ST s ()
    delete' MutableArray s (Bucket s k v)
    buckets Int
    h0 k
    k = do
        bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h0
        _ <- Bucket.delete bucket k
        return ()

    ------------------------------------------------------------------------------
    split :: (Hashable k) =>
             (HashTable_ s k v)
          -> ST s (HashTable_ s k v)
    split :: forall {k} {s} {v}.
    Hashable k =>
    HashTable_ s k v -> ST s (HashTable_ s k v)
    split ht :: HashTable_ s k v
    ht@(HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
        String -> ST s ()
    forall s. String -> ST s ()
    debug (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "split: start: nbuck=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int -> Int
    power2 Int
    lvl)
                  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", splitptr=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    splitptr

        -- grab bucket at splitPtr
        oldBucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    splitptr

        nelems <- Bucket.size oldBucket
        let !bsz = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    Bucket.newBucketSize (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 (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ (Double
    0.625 :: Double) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    nelems

        -- write an empty bucket there
        dbucket1 <- Bucket.emptyWithSize bsz
        writeArray buckets splitptr dbucket1

        -- grow the buckets?
        let lvl2 = Int -> Int
    power2 Int
    lvl
        let lvl1 = Int -> Int
    power2 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    lvlInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1

        (!buckets',!lvl',!sp') <-
            if splitptr+1 >= lvl1
              then do
                debug $ "split: resizing bucket array"
                let lvl3 = Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    lvl2
                b <- Bucket.expandBucketArray lvl3 lvl2 buckets
                debug $ "split: resizing bucket array: done"
                return (b,lvl+1,0)
              else return (buckets,lvl,splitptr+1)

        let ht' = Int -> Int -> MutableArray s (Bucket s k v) -> HashTable_ s k v
    forall s k v.
    Int -> Int -> MutableArray s (Bucket s k v) -> HashTable_ s k v
    HashTable Int
    lvl' Int
    sp' MutableArray s (Bucket s k v)
    buckets'

        -- make sure the other split bucket has enough room in it also
        let splitOffs = Int
    splitptr Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lvl1
        db2   <- readArray buckets' splitOffs
        db2sz <- Bucket.size db2
        let db2sz' = Int
    db2sz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bsz
        db2'  <- Bucket.growBucketTo db2sz' db2
        debug $ "growing bucket at " ++ show splitOffs ++ " to size "
                  ++ show db2sz'
        writeArray buckets' splitOffs db2'

        -- rehash old bucket
        debug $ "split: rehashing bucket"
        let f = (k -> b -> ST s Int) -> (k, b) -> ST s Int
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((k -> b -> ST s Int) -> (k, b) -> ST s Int)
    -> (k -> b -> ST s Int) -> (k, b) -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ HashTable_ s k b -> k -> b -> ST s Int
    forall k s v. Hashable k => HashTable_ s k v -> k -> v -> ST s Int
    primitiveInsert HashTable_ s k b
    forall {k} {v}. HashTable_ s k v
    ht'
        forceSameType f (uncurry $ primitiveInsert ht)

        Bucket.mapM_ f oldBucket
        debug $ "split: done"
        return ht'

    ------------------------------------------------------------------------------
    checkOverflow :: Int -> Bool
    checkOverflow :: Int -> Bool
    checkOverflow Int
    sz = Int
    sz Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    bucketSplitSize

    ------------------------------------------------------------------------------
    -- insert w/o splitting
    primitiveInsert :: (Hashable k) =>
                       (HashTable_ s k v)
                    -> k
                    -> v
                    -> ST s Int
    primitiveInsert :: forall k s v. Hashable k => HashTable_ s k v -> k -> v -> ST s Int
    primitiveInsert (HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) k
    k v
    v = do
        String -> ST s ()
    forall s. String -> ST s ()
    debug (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "primitiveInsert start: nbuckets=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int -> Int
    power2 Int
    lvl)
        let h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
        MutableArray s (Bucket s k v) -> Int -> k -> v -> ST s Int
    forall s k v.
    MutableArray s (Bucket s k v) -> Int -> k -> v -> ST s Int
    primitiveInsert' MutableArray s (Bucket s k v)
    buckets Int
    h0 k
    k v
    v

    ------------------------------------------------------------------------------
    primitiveInsert' :: MutableArray s (Bucket s k v)
                     -> Int
                     -> k
                     -> v
                     -> ST s Int
    primitiveInsert' :: forall s k v.
    MutableArray s (Bucket s k v) -> Int -> k -> v -> ST s Int
    primitiveInsert' MutableArray s (Bucket s k v)
    buckets !Int
    h0 !k
    k !v
    v = do
        String -> ST s ()
    forall s. String -> ST s ()
    debug (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "primitiveInsert': bucket number=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    h0
        bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h0
        debug $ "primitiveInsert': snoccing bucket"
        (!hw,m) <- Bucket.snoc bucket k v
        debug $ "primitiveInsert': bucket snoc'd"
        maybe (return ())
              (writeArray buckets h0)
              m
        return hw

    ------------------------------------------------------------------------------
    fillFactor :: Double
    fillFactor :: Double
    fillFactor = Double
    1.3

    ------------------------------------------------------------------------------
    bucketSplitSize :: Int
    bucketSplitSize :: Int
    bucketSplitSize = Int
    Bucket.bucketSplitSize

    ------------------------------------------------------------------------------
    {-# INLINE power2 #-}
    power2 :: Int -> Int
    power2 :: Int -> Int
    power2 Int
    i = Int
    1 Int -> Int -> Int
    `iShiftL` Int
    i

    ------------------------------------------------------------------------------
    {-# INLINE hashKey #-}
    hashKey :: (Hashable k) => Int -> Int -> k -> Int
    hashKey :: forall k. Hashable k => Int -> Int -> k -> Int
    hashKey !Int
    lvl !Int
    splitptr !k
    k = Int
    h1
      where
        !h0 :: Int
    h0 = Int -> k -> Int
    forall k. Hashable k => Int -> k -> Int
    hashAtLvl (Int
    lvlInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) k
    k
        !h1 :: Int
    h1 = if (Int
    h0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    splitptr)
                then Int -> k -> Int
    forall k. Hashable k => Int -> k -> Int
    hashAtLvl Int
    lvl k
    k
                else Int
    h0

    ------------------------------------------------------------------------------
    {-# INLINE hashAtLvl #-}
    hashAtLvl :: (Hashable k) => Int -> k -> Int
    hashAtLvl :: forall k. Hashable k => Int -> k -> Int
    hashAtLvl !Int
    lvl !k
    k = Int
    h
      where
        !h :: Int
    h        = Int
    hashcode Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    mask
        !hashcode :: Int
    hashcode = k -> Int
    forall a. Hashable a => a -> Int
    hash k
    k
        !mask :: Int
    mask     = Int -> Int
    power2 Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

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

    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

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

    ------------------------------------------------------------------------------
    -- | See the documentation for this function in
    -- "Data.HashTable.Class#v:lookupIndex".
    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 = 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)) -> ST s (Maybe Word)
    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)
    forall {s} {k} {v}. HashTable_ s k v -> ST s (Maybe Word)
    work
      where
        work :: HashTable_ s k v -> ST s (Maybe Word)
    work (HashTable Int
    lvl Int
    splitptr MutableArray s (Bucket s k v)
    buckets) = do
            let h0 :: Int
    h0 = Int -> Int -> k -> Int
    forall k. Hashable k => Int -> Int -> k -> Int
    hashKey Int
    lvl Int
    splitptr k
    k
            bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h0
            mbIx <- Bucket.lookupIndex bucket k
            return $! do ix <- mbIx
                         Just $! encodeIndex lvl h0 ix
    {-# INLINE lookupIndex #-}

    encodeIndex :: Int -> Int -> Int -> Word
    encodeIndex :: Int -> Int -> Int -> Word
    encodeIndex Int
    lvl Int
    bucketIx Int
    elemIx =
      Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bucketIx Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `Data.Bits.shiftL` Int -> Int
    indexOffset Int
    lvl Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .|.
      Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    elemIx
    {-# INLINE encodeIndex #-}

    decodeIndex :: Int -> Word -> (Int, Int)
    decodeIndex :: Int -> Word -> (Int, Int)
    decodeIndex Int
    lvl Word
    ix =
      ( Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    ix Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `Data.Bits.shiftR` Int
    offset)
      , Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ( (Int -> Word
    forall a. Bits a => Int -> a
    bit Int
    offset Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    1) Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .&. Word
    ix )
      )
      where offset :: Int
    offset = Int -> Int
    indexOffset Int
    lvl
    {-# INLINE decodeIndex #-}

    indexOffset :: Int -> Int
    indexOffset :: Int -> Int
    indexOffset Int
    lvl = Word -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize (Word
    0 :: Word) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    lvl
    {-# INLINE indexOffset #-}

    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
    k = 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 {s} {k} {v} {b} {c}.
    HashTable_ s k v -> ST s (Maybe (Word, b, c))
    work
      where
        work :: HashTable_ s k v -> ST s (Maybe (Word, b, c))
    work (HashTable Int
    lvl Int
    _ MutableArray s (Bucket s k v)
    buckets) = do
            let (Int
    h0,Int
    ix) = Int -> Word -> (Int, Int)
    decodeIndex Int
    lvl Word
    k
            Int -> Int -> ST s (Maybe (Word, b, c))
    forall {b} {c}. Int -> Int -> ST s (Maybe (Word, b, c))
    go Int
    h0 Int
    ix

          where
            bucketN :: Int
    bucketN = Int -> Int
    power2 Int
    lvl
            go :: Int -> Int -> ST s (Maybe (Word, b, c))
    go Int
    h Int
    ix
              | Int
    h Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 Bool -> Bool -> Bool
    || Int
    bucketN Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    h = Maybe (Word, b, c) -> ST s (Maybe (Word, b, c))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Word, b, c)
    forall a. Maybe a
    Nothing
              | Bool
    otherwise = do
                  bucket <- MutableArray s (Bucket s k v) -> Int -> ST s (Bucket s k v)
    forall s a. MutableArray s a -> Int -> ST s a
    readArray MutableArray s (Bucket s k v)
    buckets Int
    h
                  mb     <- Bucket.elemAt bucket ix
                  case mb of
                    Just (b
    k',c
    v) ->
                      let !ix' :: Word
    ix' = Int -> Int -> Int -> Word
    encodeIndex Int
    lvl Int
    h Int
    ix
                      in Maybe (Word, b, c) -> ST s (Maybe (Word, b, c))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Word, b, c) -> Maybe (Word, b, c)
    forall a. a -> Maybe a
    Just (Word
    ix', b
    k', c
    v))
                    Maybe (b, c)
    Nothing -> Int -> Int -> ST s (Maybe (Word, b, c))
    go (Int
    hInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    0

    {-# INLINE nextByIndex #-}