{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedDatatypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}

-- | Mutable hash sets that preserve insertion order.
module Mikan.Utils.HashSet.Ordered
  ( HashSet
    -- * Size and capacity
  , size
  , capacity
    -- * Creation
  , new
    -- * Insertion
  , insertingIfAbsent
    -- * Indexing
  , index
    -- * Conversion
  , toArray
  ) where

import Data.Primitive.Array qualified as A

import GHC.Base

import Mikan.Utils.IntVar
import Mikan.Utils.MinimalArray.Lifted qualified as AL

-- We need the machines word length to use MutableByteArray#
-- as an unboxed int reference.
#include "MachDeps.h"

-- | A hash set that preserves insertion order.
data HashSet a = HashSet (MVar# RealWorld (HashSet# a))

-- | A 'HashSet#' is an unlifted, open-addressing hash set.
--
-- The capacity of a 'HashSet#' is fixed throughout its lifetime, and is
-- always a power of two.
type HashSet# :: Type -> UnliftedType
data HashSet# a = HashSet#
  { forall a. HashSet# a -> MutableByteArray# RealWorld
indices :: !(MutableByteArray# RealWorld)
  -- ^ An array mapping hashes (modulo table size) to their indices in
  -- the 'hashCodes' and 'entries' arrays.
  -- If a hash is not present in the table, it should be mapped to a
  -- negative number (see 'isUnoccupied#').

  , forall a. HashSet# a -> MutableByteArray# RealWorld
hashCodes :: !(MutableByteArray# RealWorld)
  -- ^ Dense array of hash codes.

  , forall a. HashSet# a -> MutableArray# RealWorld a
entries :: !(MutableArray# RealWorld a)
  -- ^ Dense array of elements.

  , forall a. HashSet# a -> IntVar# RealWorld
numEntries :: !(IntVar# RealWorld)
  -- ^ The number of elements present in the HashSet.
  }

--------------------------------------------------------------------------------
-- Size and capacity

-- | Get the number of elements currently stored in the 'HashSet'.
size :: HashSet a -> IO Int
size :: forall a. HashSet a -> IO Int
size HashSet a
hashSet = (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ HashSet a
-> (HashSet# a -> State# RealWorld -> (# State# RealWorld, Int #))
-> State# RealWorld
-> (# State# RealWorld, Int #)
forall a r.
HashSet a
-> (HashSet# a -> State# RealWorld -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
peekHashSet# HashSet a
hashSet \HashSet# a
hashSet State# RealWorld
s0 ->
  case HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall a.
HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
size# HashSet# a
hashSet State# RealWorld
s0 of
    (# State# RealWorld
s1, Int#
n #) -> (# State# RealWorld
s1, Int# -> Int
I# Int#
n #)

{-# INLINE size# #-}
-- | Get the number of elements currently stored in an 'HashSet#'.
size# :: HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
size# :: forall a.
HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
size# HashSet#{IntVar# RealWorld
numEntries :: forall a. HashSet# a -> IntVar# RealWorld
numEntries :: IntVar# RealWorld
numEntries} State# RealWorld
s0 = IntVar# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall s. IntVar# s -> State# s -> (# State# s, Int# #)
readIntVar# IntVar# RealWorld
numEntries State# RealWorld
s0

-- | Get the current capacity of an 'HashSet'.
capacity :: HashSet a -> IO Int
capacity :: forall a. HashSet a -> IO Int
capacity HashSet a
hashSet = (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ HashSet a
-> (HashSet# a -> State# RealWorld -> (# State# RealWorld, Int #))
-> State# RealWorld
-> (# State# RealWorld, Int #)
forall a r.
HashSet a
-> (HashSet# a -> State# RealWorld -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
peekHashSet# HashSet a
hashSet \HashSet# a
hashSet State# RealWorld
s0 ->
  (# State# RealWorld
s0, Int# -> Int
I# (HashSet# a -> Int#
forall a. HashSet# a -> Int#
capacity# HashSet# a
hashSet) #)

{-# INLINE capacity# #-}
-- | Get the capacity of an 'HashSet#'.
capacity# :: HashSet# a -> Int#
capacity# :: forall a. HashSet# a -> Int#
capacity# HashSet#{MutableArray# RealWorld a
entries :: forall a. HashSet# a -> MutableArray# RealWorld a
entries :: MutableArray# RealWorld a
entries} = MutableArray# RealWorld a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# MutableArray# RealWorld a
entries

{-# INLINE capacityMask# #-}
-- | Our table sizes are always of the form @2^n@, so we can mod our indices into the table by
--  masking off only the lower @n@ bits.
capacityMask# :: Int# -> Int#
capacityMask# :: Int# -> Int#
capacityMask# Int#
cap = Int#
cap Int# -> Int# -> Int#
-# Int#
1#

--------------------------------------------------------------------------------
-- Creation

{-# INLINE new #-}
-- | Create an 'HashSet' with a specified starting capacity.
new :: Int -> IO (HashSet a)
new :: forall a. Int -> IO (HashSet a)
new (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, HashSet a #))
-> IO (HashSet a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s0 ->
  case Int#
-> State# RealWorld
-> (# State# RealWorld, MVar# RealWorld (HashSet# a) #)
forall a.
Int#
-> State# RealWorld
-> (# State# RealWorld, MVar# RealWorld (HashSet# a) #)
new# Int#
n State# RealWorld
s0 of
    (# State# RealWorld
s1, MVar# RealWorld (HashSet# a)
lock #) -> (# State# RealWorld
s1, MVar# RealWorld (HashSet# a) -> HashSet a
forall a. MVar# RealWorld (HashSet# a) -> HashSet a
HashSet MVar# RealWorld (HashSet# a)
lock #)

{-# INLINABLE new# #-}
-- | Create a fresh 'HashSet#' locked behind an 'MVar#' with a specified starting capacity.
new# :: Int# -> State# RealWorld -> (# State# RealWorld, MVar# RealWorld (HashSet# a) #)
new# :: forall a.
Int#
-> State# RealWorld
-> (# State# RealWorld, MVar# RealWorld (HashSet# a) #)
new# Int#
n State# RealWorld
s0 =
  let
    -- Round up the capacity to the next power of two.
    !cap :: Int#
cap = Int#
1# Int# -> Int# -> Int#
`iShiftL#` (Word# -> Int#
word2Int# (WORD_SIZE_IN_BITS## `minusWord#` clz# (int2Word# n `minusWord#` 1##)))
    !capBytes :: Int#
capBytes = Int#
cap Int# -> Int# -> Int#
*# SIZEOF_HSINT#

    -- Allocate the indices array and set it to all ones, which will
    -- result in all entries reading as unoccupied
    !(# State# RealWorld
s1, MutableByteArray# RealWorld
indices #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
capBytes State# RealWorld
s0
    !s2 :: State# RealWorld
s2 = MutableByteArray# RealWorld
-> Int# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
setByteArray# MutableByteArray# RealWorld
indices Int#
0# Int#
capBytes Int#
-1# State# RealWorld
s1

    -- Allocate the storage arrays
    !(# State# RealWorld
s3, MutableByteArray# RealWorld
hashCodes #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
capBytes State# RealWorld
s2
    !(# State# RealWorld
s4, MutableArray# RealWorld a
entries #)   = Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, MutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
cap a
forall a. a
unoccupied State# RealWorld
s3

    -- Allocate the length counter
    !(# State# RealWorld
s5, IntVar# RealWorld
numEntries #) = Int#
-> State# RealWorld -> (# State# RealWorld, IntVar# RealWorld #)
forall s. Int# -> State# s -> (# State# s, IntVar# s #)
newIntVar# Int#
0# State# RealWorld
s4

    !(# State# RealWorld
s6, MVar# RealWorld (HashSet# a)
lock #) = State# RealWorld
-> (# State# RealWorld, MVar# RealWorld (HashSet# a) #)
forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# RealWorld
s5
    !s7 :: State# RealWorld
s7 = MVar# RealWorld (HashSet# a)
-> HashSet# a -> State# RealWorld -> State# RealWorld
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# RealWorld (HashSet# a)
lock HashSet#{MutableArray# RealWorld a
MutableByteArray# RealWorld
IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
..} State# RealWorld
s6
  in (# State# RealWorld
s7, MVar# RealWorld (HashSet# a)
lock #)

--------------------------------------------------------------------------------
-- Resizing

{-# INLINE maybeResize# #-}
-- | Allocate a larger 'HashSet#' if necessary.
--
-- The argument to 'maybeResize#' should not be used afterwards.
maybeResize#
  :: (Eq a)
  => HashSet# a
  -> State# RealWorld
  -> (# State# RealWorld, HashSet# a #)
maybeResize# :: forall a.
Eq a =>
HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
maybeResize# hashSet :: HashSet# a
hashSet@HashSet#{MutableArray# RealWorld a
MutableByteArray# RealWorld
IntVar# RealWorld
indices :: forall a. HashSet# a -> MutableByteArray# RealWorld
hashCodes :: forall a. HashSet# a -> MutableByteArray# RealWorld
entries :: forall a. HashSet# a -> MutableArray# RealWorld a
numEntries :: forall a. HashSet# a -> IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
..} State# RealWorld
s0 =
  let !cap :: Int#
cap = MutableArray# RealWorld a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# MutableArray# RealWorld a
entries
      !(# State# RealWorld
s1, Int#
len #) = IntVar# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall s. IntVar# s -> State# s -> (# State# s, Int# #)
readIntVar# IntVar# RealWorld
numEntries State# RealWorld
s0
  -- Max load factor of 75%.
  in if Int# -> Bool
isTrue# (Int#
4# Int# -> Int# -> Int#
*# Int#
len Int# -> Int# -> Int#
<# Int#
3# Int# -> Int# -> Int#
*# Int#
cap) then
    (# State# RealWorld
s1, HashSet# a
hashSet #)
  else
    HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
forall a.
Eq a =>
HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
resizePool# HashSet# a
hashSet State# RealWorld
s1

{-# INLINABLE resizePool# #-}
-- | Allocate a larger 'HashSet#', and copy over all of the entries.
--
-- The argument to 'resize#' should not be used afterwards.
resizePool#
  :: (Eq a)
  => HashSet# a
  -> State# RealWorld
  -> (# State# RealWorld, HashSet# a #)
resizePool# :: forall a.
Eq a =>
HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
resizePool# hashSet :: HashSet# a
hashSet@HashSet#{MutableArray# RealWorld a
MutableByteArray# RealWorld
IntVar# RealWorld
indices :: forall a. HashSet# a -> MutableByteArray# RealWorld
hashCodes :: forall a. HashSet# a -> MutableByteArray# RealWorld
entries :: forall a. HashSet# a -> MutableArray# RealWorld a
numEntries :: forall a. HashSet# a -> IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
..} State# RealWorld
s0 =
  let
    !cap :: Int#
cap = MutableArray# RealWorld a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# MutableArray# RealWorld a
entries
    -- Our growth factor doubles the size of the hashSet.
    !newCap :: Int#
newCap = Int#
cap Int# -> Int# -> Int#
`iShiftL#` Int#
1#
    !newCapBytes :: Int#
newCapBytes = Int#
newCap Int# -> Int# -> Int#
*# SIZEOF_HSINT#
    !newMask :: Int#
newMask = Int# -> Int#
capacityMask# Int#
newCap

    -- Allocate the new index array and mark all the entries within as
    -- unused.
    --
    -- We don't want to use 'resizeMutableByteArray#' here, as this
    -- could cause aliasing problems when re-keying.
    !(# State# RealWorld
s1, MutableByteArray# RealWorld
newIndices #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
newCapBytes State# RealWorld
s0
    !s2 :: State# RealWorld
s2 = MutableByteArray# RealWorld
-> Int# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
setByteArray# MutableByteArray# RealWorld
newIndices Int#
0# Int#
newCapBytes Int#
-1# State# RealWorld
s1

    -- Similarly, we want to resize the storage arrays, as we are going
    -- to be performing compaction.
    !(# State# RealWorld
s3, MutableByteArray# RealWorld
newHashCodes #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
newCapBytes State# RealWorld
s2
    !(# State# RealWorld
s4, MutableArray# RealWorld a
newEntries #) = Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, MutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
newCap a
forall a. a
unoccupied State# RealWorld
s3

    !(# State# RealWorld
s5, Int#
len #) = IntVar# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall s. IntVar# s -> State# s -> (# State# s, Int# #)
readIntVar# IntVar# RealWorld
numEntries State# RealWorld
s4
    newHashSet :: HashSet# a
newHashSet = HashSet#
      { indices :: MutableByteArray# RealWorld
indices   = MutableByteArray# RealWorld
newIndices
      , hashCodes :: MutableByteArray# RealWorld
hashCodes = MutableByteArray# RealWorld
newHashCodes
      , entries :: MutableArray# RealWorld a
entries   = MutableArray# RealWorld a
newEntries
      , IntVar# RealWorld
numEntries :: IntVar# RealWorld
numEntries :: IntVar# RealWorld
numEntries
      }

    -- Now loop over all the present indices in the old table and copy
    -- them into the new table. We can use 'findIndexCps#' to compute
    -- the slot in the 'indices' which should be filled with the new
    -- index.
    rekey :: Int# -> State# RealWorld -> State# RealWorld
rekey Int#
i State# RealWorld
s0 | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
len) =
      let
        !(# State# RealWorld
s1, a
ai #) = MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
entries Int#
i State# RealWorld
s0
        !(# State# RealWorld
s2, Int#
hi #) = MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# RealWorld
hashCodes Int#
i State# RealWorld
s1
      in HashSet# a
-> a
-> Int#
-> State# RealWorld
-> (a -> Int# -> State# RealWorld -> State# RealWorld)
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
forall a r.
Eq a =>
HashSet# a
-> a
-> Int#
-> State# RealWorld
-> (a -> Int# -> State# RealWorld -> r)
-> (Int# -> State# RealWorld -> r)
-> r
findIndexCps# HashSet# a
newHashSet a
ai Int#
hi State# RealWorld
s2
        -- Impossible; there's no way that we've already got something in the hashSet
        -- that matches. Just bail out ASAP.
        (\a
_ Int#
_ State# RealWorld
s -> State# RealWorld
s)
        (\Int#
j State# RealWorld
s3 ->
          let
            -- the slot we computed points to the index, which doesn't
            -- change while resizing; the element and its hash code are
            -- written in the new arrays.
            !s4 :: State# RealWorld
s4 = MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
newIndices   Int#
j Int#
i  State# RealWorld
s3
            !s5 :: State# RealWorld
s5 = MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
newHashCodes Int#
i Int#
hi State# RealWorld
s4
            !s6 :: State# RealWorld
s6 = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray#    MutableArray# RealWorld a
newEntries   Int#
i a
ai State# RealWorld
s5
          in Int# -> State# RealWorld -> State# RealWorld
rekey (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s6)
    rekey Int#
i State# RealWorld
s0 = State# RealWorld
s0

    !s6 :: State# RealWorld
s6 = Int# -> State# RealWorld -> State# RealWorld
rekey Int#
0# State# RealWorld
s5
  in (# State# RealWorld
s6, HashSet# a
newHashSet #)

--------------------------------------------------------------------------------
-- Insertion

{-# INLINE insertingIfAbsent #-}
-- | Insert a a pre-hashed element in the 'HashSet', calling one of the
-- continuations depending on whether the element has been newly added
-- or whether it was already present. Both continuations receive an
-- 'Int' index for the element in that 'HashSet' (see 'index').
--
-- This function is lazy in the element to insert, the assumption being
-- that computing the hash should already have forced it.
insertingIfAbsent
  :: Eq a
  => HashSet a -- ^ The 'HashSet' to operate on
  -> a         -- ^ The element to insert.
  -> Int       -- ^ Its precomputed hash.
  -> (a -> Int -> IO r)
  -- ^ Continuation to invoke if the element was already present in the
  -- table.
  -> (Int -> IO r)
  -- ^ Continuation to invoke if the element was not present in the
  -- table.
  -> IO r
insertingIfAbsent :: forall a r.
Eq a =>
HashSet a
-> a -> Int -> (a -> Int -> IO r) -> (Int -> IO r) -> IO r
insertingIfAbsent HashSet a
tbl a
a (I# Int#
h) a -> Int -> IO r
hit Int -> IO r
miss =
  (State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, r #)) -> IO r)
-> (State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a b. (a -> b) -> a -> b
$ HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
forall a r.
HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
acquireHashSet# HashSet a
tbl \HashSet# a
tbl HashSet# a -> State# RealWorld -> State# RealWorld
release State# RealWorld
s0 ->
    let !(# State# RealWorld
s1, HashSet# a
resizedTbl #) = HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
forall a.
Eq a =>
HashSet# a
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
maybeResize# HashSet# a
tbl State# RealWorld
s0 in
    HashSet# a
-> a
-> Int#
-> State# RealWorld
-> (a -> Int# -> State# RealWorld -> (# State# RealWorld, r #))
-> (Int# -> State# RealWorld -> (# State# RealWorld, r #))
-> (# State# RealWorld, r #)
forall a r.
Eq a =>
HashSet# a
-> a
-> Int#
-> State# RealWorld
-> (a -> Int# -> State# RealWorld -> r)
-> (Int# -> State# RealWorld -> r)
-> r
findIndexCps# HashSet# a
resizedTbl a
a Int#
h State# RealWorld
s1
      (\a
a Int#
i State# RealWorld
s2 -> IO r -> State# RealWorld -> (# State# RealWorld, r #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (a -> Int -> IO r
hit a
a (Int# -> Int
I# Int#
i)) (HashSet# a -> State# RealWorld -> State# RealWorld
release HashSet# a
resizedTbl State# RealWorld
s2))
      (\Int#
i State# RealWorld
s2 ->
        let !(# State# RealWorld
s3, Int#
j #) = HashSet# a
-> Int#
-> a
-> Int#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall a.
HashSet# a
-> Int#
-> a
-> Int#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
pushElement# HashSet# a
resizedTbl Int#
i a
a Int#
h State# RealWorld
s2
         in IO r -> State# RealWorld -> (# State# RealWorld, r #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (Int -> IO r
miss (Int# -> Int
I# Int#
j)) (HashSet# a -> State# RealWorld -> State# RealWorld
release HashSet# a
resizedTbl State# RealWorld
s3))

{-# INLINE pushElement# #-}
-- | Insert a new element into the table at the given slot, returning
-- the index into the data arrays where it and its hash can be found.
pushElement#
  :: HashSet# a -- ^ The table to insert into.
  -> Int#       -- ^ The slot (index into the 'indices' array) that points to this entry.
  -> a          -- ^ The value to insert.
  -> Int#       -- ^ Precomputed hash.
  -> State# RealWorld
  -> (# State# RealWorld, Int# #)
pushElement# :: forall a.
HashSet# a
-> Int#
-> a
-> Int#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
pushElement# HashSet#{MutableArray# RealWorld a
MutableByteArray# RealWorld
IntVar# RealWorld
indices :: forall a. HashSet# a -> MutableByteArray# RealWorld
hashCodes :: forall a. HashSet# a -> MutableByteArray# RealWorld
entries :: forall a. HashSet# a -> MutableArray# RealWorld a
numEntries :: forall a. HashSet# a -> IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
..} Int#
i a
a Int#
h State# RealWorld
s0 =
  let
    !(# State# RealWorld
s1, Int#
n #) = IntVar# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall s. IntVar# s -> State# s -> (# State# s, Int# #)
readIntVar# IntVar# RealWorld
numEntries State# RealWorld
s0
    !s2 :: State# RealWorld
s2 = MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
indices Int#
i Int#
n State# RealWorld
s1
    !s3 :: State# RealWorld
s3 = MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
hashCodes Int#
n Int#
h State# RealWorld
s2
    !s4 :: State# RealWorld
s4 = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# RealWorld a
entries Int#
n a
a State# RealWorld
s3
    !s5 :: State# RealWorld
s5 = IntVar# RealWorld -> Int# -> State# RealWorld -> State# RealWorld
forall s. IntVar# s -> Int# -> State# s -> State# s
writeIntVar# IntVar# RealWorld
numEntries (Int#
n Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s4
  in (# State# RealWorld
s5, Int#
n #)

{-# INLINE findIndexCps# #-}

-- | Look up an element by hash in the 'HashSet#'. This function can be
-- used both to test whether an element is present (and, if so, at which
-- index) /and/ to compute the slot at which a missing element could be
-- inserted.
--
-- This function does not modify the table in any way.
findIndexCps#
  :: forall {rep :: RuntimeRep} (a :: Type) (r :: TYPE rep)
  .  (Eq a)
  => HashSet# a
  -> a
  -> Int#
  -- ^ Precomputed hash.
  -> State# RealWorld
  -> (a -> Int# -> State# RealWorld -> r)
  -- ^ Continuation to call when the element is in the table.
  --
  -- The continuation is passed an index @i@ into the 'entries' and
  -- 'hashCodes' array, along with the entry at @i@.
  -> (Int# -> State# RealWorld -> r)
  -- ^ Continuation to call when the element is not in the table.
  --
  -- The continuation is passed an index @i@ into the 'indices' array,
  -- which can be used to insert the element.
  -> r
findIndexCps# :: forall a r.
Eq a =>
HashSet# a
-> a
-> Int#
-> State# RealWorld
-> (a -> Int# -> State# RealWorld -> r)
-> (Int# -> State# RealWorld -> r)
-> r
findIndexCps# hashSet :: HashSet# a
hashSet@HashSet#{MutableArray# RealWorld a
MutableByteArray# RealWorld
IntVar# RealWorld
indices :: forall a. HashSet# a -> MutableByteArray# RealWorld
hashCodes :: forall a. HashSet# a -> MutableByteArray# RealWorld
entries :: forall a. HashSet# a -> MutableArray# RealWorld a
numEntries :: forall a. HashSet# a -> IntVar# RealWorld
indices :: MutableByteArray# RealWorld
hashCodes :: MutableByteArray# RealWorld
entries :: MutableArray# RealWorld a
numEntries :: IntVar# RealWorld
..} a
a Int#
h State# RealWorld
s0 a -> Int# -> State# RealWorld -> r
hit Int# -> State# RealWorld -> r
miss = Int# -> Int# -> State# RealWorld -> r
loop (Int#
h Int# -> Int# -> Int#
`andI#` Int#
mask) Int#
h State# RealWorld
s0 where
  cap :: Int#
  cap :: Int#
cap = HashSet# a -> Int#
forall a. HashSet# a -> Int#
capacity# HashSet# a
hashSet

  mask :: Int#
  mask :: Int#
mask = Int# -> Int#
capacityMask# Int#
cap

  {-# INLINE nextProbe# #-}
  nextProbe# :: Int# -> Int# -> (# Int#, Int# #)
  nextProbe# :: Int# -> Int# -> (# Int#, Int# #)
nextProbe# Int#
i Int#
h =
    -- Basic idea is to use an LCG that incrementally mixes
    -- in the high bits of the hash.
    --
    -- The coefficients of the LCG are chosen to satisfy
    -- the Hull-Dobell theorem, which ensures that the probe
    -- sequence has a period equal to the table size.
    let !d :: Int#
d = Int#
h Int# -> Int# -> Int#
`iShiftRL#` Int#
5#
    in (# (Int#
5# Int# -> Int# -> Int#
*# Int#
i Int# -> Int# -> Int#
+# Int#
1# Int# -> Int# -> Int#
+# Int#
d) Int# -> Int# -> Int#
`andI#` Int#
mask , Int#
d #)

  {-# INLINABLE loop #-}
  -- First argument is the index to probe, second argument
  -- is decaying bits of hash; see nextProbe# for details.
  loop :: Int# -> Int# -> State# RealWorld -> r
loop Int#
i Int#
d State# RealWorld
s0 =
    let !(# State# RealWorld
s1, Int#
j #) = MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# RealWorld
indices Int#
i State# RealWorld
s0
        -- No sense duplicating this in the branches;
        -- this only takes a couple of cycles.
        !(# Int#
i', Int#
d' #) = Int# -> Int# -> (# Int#, Int# #)
nextProbe# Int#
i Int#
d
    in if Int# -> Bool
isTrue# (Int# -> Int#
isUnoccupied# Int#
j) then
      Int# -> State# RealWorld -> r
miss Int#
i State# RealWorld
s1
    else
      let !(# State# RealWorld
s2, Int#
hj #) = MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# RealWorld
hashCodes Int#
j State# RealWorld
s1
      in if Int# -> Bool
isTrue# (Int#
hj Int# -> Int# -> Int#
==# Int#
h) then
        let !(# State# RealWorld
s3, a
aj #) = MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
entries Int#
j State# RealWorld
s2
        in if (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
aj) then
          -- Found it!
          a -> Int# -> State# RealWorld -> r
hit a
aj Int#
j State# RealWorld
s3
        else
          -- Hash-collision, keep probing.
          Int# -> Int# -> State# RealWorld -> r
loop Int#
i' Int#
d' State# RealWorld
s3
      else
        -- The perils of open-addressing! Our probe stumbled
        -- across a slot that was occupied by another key, keep probing.
        Int# -> Int# -> State# RealWorld -> r
loop Int#
i' Int#
d' State# RealWorld
s2


--------------------------------------------------------------------------------
-- Indexing

-- | Get the @n@th element inserted into the hash set.
index :: HashSet a -> Int -> IO (Maybe a)
index :: forall a. HashSet a -> Int -> IO (Maybe a)
index HashSet a
hashSet (I# Int#
i) = (State# RealWorld -> (# State# RealWorld, Maybe a #))
-> IO (Maybe a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Maybe a #))
 -> IO (Maybe a))
-> (State# RealWorld -> (# State# RealWorld, Maybe a #))
-> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, Maybe a #))
-> State# RealWorld
-> (# State# RealWorld, Maybe a #)
forall a r.
HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
acquireHashSet# HashSet a
hashSet \HashSet# a
tbl HashSet# a -> State# RealWorld -> State# RealWorld
release State# RealWorld
s0 ->
  let !(# State# RealWorld
s1, Int#
len #) = HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall a.
HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
size# HashSet# a
tbl State# RealWorld
s0
  in if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
len) then
    let !(# State# RealWorld
s2, a
a #) = MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# (HashSet# a -> MutableArray# RealWorld a
forall a. HashSet# a -> MutableArray# RealWorld a
entries HashSet# a
tbl) Int#
i State# RealWorld
s1
    in (# HashSet# a -> State# RealWorld -> State# RealWorld
release HashSet# a
tbl State# RealWorld
s2, a -> Maybe a
forall a. a -> Maybe a
Just a
a #)
  else
    (# HashSet# a -> State# RealWorld -> State# RealWorld
release HashSet# a
tbl State# RealWorld
s1, Maybe a
forall a. Maybe a
Nothing #)

--------------------------------------------------------------------------------
-- Conversions

-- | Make an immutable copy of the entries in a 'HashSet'.
--
-- The elements of @toArray hs@ are ordered by insertion time, with the
-- first element inserted at index 0.
toArray :: HashSet a -> IO (AL.Array a)
toArray :: forall a. HashSet a -> IO (Array a)
toArray HashSet a
hashSet =
  (State# RealWorld -> (# State# RealWorld, Array a #))
-> IO (Array a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Array a #))
 -> IO (Array a))
-> (State# RealWorld -> (# State# RealWorld, Array a #))
-> IO (Array a)
forall a b. (a -> b) -> a -> b
$ HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, Array a #))
-> State# RealWorld
-> (# State# RealWorld, Array a #)
forall a r.
HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
acquireHashSet# HashSet a
hashSet \HashSet# a
tbl HashSet# a -> State# RealWorld -> State# RealWorld
release State# RealWorld
s0 ->
    let !(# State# RealWorld
s1, Int#
len #) = HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall a.
HashSet# a -> State# RealWorld -> (# State# RealWorld, Int# #)
size# HashSet# a
tbl State# RealWorld
s0
        !(# State# RealWorld
s2, Array# a
arr #) = MutableArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, Array# a #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, Array# a #)
freezeArray# (HashSet# a -> MutableArray# RealWorld a
forall a. HashSet# a -> MutableArray# RealWorld a
entries HashSet# a
tbl) Int#
0# Int#
len State# RealWorld
s1
    in (# HashSet# a -> State# RealWorld -> State# RealWorld
release HashSet# a
tbl State# RealWorld
s2, Array a -> Array a
forall a. Array a -> Array a
AL.Array (Array# a -> Array a
forall a. Array# a -> Array a
A.Array Array# a
arr) #)

--------------------------------------------------------------------------------
-- Locking

{-# INLINE acquireHashSet# #-}
-- | Acquire the lock on an 'HashSet'.
acquireHashSet#
  :: forall {rep :: RuntimeRep} (a :: Type) (r :: TYPE rep)
  . HashSet a
  -> (HashSet# a -> (HashSet# a -> State# RealWorld -> State# RealWorld) -> State# RealWorld -> (# State# RealWorld, r #))
  -> State# RealWorld
  -> (# State# RealWorld, r #)
acquireHashSet# :: forall a r.
HashSet a
-> (HashSet# a
    -> (HashSet# a -> State# RealWorld -> State# RealWorld)
    -> State# RealWorld
    -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
acquireHashSet# (HashSet MVar# RealWorld (HashSet# a)
lock) HashSet# a
-> (HashSet# a -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> (# State# RealWorld, r #)
k State# RealWorld
s0 =
  case MVar# RealWorld (HashSet# a)
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# RealWorld (HashSet# a)
lock State# RealWorld
s0 of
    (# State# RealWorld
s1, HashSet# a
hashSet #) -> HashSet# a
-> (HashSet# a -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> (# State# RealWorld, r #)
k HashSet# a
hashSet (MVar# RealWorld (HashSet# a)
-> HashSet# a -> State# RealWorld -> State# RealWorld
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# RealWorld (HashSet# a)
lock) State# RealWorld
s1

{-# INLINE peekHashSet# #-}
-- | Peek at the underlying table of an 'HashSet' without
-- acquiring the lock.
--
-- If another operation has the lock, 'peekHashSet#' will block until the lock
-- has been released.
peekHashSet#
  :: forall {rep :: RuntimeRep} (a :: Type) (r :: TYPE rep)
  . HashSet a
  -> (HashSet# a -> State# RealWorld -> (# State# RealWorld, r #))
  -> State# RealWorld
  -> (# State# RealWorld, r #)
peekHashSet# :: forall a r.
HashSet a
-> (HashSet# a -> State# RealWorld -> (# State# RealWorld, r #))
-> State# RealWorld
-> (# State# RealWorld, r #)
peekHashSet# (HashSet  MVar# RealWorld (HashSet# a)
lock) HashSet# a -> State# RealWorld -> (# State# RealWorld, r #)
k State# RealWorld
s0 =
  case MVar# RealWorld (HashSet# a)
-> State# RealWorld -> (# State# RealWorld, HashSet# a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# RealWorld (HashSet# a)
lock State# RealWorld
s0 of
    (# State# RealWorld
s1, HashSet# a
hashSet #) -> HashSet# a -> State# RealWorld -> (# State# RealWorld, r #)
k HashSet# a
hashSet State# RealWorld
s1

--------------------------------------------------------------------------------
-- Unoccupied elements

{-# NOINLINE unoccupied #-}
unoccupied :: a
unoccupied :: forall a. a
unoccupied = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Mikan.Utils.HashSet.Ordered: unoccupied entry"

{-# INLINE isUnoccupied# #-}
-- | Is a slot unoccupied?
isUnoccupied# :: Int# -> Int#
isUnoccupied# :: Int# -> Int#
isUnoccupied# Int#
i = Int#
i Int# -> Int# -> Int#
<# Int#
0#