{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnliftedNewtypes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

-- |
-- This module provides mutable hashmaps with a linear interface.
--
-- It is implemented with Robin Hood hashing which has amortized
-- constant time lookups and updates.
module Data.HashMap.Mutable.Linear
  ( -- * A mutable hashmap
    HashMap,
    Keyed,
    -- * Constructors
    empty,
    fromList,
    -- * Modifiers
    insert,
    insertAll,
    delete,
    filter,
    filterWithKey,
    mapMaybe,
    mapMaybeWithKey,
    shrinkToFit,
    alter,
    alterF,
    -- * Accessors
    size,
    capacity,
    lookup,
    member,
    toList,
    -- * Combining maps
    union,
    unionWith,
    intersectionWith
  )
where

import qualified Control.Functor.Linear as Control
import Data.Array.Mutable.Linear (Array)
import Data.Functor.Identity hiding (runIdentity)
import qualified Data.Functor.Linear as Data
import qualified Data.Array.Mutable.Linear as Array
import Data.Hashable
import Data.Unrestricted.Linear
import Prelude.Linear hiding ((+), lookup, read, filter, mapMaybe, insert)
import Prelude ((+))
import qualified Data.Maybe as NonLinear
import qualified Data.Function as NonLinear
import qualified Prelude
import Unsafe.Coerce (unsafeCoerce)
import qualified Unsafe.Linear as Unsafe

-- # Implementation Notes
-- This is a simple implementatation of robin hood hashing.
--
-- See these links:
--
-- * https://programming.guide/robin-hood-hashing.html
-- * https://andre.arko.net/2017/08/24/robin-hood-hashing/
-- * https://cs.uwaterloo.ca/research/tr/1986/CS-86-14.pdf
--

-- # Constants
--------------------------------------------------

-- | When to trigger a resize.
--
-- A high load factor usually is not desirable because it makes operations
-- do more probes. A very low one is also not desirable since there're some
-- operations which take time relative to the 'capacity'.
--
-- This should be between (0, 1)
--
-- The value 0.75 is what Java uses:
-- https://docs.oracle.com/javase/10/docs/api/java/util/HashMap.html
constMaxLoadFactor :: Float
constMaxLoadFactor :: Float
constMaxLoadFactor = Float
0.75

-- | When resizing, the capacity will be multiplied by this amount.
--
-- This should be greater than one.
constGrowthFactor :: Int
constGrowthFactor :: Int
constGrowthFactor = Int
2

-- # Core Data Types
--------------------------------------------------

-- | A mutable hashmap with a linear interface.
data HashMap k v where
  -- |
  -- @loadFactor m = size m / cap m@
  --
  -- Invariants:
  -- - array is non-empty
  -- - (count / capacity) <= constMaxLoadFactor.
  HashMap
    :: Int -- ^ The number of stored (key, value) pairs.
    -> RobinArr k v -- ^ Underlying array.
    %1-> HashMap k v

-- | An array of Robin values
--
-- Each cell is Nothing if empty and is a RobinVal with the correct
-- PSL otherwise.
type RobinArr k v = Array (Maybe (RobinVal k v))

-- | Robin values are triples of the key, value and PSL
-- (the probe sequence length).
data RobinVal k v = RobinVal {-# UNPACK #-} !PSL k v
  deriving (Int -> RobinVal k v -> ShowS
[RobinVal k v] -> ShowS
RobinVal k v -> String
(Int -> RobinVal k v -> ShowS)
-> (RobinVal k v -> String)
-> ([RobinVal k v] -> ShowS)
-> Show (RobinVal k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> RobinVal k v -> ShowS
forall k v. (Show k, Show v) => [RobinVal k v] -> ShowS
forall k v. (Show k, Show v) => RobinVal k v -> String
showList :: [RobinVal k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [RobinVal k v] -> ShowS
show :: RobinVal k v -> String
$cshow :: forall k v. (Show k, Show v) => RobinVal k v -> String
showsPrec :: Int -> RobinVal k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> RobinVal k v -> ShowS
Show)

incRobinValPSL :: RobinVal k v -> RobinVal k v
incRobinValPSL :: forall k v. RobinVal k v -> RobinVal k v
incRobinValPSL (RobinVal (PSL Int
p) k
k v
v) = PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal (Int -> PSL
PSL (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) k
k v
v

decRobinValPSL :: RobinVal k v -> RobinVal k v
decRobinValPSL :: forall k v. RobinVal k v -> RobinVal k v
decRobinValPSL (RobinVal (PSL Int
p) k
k v
v) = PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal (Int -> PSL
PSL (Int
pInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
1)) k
k v
v

-- | A probe sequence length
newtype PSL = PSL Int
  deriving (PSL -> PSL -> Bool
(PSL -> PSL -> Bool) -> (PSL -> PSL -> Bool) -> Eq PSL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PSL -> PSL -> Bool
$c/= :: PSL -> PSL -> Bool
== :: PSL -> PSL -> Bool
$c== :: PSL -> PSL -> Bool
Prelude.Eq, Eq PSL
Eq PSL
-> (PSL -> PSL -> Ordering)
-> (PSL -> PSL -> Bool)
-> (PSL -> PSL -> Bool)
-> (PSL -> PSL -> Bool)
-> (PSL -> PSL -> Bool)
-> (PSL -> PSL -> PSL)
-> (PSL -> PSL -> PSL)
-> Ord PSL
PSL -> PSL -> Bool
PSL -> PSL -> Ordering
PSL -> PSL -> PSL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PSL -> PSL -> PSL
$cmin :: PSL -> PSL -> PSL
max :: PSL -> PSL -> PSL
$cmax :: PSL -> PSL -> PSL
>= :: PSL -> PSL -> Bool
$c>= :: PSL -> PSL -> Bool
> :: PSL -> PSL -> Bool
$c> :: PSL -> PSL -> Bool
<= :: PSL -> PSL -> Bool
$c<= :: PSL -> PSL -> Bool
< :: PSL -> PSL -> Bool
$c< :: PSL -> PSL -> Bool
compare :: PSL -> PSL -> Ordering
$ccompare :: PSL -> PSL -> Ordering
Prelude.Ord, Integer -> PSL
PSL -> PSL
PSL -> PSL -> PSL
(PSL -> PSL -> PSL)
-> (PSL -> PSL -> PSL)
-> (PSL -> PSL -> PSL)
-> (PSL -> PSL)
-> (PSL -> PSL)
-> (PSL -> PSL)
-> (Integer -> PSL)
-> Num PSL
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PSL
$cfromInteger :: Integer -> PSL
signum :: PSL -> PSL
$csignum :: PSL -> PSL
abs :: PSL -> PSL
$cabs :: PSL -> PSL
negate :: PSL -> PSL
$cnegate :: PSL -> PSL
* :: PSL -> PSL -> PSL
$c* :: PSL -> PSL -> PSL
- :: PSL -> PSL -> PSL
$c- :: PSL -> PSL -> PSL
+ :: PSL -> PSL -> PSL
$c+ :: PSL -> PSL -> PSL
Prelude.Num, Int -> PSL -> ShowS
[PSL] -> ShowS
PSL -> String
(Int -> PSL -> ShowS)
-> (PSL -> String) -> ([PSL] -> ShowS) -> Show PSL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSL] -> ShowS
$cshowList :: [PSL] -> ShowS
show :: PSL -> String
$cshow :: PSL -> String
showsPrec :: Int -> PSL -> ShowS
$cshowsPrec :: Int -> PSL -> ShowS
Prelude.Show)

-- | At minimum, we need to store hashable
-- and identifiable keys
type Keyed k = (Prelude.Eq k, Hashable k)

-- | The results of searching for where to insert a key.
--
-- PSL's on the constructors are the probes spent from the query, this
-- might be different than PSL's of the cell at the returned index
-- (in case of `IndexToSwap` constructor).
data ProbeResult k v where
  -- | An empty cell at index to insert a new element with PSL.
  IndexToInsert :: !PSL -> !Int -> ProbeResult k v
  -- | A matching cell at index with a PSL and a value to update.
  IndexToUpdate :: v -> !PSL -> !Int -> ProbeResult k v
  -- | An occupied, richer, cell which should be evicted when inserting
  -- the new element. The swapped-out cell will then need to be inserted
  -- with a higher PSL.
  IndexToSwap :: RobinVal k v -> !PSL -> !Int -> ProbeResult k v

-- # Construction and Modification
--------------------------------------------------

-- | Run a computation with an empty 'HashMap' with given capacity.
empty :: forall k v b.
  Keyed k => Int -> (HashMap k v %1-> Ur b) %1-> Ur b
empty :: forall k v b. Keyed k => Int -> (HashMap k v %1 -> Ur b) %1 -> Ur b
empty Int
size HashMap k v %1 -> Ur b
scope =
  Int
-> Maybe (RobinVal k v)
-> (Array (Maybe (RobinVal k v)) %1 -> Ur b)
%1 -> Ur b
forall a b.
HasCallStack =>
Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b
Array.alloc
    (Int %1 -> Int %1 -> Int
forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
max Int
1 Int
size)
    Maybe (RobinVal k v)
forall a. Maybe a
Nothing
    (\Array (Maybe (RobinVal k v))
arr -> HashMap k v %1 -> Ur b
scope (Int -> Array (Maybe (RobinVal k v)) %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
0 Array (Maybe (RobinVal k v))
arr))

-- | Create an empty HashMap, using another as a uniqueness proof.
allocBeside :: Keyed k => Int -> HashMap k' v' %1-> (HashMap k v, HashMap k' v')
allocBeside :: forall k k' v' v.
Keyed k =>
Int -> HashMap k' v' %1 -> (HashMap k v, HashMap k' v')
allocBeside Int
size (HashMap Int
s' RobinArr k' v'
arr) =
  Int
-> Maybe (RobinVal k v)
-> RobinArr k' v'
%1 -> (Array (Maybe (RobinVal k v)), RobinArr k' v')
forall a b. Int -> a -> Array b %1 -> (Array a, Array b)
Array.allocBeside (Int %1 -> Int %1 -> Int
forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
max Int
1 Int
size) Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k' v'
arr (Array (Maybe (RobinVal k v)), RobinArr k' v')
%1 -> ((Array (Maybe (RobinVal k v)), RobinArr k' v')
       %1 -> (HashMap k v, HashMap k' v'))
%1 -> (HashMap k v, HashMap k' v')
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Array (Maybe (RobinVal k v))
arr', RobinArr k' v'
arr'') ->
    (Int -> Array (Maybe (RobinVal k v)) %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
size Array (Maybe (RobinVal k v))
arr', Int -> RobinArr k' v' %1 -> HashMap k' v'
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
s' RobinArr k' v'
arr'')

-- | Run a computation with an 'HashMap' containing given key-value pairs.
fromList :: forall k v b.
  Keyed k => [(k, v)] -> (HashMap k v %1-> Ur b) %1-> Ur b
fromList :: forall k v b.
Keyed k =>
[(k, v)] -> (HashMap k v %1 -> Ur b) %1 -> Ur b
fromList [(k, v)]
xs HashMap k v %1 -> Ur b
scope =
  Int
-> Maybe (RobinVal k v)
-> (Array (Maybe (RobinVal k v)) %1 -> Ur b)
%1 -> Ur b
forall a b.
HasCallStack =>
Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b
Array.alloc
    (Int %1 -> Int %1 -> Int
forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
max
      Int
1
      (forall a b. (RealFrac a, Integral b) => a -> b
ceiling @Float @Int (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(k, v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [(k, v)]
xs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
constMaxLoadFactor)))
    Maybe (RobinVal k v)
forall a. Maybe a
Nothing
    (\Array (Maybe (RobinVal k v))
arr -> HashMap k v %1 -> Ur b
scope ([(k, v)] -> HashMap k v %1 -> HashMap k v
forall k v. Keyed k => [(k, v)] -> HashMap k v %1 -> HashMap k v
insertAll [(k, v)]
xs (Int -> Array (Maybe (RobinVal k v)) %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
0 Array (Maybe (RobinVal k v))
arr)))

-- | The most general modification function; which can insert, update or delete
-- a value of the key, while collecting an effect in the form of an arbitrary
-- 'Control.Functor'.
alterF :: (Keyed k, Control.Functor f) => (Maybe v -> f (Ur (Maybe v))) -> k -> HashMap k v %1-> f (HashMap k v)
alterF :: forall k (f :: * -> *) v.
(Keyed k, Functor f) =>
(Maybe v -> f (Ur (Maybe v)))
-> k -> HashMap k v %1 -> f (HashMap k v)
alterF Maybe v -> f (Ur (Maybe v))
f k
key HashMap k v
hm =
  k -> HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. Keyed k => k -> HashMap k v %1 -> (Ur Int, HashMap k v)
idealIndexForKey k
key HashMap k v
hm (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> f (HashMap k v))
%1 -> f (HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
idx, HashMap k v
hm') ->
    (k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
forall k v.
Keyed k =>
(k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
probeFrom (k
key, PSL
0) Int
idx HashMap k v
hm' (HashMap k v, ProbeResult k v)
%1 -> ((HashMap k v, ProbeResult k v) %1 -> f (HashMap k v))
%1 -> f (HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      -- The key does not exist, and there is an empty cell to insert.
      (HashMap Int
count RobinArr k v
arr, IndexToInsert PSL
psl Int
ix) ->
        Maybe v -> f (Ur (Maybe v))
f Maybe v
forall a. Maybe a
Nothing f (Ur (Maybe v))
%1 -> (Ur (Maybe v) %1 -> HashMap k v) %1 -> f (HashMap k v)
forall (f :: * -> *) a b.
Functor f =>
f a %1 -> (a %1 -> b) %1 -> f b
Control.<&> \case
          -- We don't need to insert anything.
          Ur Maybe v
Nothing -> Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
count RobinArr k v
arr
          -- We need to insert a new key.
          Ur (Just v
v)->
            Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap
             (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
             (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl k
key v
v)))
             HashMap k v %1 -> (HashMap k v %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& HashMap k v %1 -> HashMap k v
forall k v. Keyed k => HashMap k v %1 -> HashMap k v
growMapIfNecessary
      -- The key exists.
      (HashMap k v
hm'', IndexToUpdate v
v PSL
psl Int
ix) ->
        HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm'' (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> f (HashMap k v))
%1 -> f (HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap Int
count RobinArr k v
arr) ->
          Maybe v -> f (Ur (Maybe v))
f (v -> Maybe v
forall a. a -> Maybe a
Just v
v) f (Ur (Maybe v))
%1 -> (Ur (Maybe v) %1 -> HashMap k v) %1 -> f (HashMap k v)
forall (f :: * -> *) a b.
Functor f =>
f a %1 -> (a %1 -> b) %1 -> f b
Control.<&> \case
            -- We need to delete it.
            Ur Maybe v
Nothing ->
              RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
%1 -> (RobinArr k v %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \RobinArr k v
arr' ->
                Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
forall k v.
Keyed k =>
Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
shiftSegmentBackward Int
1 Int
cap RobinArr k v
arr' ((Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
cap) RobinArr k v
%1 -> (RobinArr k v %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \RobinArr k v
arr'' ->
                  Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap
                    (Int
count Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1)
                    RobinArr k v
arr''
            -- We need to update it.
            Ur (Just v
new)->
              Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap
                Int
count
                (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl k
key v
new)))
      -- The key does not exist, but there is a key to evict.
      (HashMap k v
hm, IndexToSwap RobinVal k v
evicted PSL
psl Int
ix) ->
        Maybe v -> f (Ur (Maybe v))
f Maybe v
forall a. Maybe a
Nothing f (Ur (Maybe v))
%1 -> (Ur (Maybe v) %1 -> HashMap k v) %1 -> f (HashMap k v)
forall (f :: * -> *) a b.
Functor f =>
f a %1 -> (a %1 -> b) %1 -> f b
Control.<&> \case
          -- We don't need to insert anything.
          Ur Maybe v
Nothing -> HashMap k v
hm
          -- We need to insert a new key.
          Ur (Just v
v)->
            HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap Int
count RobinArr k v
arr) ->
              HashMap k v %1 -> Int -> RobinVal k v -> HashMap k v
forall k v.
Keyed k =>
HashMap k v %1 -> Int -> RobinVal k v -> HashMap k v
tryInsertAtIndex
                (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap
                  Int
count
                  (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl k
key v
v))))
                ((Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
cap)
                (RobinVal k v -> RobinVal k v
forall k v. RobinVal k v -> RobinVal k v
incRobinValPSL RobinVal k v
evicted)
              HashMap k v %1 -> (HashMap k v %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& HashMap k v %1 -> HashMap k v
forall k v. Keyed k => HashMap k v %1 -> HashMap k v
growMapIfNecessary

-- aspiwack: I'm implementing `alter` in terms of `alterF`, because, at this
-- point, we may have some bug fixes and so on and so forth. And maintaining two
-- functions this size is quite a bit unpleasant. Nevertheless, the extra boxing
-- required by the intermediate `Ur` call, there, makes it so that the
-- specialisation of `alterF` to `Identity` doesn't quite yield the code that we
-- would like, it's a bit costlier than it should. So in an ideal word, we would
-- implement both manually. In the future probably.
-- | A general modification function; which can insert, update or delete
-- a value of the key. See 'alterF', for an even more general function.
alter :: Keyed k => (Maybe v -> Maybe v) -> k -> HashMap k v %1-> HashMap k v
alter :: forall k v.
Keyed k =>
(Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
alter Maybe v -> Maybe v
f k
key HashMap k v
hm = Identity (HashMap k v) %1 -> HashMap k v
forall a. Identity a %1 -> a
runIdentity (Identity (HashMap k v) %1 -> HashMap k v)
%1 -> Identity (HashMap k v) %1 -> HashMap k v
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Maybe v -> Identity (Ur (Maybe v)))
-> k -> HashMap k v %1 -> Identity (HashMap k v)
forall k (f :: * -> *) v.
(Keyed k, Functor f) =>
(Maybe v -> f (Ur (Maybe v)))
-> k -> HashMap k v %1 -> f (HashMap k v)
alterF (\Maybe v
v -> Ur (Maybe v) -> Identity (Ur (Maybe v))
forall a. a -> Identity a
Identity (Maybe v -> Ur (Maybe v)
forall a. a -> Ur a
Ur (Maybe v -> Maybe v
f Maybe v
v))) k
key HashMap k v
hm
  where
    runIdentity :: Identity a %1-> a
    runIdentity :: forall a. Identity a %1 -> a
runIdentity (Identity a
x) = a
x

-- | Insert a key value pair to a 'HashMap'. It overwrites the previous
-- value if it exists.
insert :: Keyed k => k -> v -> HashMap k v %1-> HashMap k v
insert :: forall k v. Keyed k => k -> v -> HashMap k v %1 -> HashMap k v
insert k
k v
v = (Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
(Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
alter (\Maybe v
_ -> v -> Maybe v
forall a. a -> Maybe a
Just v
v) k
k

-- | Delete a key from a 'HashMap'. Does nothing if the key does not
-- exist.
delete :: Keyed k => k -> HashMap k v %1-> HashMap k v
delete :: forall k v. Keyed k => k -> HashMap k v %1 -> HashMap k v
delete = (Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
(Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
alter (\Maybe v
_ -> Maybe v
forall a. Maybe a
Nothing)

-- | 'insert' (in the provided order) the given key-value pairs to
-- the hashmap.
insertAll :: Keyed k => [(k, v)] -> HashMap k v %1-> HashMap k v
insertAll :: forall k v. Keyed k => [(k, v)] -> HashMap k v %1 -> HashMap k v
insertAll [] HashMap k v
hmap = HashMap k v
hmap
insertAll ((k
k, v
v) : [(k, v)]
xs) HashMap k v
hmap = [(k, v)] -> HashMap k v %1 -> HashMap k v
forall k v. Keyed k => [(k, v)] -> HashMap k v %1 -> HashMap k v
insertAll [(k, v)]
xs (k -> v -> HashMap k v %1 -> HashMap k v
forall k v. Keyed k => k -> v -> HashMap k v %1 -> HashMap k v
insert k
k v
v HashMap k v
hmap)
-- TODO: Do a resize first on the length of the input.

-- | A version of 'fmap' which can throw out the elements.
--
-- Complexity: O(capacity hm)
mapMaybe :: Keyed k => (v -> Maybe v') -> HashMap k v %1-> HashMap k v'
mapMaybe :: forall k v v'.
Keyed k =>
(v -> Maybe v') -> HashMap k v %1 -> HashMap k v'
mapMaybe v -> Maybe v'
f = (k -> v -> Maybe v') -> HashMap k v %1 -> HashMap k v'
forall k v v'.
Keyed k =>
(k -> v -> Maybe v') -> HashMap k v %1 -> HashMap k v'
mapMaybeWithKey (\k
_k v
v -> v -> Maybe v'
f v
v)

-- | Same as 'mapMaybe', but also has access to the keys.
mapMaybeWithKey :: forall k v v' .
  Keyed k => (k -> v -> Maybe v') -> HashMap k v %1-> HashMap k v'
mapMaybeWithKey :: forall k v v'.
Keyed k =>
(k -> v -> Maybe v') -> HashMap k v %1 -> HashMap k v'
mapMaybeWithKey k -> v -> Maybe v'
_ (HashMap Int
0 RobinArr k v
arr) = Int -> RobinArr k v' %1 -> HashMap k v'
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
0 (RobinArr k v %1 -> RobinArr k v'
forall a b. a %1 -> b
Unsafe.coerce RobinArr k v
arr)
mapMaybeWithKey k -> v -> Maybe v'
f (HashMap Int
_ RobinArr k v
arr) = RobinArr k v %1 -> (Ur Int, RobinArr k v)
forall a. Array a %1 -> (Ur Int, Array a)
Array.size RobinArr k v
arr (Ur Int, RobinArr k v)
%1 -> ((Ur Int, RobinArr k v) %1 -> HashMap k v')
%1 -> HashMap k v'
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
size, RobinArr k v
arr1) ->
  Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack Int
0 (Int
sizeInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
1) (Bool
False,Int
0) Int
0 RobinArr k v
arr1 (Ur Int, RobinArr k v)
%1 -> ((Ur Int, RobinArr k v) %1 -> HashMap k v')
%1 -> HashMap k v'
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
c, RobinArr k v
arr2) ->
    Int -> RobinArr k v' %1 -> HashMap k v'
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
c (RobinArr k v %1 -> RobinArr k v'
forall a b. a %1 -> b
Unsafe.coerce RobinArr k v
arr2) where

  f' :: k -> v -> Maybe v
  f' :: k -> v -> Maybe v
f' k
k v
v = Maybe v' -> Maybe v
forall a b. a -> b
unsafeCoerce (k -> v -> Maybe v'
f k
k v
v)

  -- Going from arr[0] to arr[size-1] map each element while
  -- simultaneously pushing elements back if some earlier element(s)
  -- were deleted in a contiguous segment and if the current
  -- element has PSL > 0. Maintain a counter of how
  -- far to push elements back. At arr[size-1] if needed, call
  -- shiftSegmentBackward with the counter at arr[0].
  mapAndPushBack ::
    Int -> -- ^ Current index
    Int -> -- ^ Last index of array which is (size-1)
    (Bool, Int) -> -- ^ (b,n) s.t. b iff open space n cells before current cell
    Int -> -- ^ Count of present key-value pairs
    RobinArr k v %1->
    (Ur Int, RobinArr k v) -- ^ The new count and fully mapped array
  mapAndPushBack :: Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack Int
ix Int
end (Bool
shift,Int
dec) Int
count RobinArr k v
arr
    | (Int
ix Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
> Int
end) =
        if Bool
shift
        then (Int -> Ur Int
forall a. a -> Ur a
Ur Int
count, Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
forall k v.
Keyed k =>
Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
shiftSegmentBackward Int
dec (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RobinArr k v
arr Int
0)
        else (Int -> Ur Int
forall a. a -> Ur a
Ur Int
count, RobinArr k v
arr)
    | Bool
otherwise = RobinArr k v %1 -> Int -> (Ur (Maybe (RobinVal k v)), RobinArr k v)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read RobinArr k v
arr Int
ix (Ur (Maybe (RobinVal k v)), RobinArr k v)
%1 -> ((Ur (Maybe (RobinVal k v)), RobinArr k v)
       %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
        (Ur Maybe (RobinVal k v)
Nothing, RobinArr k v
arr1) ->
          Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
False,Int
0) Int
count RobinArr k v
arr1
        (Ur (Just (RobinVal (PSL Int
p) k
k v
v)), RobinArr k v
arr1) -> case k -> v -> Maybe v
f' k
k v
v of
          Maybe v
Nothing -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr1 Int
ix Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
            \RobinArr k v
arr2 -> Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
True,Int
decInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
count RobinArr k v
arr2
          Just v
v' -> case Bool
shift of
            Bool
False -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr1 Int
ix (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal (Int -> PSL
PSL Int
p) k
k v
v')) RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
              \RobinArr k v
arr2 -> Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
False,Int
0) (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RobinArr k v
arr2
            Bool
True -> case Int
dec Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
p of
              Bool
False -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr1 (Int
ixInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
p) (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
0 k
k v
v')) RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
                \RobinArr k v
arr2 -> case Int
p Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
0 of
                  Bool
False -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr2 Int
ix Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
                    \RobinArr k v
arr3 -> Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
True,Int
p) (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RobinArr k v
arr3
                  Bool
True -> Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
False,Int
0) (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RobinArr k v
arr2
              Bool
True -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr1 (Int
ixInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
dec) (RobinVal k v -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal (Int -> PSL
PSL (Int
pInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
dec)) k
k v
v')) RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
                \RobinArr k v
arr2 -> RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr2 Int
ix Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
%1 -> (RobinArr k v %1 -> (Ur Int, RobinArr k v))
%1 -> (Ur Int, RobinArr k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
&
                  \RobinArr k v
arr3 -> Int
-> Int
-> (Bool, Int)
-> Int
-> RobinArr k v
%1 -> (Ur Int, RobinArr k v)
mapAndPushBack (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
end (Bool
True,Int
dec) (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RobinArr k v
arr3

-- | Complexity: O(capacity hm)
filterWithKey :: Keyed k => (k -> v -> Bool) -> HashMap k v %1-> HashMap k v
filterWithKey :: forall k v.
Keyed k =>
(k -> v -> Bool) -> HashMap k v %1 -> HashMap k v
filterWithKey k -> v -> Bool
f =
  (k -> v -> Maybe v) -> HashMap k v %1 -> HashMap k v
forall k v v'.
Keyed k =>
(k -> v -> Maybe v') -> HashMap k v %1 -> HashMap k v'
mapMaybeWithKey
    (\k
k v
v -> if k -> v -> Bool
f k
k v
v then v -> Maybe v
forall a. a -> Maybe a
Just v
v else Maybe v
forall a. Maybe a
Nothing)

-- | Complexity: O(capacity hm)
filter :: Keyed k => (v -> Bool) -> HashMap k v %1-> HashMap k v
filter :: forall k v. Keyed k => (v -> Bool) -> HashMap k v %1 -> HashMap k v
filter v -> Bool
f = (k -> v -> Bool) -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
(k -> v -> Bool) -> HashMap k v %1 -> HashMap k v
filterWithKey (\k
_k v
v -> v -> Bool
f v
v)

-- | Union of two maps using the provided function on conflicts.
--
-- Complexity: O(min(capacity hm1, capacity hm2)
unionWith
  :: Keyed k => (v -> v -> v)
  -> HashMap k v %1-> HashMap k v %1-> HashMap k v
unionWith :: forall k v.
Keyed k =>
(v -> v -> v) -> HashMap k v %1 -> HashMap k v %1 -> HashMap k v
unionWith v -> v -> v
onConflict (HashMap k v
hm1 :: HashMap k v) HashMap k v
hm2 =
  -- To insert the elements in smaller map to the larger map, we
  -- compare their capacities, and flip the arguments if necessary.
  HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm1 (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap1, HashMap k v
hm1') ->
    HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm2 (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap2, HashMap k v
hm2') ->
      if Int
cap1 Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
> Int
cap2
      then (v -> v -> v) -> HashMap k v %1 -> Ur [(k, v)] %1 -> HashMap k v
go v -> v -> v
onConflict HashMap k v
hm1' (HashMap k v %1 -> Ur [(k, v)]
forall k v. HashMap k v %1 -> Ur [(k, v)]
toList HashMap k v
hm2')
      else (v -> v -> v) -> HashMap k v %1 -> Ur [(k, v)] %1 -> HashMap k v
go (\v
v2 v
v1 -> v -> v -> v
onConflict v
v1 v
v2) HashMap k v
hm2' (HashMap k v %1 -> Ur [(k, v)]
forall k v. HashMap k v %1 -> Ur [(k, v)]
toList HashMap k v
hm1')
  where
    go :: (v -> v -> v)
       -> HashMap k v -- ^ larger map
       %1-> Ur [(k, v)] -- ^ contents of the smaller map
       %1-> HashMap k v
    go :: (v -> v -> v) -> HashMap k v %1 -> Ur [(k, v)] %1 -> HashMap k v
go v -> v -> v
_ HashMap k v
hm (Ur []) = HashMap k v
hm
    go v -> v -> v
f HashMap k v
hm (Ur ((k
k, v
vr):[(k, v)]
xs)) =
      (Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
(Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v
alter (\case
        Maybe v
Nothing -> v -> Maybe v
forall a. a -> Maybe a
Just v
vr
        Just v
vl -> v -> Maybe v
forall a. a -> Maybe a
Just (v -> v -> v
f v
vl v
vr))
        k
k
        HashMap k v
hm
        HashMap k v %1 -> (HashMap k v %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \HashMap k v
hm -> (v -> v -> v) -> HashMap k v %1 -> Ur [(k, v)] %1 -> HashMap k v
go v -> v -> v
f HashMap k v
hm ([(k, v)] -> Ur [(k, v)]
forall a. a -> Ur a
Ur [(k, v)]
xs)

-- | A right-biased union.
--
-- Complexity: O(min(capacity hm1, capacity hm2)
union :: Keyed k => HashMap k v %1-> HashMap k v %1-> HashMap k v
union :: forall k v.
Keyed k =>
HashMap k v %1 -> HashMap k v %1 -> HashMap k v
union HashMap k v
hm1 HashMap k v
hm2 = (v -> v -> v) -> HashMap k v %1 -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
(v -> v -> v) -> HashMap k v %1 -> HashMap k v %1 -> HashMap k v
unionWith (\v
_v1 v
v2 -> v
v2) HashMap k v
hm1 HashMap k v
hm2

-- | Intersection of two maps with the provided combine function.
--
-- Complexity: O(min(capacity hm1, capacity hm2)
intersectionWith
  :: Keyed k
  => (a -> b -> c)
  -> HashMap k a %1-> HashMap k b %1-> HashMap k c
intersectionWith :: forall k a b c.
Keyed k =>
(a -> b -> c) -> HashMap k a %1 -> HashMap k b %1 -> HashMap k c
intersectionWith a -> b -> c
combine (HashMap k a
hm1 :: HashMap k a') HashMap k b
hm2 =
  Int -> HashMap k a %1 -> (HashMap k c, HashMap k a)
forall k k' v' v.
Keyed k =>
Int -> HashMap k' v' %1 -> (HashMap k v, HashMap k' v')
allocBeside Int
0 HashMap k a
hm1 (HashMap k c, HashMap k a)
%1 -> ((HashMap k c, HashMap k a) %1 -> HashMap k c)
%1 -> HashMap k c
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(HashMap k c
hmNew, HashMap k a
hm1') ->
    HashMap k a %1 -> (Ur Int, HashMap k a)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k a
hm1' (Ur Int, HashMap k a)
%1 -> ((Ur Int, HashMap k a) %1 -> HashMap k c) %1 -> HashMap k c
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap1, HashMap k a
hm1'') ->
      HashMap k b %1 -> (Ur Int, HashMap k b)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k b
hm2 (Ur Int, HashMap k b)
%1 -> ((Ur Int, HashMap k b) %1 -> HashMap k c) %1 -> HashMap k c
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap2, HashMap k b
hm2') ->
        if Int
cap1 Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
> Int
cap2
        then (a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
forall a b c.
(a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
go a -> b -> c
combine HashMap k a
hm1'' (HashMap k b %1 -> Ur [(k, b)]
forall k v. HashMap k v %1 -> Ur [(k, v)]
toList HashMap k b
hm2') HashMap k c
hmNew
        else (b -> a -> c)
-> HashMap k b
%1 -> Ur [(k, a)]
%1 -> HashMap k c
%1 -> HashMap k c
forall a b c.
(a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
go (\b
v2 a
v1 -> a -> b -> c
combine a
v1 b
v2) HashMap k b
hm2' (HashMap k a %1 -> Ur [(k, a)]
forall k v. HashMap k v %1 -> Ur [(k, v)]
toList HashMap k a
hm1'') HashMap k c
hmNew
 where
   -- Iterate over the smaller map, while checking for the matches
   -- on the bigger map; and accumulate results on a third map.
   go :: (a -> b -> c)
      -> HashMap k a %1-> Ur [(k, b)]
      %1-> HashMap k c %1-> HashMap k c
   go :: forall a b c.
(a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
go a -> b -> c
_ HashMap k a
hm (Ur []) HashMap k c
acc = HashMap k a
hm HashMap k a %1 -> HashMap k c %1 -> HashMap k c
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` HashMap k c
acc
   go a -> b -> c
f HashMap k a
hm (Ur ((k
k, b
b):[(k, b)]
xs)) HashMap k c
acc =
     k -> HashMap k a %1 -> (Ur (Maybe a), HashMap k a)
forall k v.
Keyed k =>
k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v)
lookup k
k HashMap k a
hm (Ur (Maybe a), HashMap k a)
%1 -> ((Ur (Maybe a), HashMap k a) %1 -> HashMap k c)
%1 -> HashMap k c
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
       (Ur Maybe a
Nothing, HashMap k a
hm') -> (a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
forall a b c.
(a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
go a -> b -> c
f HashMap k a
hm' ([(k, b)] -> Ur [(k, b)]
forall a. a -> Ur a
Ur [(k, b)]
xs) HashMap k c
acc
       (Ur (Just a
a), HashMap k a
hm') -> (a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
forall a b c.
(a -> b -> c)
-> HashMap k a
%1 -> Ur [(k, b)]
%1 -> HashMap k c
%1 -> HashMap k c
go a -> b -> c
f HashMap k a
hm' ([(k, b)] -> Ur [(k, b)]
forall a. a -> Ur a
Ur [(k, b)]
xs) (k -> c -> HashMap k c %1 -> HashMap k c
forall k v. Keyed k => k -> v -> HashMap k v %1 -> HashMap k v
insert k
k (a -> b -> c
f a
a b
b) HashMap k c
acc)

-- |
-- Reduce the 'HashMap' 'capacity' to decrease wasted memory. Returns
-- a semantically identical 'HashMap'.
--
-- This is only useful after a lot of deletes.
--
-- Complexity: O(capacity hm)
shrinkToFit :: Keyed k => HashMap k a %1-> HashMap k a
shrinkToFit :: forall k v. Keyed k => HashMap k v %1 -> HashMap k v
shrinkToFit HashMap k a
hm =
  HashMap k a %1 -> (Ur Int, HashMap k a)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
size HashMap k a
hm (Ur Int, HashMap k a)
%1 -> ((Ur Int, HashMap k a) %1 -> HashMap k a) %1 -> HashMap k a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
size, HashMap k a
hm') ->
    let targetSize :: Int
targetSize = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
          (Float -> Float -> Float
forall a. Ord a => a -> a -> a
Prelude.max Float
1 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Float -> Float -> Float
forall a. Fractional a => a -> a -> a
Prelude./ Float
constMaxLoadFactor))
    in  Int -> HashMap k a %1 -> HashMap k a
forall k v. Keyed k => Int -> HashMap k v %1 -> HashMap k v
resize Int
targetSize HashMap k a
hm'

-- # Querying
--------------------------------------------------

-- | Number of key-value pairs inside the 'HashMap'
size :: HashMap k v %1-> (Ur Int, HashMap k v)
size :: forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
size (HashMap Int
ct RobinArr k v
arr) = (Int -> Ur Int
forall a. a -> Ur a
Ur Int
ct, Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr)

-- | Maximum number of elements the HashMap can store without
-- resizing. However, for performance reasons, the 'HashMap' might be
-- before full.
--
-- Use 'shrinkToFit' to reduce the wasted space.
capacity :: HashMap k v %1-> (Ur Int, HashMap k v)
capacity :: forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity (HashMap Int
ct RobinArr k v
arr) =
  RobinArr k v %1 -> (Ur Int, RobinArr k v)
forall a. Array a %1 -> (Ur Int, Array a)
Array.size RobinArr k v
arr (Ur Int, RobinArr k v)
%1 -> ((Ur Int, RobinArr k v) %1 -> (Ur Int, HashMap k v))
%1 -> (Ur Int, HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
len, RobinArr k v
arr') ->
    (Ur Int
len, Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr')

-- | Look up a value from a 'HashMap'.
lookup :: Keyed k => k -> HashMap k v %1-> (Ur (Maybe v), HashMap k v)
lookup :: forall k v.
Keyed k =>
k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v)
lookup k
k HashMap k v
hm =
  k -> HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. Keyed k => k -> HashMap k v %1 -> (Ur Int, HashMap k v)
idealIndexForKey k
k HashMap k v
hm (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> (Ur (Maybe v), HashMap k v))
%1 -> (Ur (Maybe v), HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
idx, HashMap k v
hm') ->
    (k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
forall k v.
Keyed k =>
(k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
probeFrom (k
k,PSL
0) Int
idx HashMap k v
hm' (HashMap k v, ProbeResult k v)
%1 -> ((HashMap k v, ProbeResult k v)
       %1 -> (Ur (Maybe v), HashMap k v))
%1 -> (Ur (Maybe v), HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      (HashMap k v
h, IndexToUpdate v
v PSL
_ Int
_) ->
        (Maybe v -> Ur (Maybe v)
forall a. a -> Ur a
Ur (v -> Maybe v
forall a. a -> Maybe a
Just v
v), HashMap k v
h)
      (HashMap k v
h, IndexToInsert PSL
_ Int
_) ->
        (Maybe v -> Ur (Maybe v)
forall a. a -> Ur a
Ur Maybe v
forall a. Maybe a
Nothing, HashMap k v
h)
      (HashMap k v
h, IndexToSwap RobinVal k v
_ PSL
_ Int
_) ->
        (Maybe v -> Ur (Maybe v)
forall a. a -> Ur a
Ur Maybe v
forall a. Maybe a
Nothing, HashMap k v
h)

-- | Check if the given key exists.
member :: Keyed k => k -> HashMap k v %1-> (Ur Bool, HashMap k v)
member :: forall k v.
Keyed k =>
k -> HashMap k v %1 -> (Ur Bool, HashMap k v)
member k
k HashMap k v
hm =
  k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v)
forall k v.
Keyed k =>
k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v)
lookup k
k HashMap k v
hm (Ur (Maybe v), HashMap k v)
%1 -> ((Ur (Maybe v), HashMap k v) %1 -> (Ur Bool, HashMap k v))
%1 -> (Ur Bool, HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    (Ur Maybe v
Nothing, HashMap k v
hm') -> (Bool -> Ur Bool
forall a. a -> Ur a
Ur Bool
False, HashMap k v
hm')
    (Ur (Just v
_), HashMap k v
hm') -> (Bool -> Ur Bool
forall a. a -> Ur a
Ur Bool
True, HashMap k v
hm')

-- | Converts a HashMap to a lazy list.
toList :: HashMap k v %1-> Ur [(k, v)]
toList :: forall k v. HashMap k v %1 -> Ur [(k, v)]
toList (HashMap Int
_ RobinArr k v
arr) =
  RobinArr k v %1 -> Ur [Maybe (RobinVal k v)]
forall a. Array a %1 -> Ur [a]
Array.toList RobinArr k v
arr Ur [Maybe (RobinVal k v)]
%1 -> (Ur [Maybe (RobinVal k v)] %1 -> Ur [(k, v)])
%1 -> Ur [(k, v)]
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur [Maybe (RobinVal k v)]
elems) ->
    [Maybe (RobinVal k v)]
elems
      [Maybe (RobinVal k v)]
-> ([Maybe (RobinVal k v)] -> [RobinVal k v]) -> [RobinVal k v]
forall a b. a -> (a -> b) -> b
NonLinear.& [Maybe (RobinVal k v)] -> [RobinVal k v]
forall a. [Maybe a] -> [a]
NonLinear.catMaybes
      [RobinVal k v] -> ([RobinVal k v] -> [(k, v)]) -> [(k, v)]
forall a b. a -> (a -> b) -> b
NonLinear.& (RobinVal k v -> (k, v)) -> [RobinVal k v] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(RobinVal PSL
_ k
k v
v) -> (k
k, v
v))
      [(k, v)] -> ([(k, v)] -> Ur [(k, v)]) -> Ur [(k, v)]
forall a b. a -> (a -> b) -> b
NonLinear.& [(k, v)] -> Ur [(k, v)]
forall a. a -> Ur a
Ur

-- # Instances
--------------------------------------------------

instance Consumable (HashMap k v) where
  consume :: HashMap k v %1-> ()
  consume :: HashMap k v %1 -> ()
consume (HashMap Int
_ RobinArr k v
arr) = RobinArr k v %1 -> ()
forall a. Consumable a => a %1 -> ()
consume RobinArr k v
arr

instance Dupable (HashMap k v) where
  dup2 :: HashMap k v %1 -> (HashMap k v, HashMap k v)
dup2 (HashMap Int
i RobinArr k v
arr) = RobinArr k v %1 -> (RobinArr k v, RobinArr k v)
forall a. Dupable a => a %1 -> (a, a)
dup2 RobinArr k v
arr (RobinArr k v, RobinArr k v)
%1 -> ((RobinArr k v, RobinArr k v)
       %1 -> (HashMap k v, HashMap k v))
%1 -> (HashMap k v, HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(RobinArr k v
a1, RobinArr k v
a2) ->
    (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
i RobinArr k v
a1, Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
i RobinArr k v
a2)

instance Data.Functor (HashMap k) where
  fmap :: forall a b. (a %1 -> b) -> HashMap k a %1 -> HashMap k b
fmap a %1 -> b
f (HashMap Int
c RobinArr k a
arr) =
    Int -> RobinArr k b %1 -> HashMap k b
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
c (RobinArr k b %1 -> HashMap k b)
%1 -> RobinArr k b %1 -> HashMap k b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$
      (Maybe (RobinVal k a) %1 -> Maybe (RobinVal k b))
-> RobinArr k a %1 -> RobinArr k b
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap
        (\case
          Maybe (RobinVal k a)
Nothing -> Maybe (RobinVal k b)
forall a. Maybe a
Nothing
          Just (RobinVal PSL
p k
k a
v) -> RobinVal k b %1 -> Maybe (RobinVal k b)
forall a. a -> Maybe a
Just (PSL %1 -> k %1 -> b %1 -> RobinVal k b
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
p k
k (a %1 -> b
f a
v))
        )
        RobinArr k a
arr

instance Prelude.Semigroup (HashMap k v) where
  <> :: HashMap k v -> HashMap k v -> HashMap k v
(<>) = String -> HashMap k v -> HashMap k v -> HashMap k v
forall a. HasCallStack => String -> a
error String
"Prelude.<>: invariant violation, unrestricted HashMap"

instance Keyed k => Semigroup (HashMap k v) where
  <> :: HashMap k v %1 -> HashMap k v %1 -> HashMap k v
(<>) = HashMap k v %1 -> HashMap k v %1 -> HashMap k v
forall k v.
Keyed k =>
HashMap k v %1 -> HashMap k v %1 -> HashMap k v
union

-- # Internal library
--------------------------------------------------

_debugShow :: (Show k, Show v) => HashMap k v %1-> String
_debugShow :: forall k v. (Show k, Show v) => HashMap k v %1 -> String
_debugShow (HashMap Int
_ RobinArr k v
robinArr) =
  RobinArr k v %1 -> Ur [Maybe (RobinVal k v)]
forall a. Array a %1 -> Ur [a]
Array.toList RobinArr k v
robinArr Ur [Maybe (RobinVal k v)]
%1 -> (Ur [Maybe (RobinVal k v)] %1 -> String) %1 -> String
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur [Maybe (RobinVal k v)]
xs) -> [Maybe (RobinVal k v)] -> String
forall a. Show a => a -> String
show [Maybe (RobinVal k v)]
xs

idealIndexForKey
  :: Keyed k
  => k -> HashMap k v %1-> (Ur Int, HashMap k v)
idealIndexForKey :: forall k v. Keyed k => k -> HashMap k v %1 -> (Ur Int, HashMap k v)
idealIndexForKey k
k HashMap k v
hm =
  HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> (Ur Int, HashMap k v))
%1 -> (Ur Int, HashMap k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap k v
hm') ->
    (Int -> Ur Int
forall a. a -> Ur a
Ur (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (k -> Int
forall a. Hashable a => a -> Int
hash k
k) Int
cap), HashMap k v
hm')

-- | Given a key, psl of the probe so far, current unread index, and
-- a full hashmap, return a probe result: the place the key already
-- exists, a place to swap from, or an unfilled cell to write over.
probeFrom :: Keyed k =>
  (k, PSL) -> Int -> HashMap k v %1-> (HashMap k v, ProbeResult k v)
probeFrom :: forall k v.
Keyed k =>
(k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
probeFrom (k
k, PSL
p) Int
ix (HashMap Int
ct RobinArr k v
arr) = RobinArr k v %1 -> Int -> (Ur (Maybe (RobinVal k v)), RobinArr k v)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read RobinArr k v
arr Int
ix (Ur (Maybe (RobinVal k v)), RobinArr k v)
%1 -> ((Ur (Maybe (RobinVal k v)), RobinArr k v)
       %1 -> (HashMap k v, ProbeResult k v))
%1 -> (HashMap k v, ProbeResult k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
  (Ur Maybe (RobinVal k v)
Nothing, RobinArr k v
arr') ->
    (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr', PSL -> Int -> ProbeResult k v
forall k v. PSL -> Int -> ProbeResult k v
IndexToInsert PSL
p Int
ix)
  (Ur (Just robinVal' :: RobinVal k v
robinVal'@(RobinVal PSL
psl k
k' v
v')), RobinArr k v
arr') ->
    case k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== k
k' of
      -- Note: in the True case, we must have p == psl
      Bool
True -> (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr', v -> PSL -> Int -> ProbeResult k v
forall v k. v -> PSL -> Int -> ProbeResult k v
IndexToUpdate v
v' PSL
psl Int
ix)
      Bool
False -> case PSL
psl PSL -> PSL -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.< PSL
p of
        Bool
True -> (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr', RobinVal k v -> PSL -> Int -> ProbeResult k v
forall k v. RobinVal k v -> PSL -> Int -> ProbeResult k v
IndexToSwap RobinVal k v
robinVal' PSL
p Int
ix)
        Bool
False ->
          HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct RobinArr k v
arr') (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> (HashMap k v, ProbeResult k v))
%1 -> (HashMap k v, ProbeResult k v)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap Int
ct' RobinArr k v
arr'') ->
            (k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
forall k v.
Keyed k =>
(k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
probeFrom (k
k, PSL
pPSL -> PSL -> PSL
forall a. Num a => a -> a -> a
+PSL
1) ((Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
cap) (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct' RobinArr k v
arr'')

-- | Try to insert at a given index with a given PSL. So the
-- probing starts from the given index (with the given PSL).
tryInsertAtIndex :: Keyed k =>
  HashMap k v %1-> Int -> RobinVal k v -> HashMap k v
tryInsertAtIndex :: forall k v.
Keyed k =>
HashMap k v %1 -> Int -> RobinVal k v -> HashMap k v
tryInsertAtIndex HashMap k v
hmap Int
ix (RobinVal PSL
psl k
key v
val) =
  (k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
forall k v.
Keyed k =>
(k, PSL) -> Int -> HashMap k v %1 -> (HashMap k v, ProbeResult k v)
probeFrom (k
key, PSL
psl) Int
ix HashMap k v
hmap (HashMap k v, ProbeResult k v)
%1 -> ((HashMap k v, ProbeResult k v) %1 -> HashMap k v)
%1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    (HashMap Int
ct RobinArr k v
arr, IndexToUpdate v
_ PSL
psl' Int
ix') ->
      Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix' (RobinVal k v %1 -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (RobinVal k v %1 -> Maybe (RobinVal k v))
%1 -> RobinVal k v %1 -> Maybe (RobinVal k v)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl' k
key v
val))
    (HashMap Int
c RobinArr k v
arr, IndexToInsert PSL
psl' Int
ix') ->
      Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix' (RobinVal k v %1 -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (RobinVal k v %1 -> Maybe (RobinVal k v))
%1 -> RobinVal k v %1 -> Maybe (RobinVal k v)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl' k
key v
val))
    (HashMap k v
hm, IndexToSwap RobinVal k v
oldVal PSL
psl' Int
ix') ->
      HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm  (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap Int
ct RobinArr k v
arr) ->
        HashMap k v %1 -> Int -> RobinVal k v -> HashMap k v
forall k v.
Keyed k =>
HashMap k v %1 -> Int -> RobinVal k v -> HashMap k v
tryInsertAtIndex
          (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
ct (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr Int
ix' (RobinVal k v %1 -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (RobinVal k v %1 -> Maybe (RobinVal k v))
%1 -> RobinVal k v %1 -> Maybe (RobinVal k v)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ PSL -> k -> v -> RobinVal k v
forall k v. PSL -> k -> v -> RobinVal k v
RobinVal PSL
psl' k
key v
val)))
          ((Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
cap)
          (RobinVal k v -> RobinVal k v
forall k v. RobinVal k v -> RobinVal k v
incRobinValPSL RobinVal k v
oldVal)

-- | Shift all cells with PSLs > 0 in a continuous segment
-- following the deleted cell, backwards by one and decrement
-- their PSLs.
shiftSegmentBackward :: Keyed k =>
  Int -> Int -> RobinArr k v %1-> Int -> RobinArr k v
shiftSegmentBackward :: forall k v.
Keyed k =>
Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
shiftSegmentBackward Int
dec Int
s RobinArr k v
arr Int
ix = RobinArr k v %1 -> Int -> (Ur (Maybe (RobinVal k v)), RobinArr k v)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read RobinArr k v
arr Int
ix (Ur (Maybe (RobinVal k v)), RobinArr k v)
%1 -> ((Ur (Maybe (RobinVal k v)), RobinArr k v)
       %1 -> RobinArr k v)
%1 -> RobinArr k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
  (Ur Maybe (RobinVal k v)
Nothing, RobinArr k v
arr') -> RobinArr k v
arr'
  (Ur (Just (RobinVal PSL
0 k
_ v
_)), RobinArr k v
arr') -> RobinArr k v
arr'
  (Ur (Just RobinVal k v
val), RobinArr k v
arr') ->
    RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr' Int
ix Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
%1 -> (RobinArr k v %1 -> RobinArr k v) %1 -> RobinArr k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \RobinArr k v
arr'' ->
      Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
forall k v.
Keyed k =>
Int -> Int -> RobinArr k v %1 -> Int -> RobinArr k v
shiftSegmentBackward
        Int
dec
        Int
s
        (RobinArr k v %1 -> Int -> Maybe (RobinVal k v) -> RobinArr k v
forall a. HasCallStack => Array a %1 -> Int -> a -> Array a
Array.write RobinArr k v
arr'' ((Int
ixInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
decInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
s) (RobinVal k v %1 -> Maybe (RobinVal k v)
forall a. a -> Maybe a
Just (RobinVal k v %1 -> Maybe (RobinVal k v))
%1 -> RobinVal k v %1 -> Maybe (RobinVal k v)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ RobinVal k v -> RobinVal k v
forall k v. RobinVal k v -> RobinVal k v
decRobinValPSL RobinVal k v
val))
        ((Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
s)
-- TODO: This does twice as much writes than necessary, it first empties
-- the cell, just to update it again at the next call. We can save some
-- writes by only emptying the last cell.

-- | Makes sure that the map is not exceeding its utilization threshold
-- (constMaxUtilization), resizes (constGrowthFactor) if necessary.
growMapIfNecessary :: Keyed k => HashMap k v %1-> HashMap k v
growMapIfNecessary :: forall k v. Keyed k => HashMap k v %1 -> HashMap k v
growMapIfNecessary HashMap k v
hm =
  HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
capacity HashMap k v
hm (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, HashMap k v
hm') ->
   HashMap k v %1 -> (Ur Int, HashMap k v)
forall k v. HashMap k v %1 -> (Ur Int, HashMap k v)
size HashMap k v
hm' (Ur Int, HashMap k v)
%1 -> ((Ur Int, HashMap k v) %1 -> HashMap k v) %1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
sz, HashMap k v
hm'') ->
    let load :: Float
load = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cap
    in if Float
load Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.< Float
constMaxLoadFactor
       then HashMap k v
hm''
       else
         let newCap :: Int
newCap = Int %1 -> Int %1 -> Int
forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
max Int
1 (Int
cap Int %1 -> Int %1 -> Int
forall a. Multiplicative a => a %1 -> a %1 -> a
* Int
constGrowthFactor)
         in  Int -> HashMap k v %1 -> HashMap k v
forall k v. Keyed k => Int -> HashMap k v %1 -> HashMap k v
resize Int
newCap HashMap k v
hm''

-- | Resizes the HashMap to given capacity.
--
-- Invariant: Given capacity should be greater than the size, this is not
-- checked.
resize :: Keyed k => Int -> HashMap k v %1-> HashMap k v
resize :: forall k v. Keyed k => Int -> HashMap k v %1 -> HashMap k v
resize Int
targetSize (HashMap Int
_ RobinArr k v
arr) =
  Int
-> Maybe (RobinVal k v)
-> RobinArr k v
%1 -> (RobinArr k v, RobinArr k v)
forall a b. Int -> a -> Array b %1 -> (Array a, Array b)
Array.allocBeside Int
targetSize Maybe (RobinVal k v)
forall a. Maybe a
Nothing RobinArr k v
arr (RobinArr k v, RobinArr k v)
%1 -> ((RobinArr k v, RobinArr k v) %1 -> HashMap k v)
%1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(RobinArr k v
newArr, RobinArr k v
oldArr) ->
    RobinArr k v %1 -> Ur [Maybe (RobinVal k v)]
forall a. Array a %1 -> Ur [a]
Array.toList RobinArr k v
oldArr Ur [Maybe (RobinVal k v)]
%1 -> (Ur [Maybe (RobinVal k v)] %1 -> HashMap k v)
%1 -> HashMap k v
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur [Maybe (RobinVal k v)]
elems) ->
      let xs :: [(k, v)]
xs =
            [Maybe (RobinVal k v)]
elems
              [Maybe (RobinVal k v)]
-> ([Maybe (RobinVal k v)] -> [RobinVal k v]) -> [RobinVal k v]
forall a b. a -> (a -> b) -> b
NonLinear.& [Maybe (RobinVal k v)] -> [RobinVal k v]
forall a. [Maybe a] -> [a]
NonLinear.catMaybes
              [RobinVal k v] -> ([RobinVal k v] -> [(k, v)]) -> [(k, v)]
forall a b. a -> (a -> b) -> b
NonLinear.& (RobinVal k v -> (k, v)) -> [RobinVal k v] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(RobinVal PSL
_ k
k v
v) -> (k
k, v
v))
       in  [(k, v)] -> HashMap k v %1 -> HashMap k v
forall k v. Keyed k => [(k, v)] -> HashMap k v %1 -> HashMap k v
insertAll [(k, v)]
xs (Int -> RobinArr k v %1 -> HashMap k v
forall k v. Int -> RobinArr k v -> HashMap k v
HashMap Int
0 RobinArr k v
newArr)
-- TODO: 'insertAll' keeps checking capacity on each insert. We should
-- replace it with a faster unsafe variant.