{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE LambdaCase #-}
#if __GLASGOW_HASKELL__ >= 802
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedSums #-}
#endif
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.

module Data.HashMap.Internal
    (
      HashMap(..)
    , Leaf(..)

      -- * Construction
    , empty
    , singleton

      -- * Basic interface
    , null
    , size
    , member
    , lookup
    , (!?)
    , findWithDefault
    , lookupDefault
    , (!)
    , insert
    , insertWith
    , unsafeInsert
    , delete
    , adjust
    , update
    , alter
    , alterF
    , isSubmapOf
    , isSubmapOfBy

      -- * Combine
      -- ** Union
    , union
    , unionWith
    , unionWithKey
    , unions

    -- ** Compose
    , compose

      -- * Transformations
    , map
    , mapWithKey
    , traverseWithKey
    , mapKeys

      -- * Difference and intersection
    , difference
    , differenceWith
    , intersection
    , intersectionWith
    , intersectionWithKey

      -- * Folds
    , foldr'
    , foldl'
    , foldrWithKey'
    , foldlWithKey'
    , foldr
    , foldl
    , foldrWithKey
    , foldlWithKey
    , foldMapWithKey

      -- * Filter
    , mapMaybe
    , mapMaybeWithKey
    , filter
    , filterWithKey

      -- * Conversions
    , keys
    , elems

      -- ** Lists
    , toList
    , fromList
    , fromListWith
    , fromListWithKey

      -- Internals used by the strict version
    , Hash
    , Bitmap
    , bitmapIndexedOrFull
    , collision
    , hash
    , mask
    , index
    , bitsPerSubkey
    , fullNodeMask
    , sparseIndex
    , two
    , unionArrayBy
    , update16
    , update16M
    , update16With'
    , updateOrConcatWith
    , updateOrConcatWithKey
    , filterMapAux
    , equalKeys
    , equalKeys1
    , lookupRecordCollision
    , LookupRes(..)
    , insert'
    , delete'
    , lookup'
    , insertNewKey
    , insertKeyExists
    , deleteKeyExists
    , insertModifying
    , ptrEq
    , adjust#
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), Applicative(pure))
import Data.Monoid (Monoid(mempty, mappend))
import Data.Traversable (Traversable(..))
import Data.Word (Word)
#endif
#if __GLASGOW_HASKELL__ >= 711
import Data.Semigroup (Semigroup((<>)))
#endif
import Control.DeepSeq (NFData(rnf))
import Control.Monad.ST (ST)
import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR)
import Data.Data hiding (Typeable)
import qualified Data.Foldable as Foldable
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable
#endif
import qualified Data.List as L
import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, inline)
import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred)
import Text.Read hiding (step)

import qualified Data.HashMap.Internal.Array as A
import qualified Data.Hashable as H
import Data.Hashable (Hashable)
import Data.HashMap.Internal.Unsafe (runST)
import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare)
import Data.Typeable (Typeable)

import GHC.Exts (isTrue#)
import qualified GHC.Exts as Exts

#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
import GHC.Stack
#endif

#if MIN_VERSION_hashable(1,2,5)
import qualified Data.Hashable.Lifted as H
#endif

#if MIN_VERSION_deepseq(1,4,3)
import qualified Control.DeepSeq as NF
#endif

#if __GLASGOW_HASKELL__ >= 802
import GHC.Exts (TYPE, Int (..), Int#)
#endif

#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity (..))
#endif
import Control.Applicative (Const (..))
import Data.Coerce (coerce)

-- | A set of values.  A set cannot contain duplicate values.
------------------------------------------------------------------------

-- | Convenience function.  Compute a hash value for the given value.
hash :: H.Hashable a => a -> Hash
hash :: a -> Hash
hash = Int -> Hash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Hash) -> (a -> Int) -> a -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Hashable a => a -> Int
H.hash

data Leaf k v = L !k v
  deriving (Leaf k v -> Leaf k v -> Bool
(Leaf k v -> Leaf k v -> Bool)
-> (Leaf k v -> Leaf k v -> Bool) -> Eq (Leaf k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Leaf k v -> Leaf k v -> Bool
/= :: Leaf k v -> Leaf k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Leaf k v -> Leaf k v -> Bool
== :: Leaf k v -> Leaf k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Leaf k v -> Leaf k v -> Bool
Eq)

instance (NFData k, NFData v) => NFData (Leaf k v) where
    rnf :: Leaf k v -> ()
rnf (L k
k v
v) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` v -> ()
forall a. NFData a => a -> ()
rnf v
v

#if MIN_VERSION_deepseq(1,4,3)
-- | @since 0.2.14.0
instance NFData k => NF.NFData1 (Leaf k) where
    liftRnf :: (a -> ()) -> Leaf k a -> ()
liftRnf a -> ()
rnf2 = (k -> ()) -> (a -> ()) -> Leaf k a -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 k -> ()
forall a. NFData a => a -> ()
rnf a -> ()
rnf2

-- | @since 0.2.14.0
instance NF.NFData2 Leaf where
    liftRnf2 :: (a -> ()) -> (b -> ()) -> Leaf a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (L a
k b
v) = a -> ()
rnf1 a
k () -> () -> ()
`seq` b -> ()
rnf2 b
v
#endif

-- Invariant: The length of the 1st argument to 'Full' is
-- 2^bitsPerSubkey

-- | A map from keys to values.  A map cannot contain duplicate keys;
-- each key can map to at most one value.
data HashMap k v
    = Empty
    | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
    | Leaf !Hash !(Leaf k v)
    | Full !(A.Array (HashMap k v))
    | Collision !Hash !(A.Array (Leaf k v))
      deriving (Typeable)

type role HashMap nominal representational

instance (NFData k, NFData v) => NFData (HashMap k v) where
    rnf :: HashMap k v -> ()
rnf HashMap k v
Empty                 = ()
    rnf (BitmapIndexed Hash
_ Array (HashMap k v)
ary) = Array (HashMap k v) -> ()
forall a. NFData a => a -> ()
rnf Array (HashMap k v)
ary
    rnf (Leaf Hash
_ Leaf k v
l)            = Leaf k v -> ()
forall a. NFData a => a -> ()
rnf Leaf k v
l
    rnf (Full Array (HashMap k v)
ary)            = Array (HashMap k v) -> ()
forall a. NFData a => a -> ()
rnf Array (HashMap k v)
ary
    rnf (Collision Hash
_ Array (Leaf k v)
ary)     = Array (Leaf k v) -> ()
forall a. NFData a => a -> ()
rnf Array (Leaf k v)
ary

#if MIN_VERSION_deepseq(1,4,3)
-- | @since 0.2.14.0
instance NFData k => NF.NFData1 (HashMap k) where
    liftRnf :: (a -> ()) -> HashMap k a -> ()
liftRnf a -> ()
rnf2 = (k -> ()) -> (a -> ()) -> HashMap k a -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 k -> ()
forall a. NFData a => a -> ()
rnf a -> ()
rnf2

-- | @since 0.2.14.0
instance NF.NFData2 HashMap where
    liftRnf2 :: (a -> ()) -> (b -> ()) -> HashMap a b -> ()
liftRnf2 a -> ()
_ b -> ()
_ HashMap a b
Empty                       = ()
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (BitmapIndexed Hash
_ Array (HashMap a b)
ary) = (HashMap a b -> ()) -> Array (HashMap a b) -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
NF.liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (HashMap a b)
ary
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Leaf Hash
_ Leaf a b
l)            = (a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 a -> ()
rnf1 b -> ()
rnf2 Leaf a b
l
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Full Array (HashMap a b)
ary)            = (HashMap a b -> ()) -> Array (HashMap a b) -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
NF.liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (HashMap a b)
ary
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Collision Hash
_ Array (Leaf a b)
ary)     = (Leaf a b -> ()) -> Array (Leaf a b) -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
NF.liftRnf ((a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (Leaf a b)
ary
#endif

instance Functor (HashMap k) where
    fmap :: (a -> b) -> HashMap k a -> HashMap k b
fmap = (a -> b) -> HashMap k a -> HashMap k b
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
map

instance Foldable.Foldable (HashMap k) where
    foldMap :: (a -> m) -> HashMap k a -> m
foldMap a -> m
f = (k -> a -> m) -> HashMap k a -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldMapWithKey (\ k
_k a
v -> a -> m
f a
v)
    {-# INLINE foldMap #-}
    foldr :: (a -> b -> b) -> b -> HashMap k a -> b
foldr = (a -> b -> b) -> b -> HashMap k a -> b
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr
    {-# INLINE foldr #-}
    foldl :: (b -> a -> b) -> b -> HashMap k a -> b
foldl = (b -> a -> b) -> b -> HashMap k a -> b
forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl
    {-# INLINE foldl #-}
    foldr' :: (a -> b -> b) -> b -> HashMap k a -> b
foldr' = (a -> b -> b) -> b -> HashMap k a -> b
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr'
    {-# INLINE foldr' #-}
    foldl' :: (b -> a -> b) -> b -> HashMap k a -> b
foldl' = (b -> a -> b) -> b -> HashMap k a -> b
forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl'
    {-# INLINE foldl' #-}
#if MIN_VERSION_base(4,8,0)
    null :: HashMap k a -> Bool
null = HashMap k a -> Bool
forall k a. HashMap k a -> Bool
null
    {-# INLINE null #-}
    length :: HashMap k a -> Int
length = HashMap k a -> Int
forall k a. HashMap k a -> Int
size
    {-# INLINE length #-}
#endif

#if MIN_VERSION_base(4,10,0)
-- | @since 0.2.11
instance Bifoldable HashMap where
    bifoldMap :: (a -> m) -> (b -> m) -> HashMap a b -> m
bifoldMap a -> m
f b -> m
g = (a -> b -> m) -> HashMap a b -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldMapWithKey (\ a
k b
v -> a -> m
f a
k m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` b -> m
g b
v)
    {-# INLINE bifoldMap #-}
    bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> HashMap a b -> c
bifoldr a -> c -> c
f b -> c -> c
g = (a -> b -> c -> c) -> c -> HashMap a b -> c
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (\ a
k b
v c
acc -> a
k a -> c -> c
`f` (b
v b -> c -> c
`g` c
acc))
    {-# INLINE bifoldr #-}
    bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> HashMap a b -> c
bifoldl c -> a -> c
f c -> b -> c
g = (c -> a -> b -> c) -> c -> HashMap a b -> c
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey (\ c
acc a
k b
v -> (c
acc c -> a -> c
`f` a
k) c -> b -> c
`g` b
v)
    {-# INLINE bifoldl #-}
#endif

#if __GLASGOW_HASKELL__ >= 711
-- | '<>' = 'union'
--
-- If a key occurs in both maps, the mapping from the first will be the mapping in the result.
--
-- ==== __Examples__
--
-- >>> fromList [(1,'a'),(2,'b')] <> fromList [(2,'c'),(3,'d')]
-- fromList [(1,'a'),(2,'b'),(3,'d')]
instance (Eq k, Hashable k) => Semigroup (HashMap k v) where
  <> :: HashMap k v -> HashMap k v -> HashMap k v
(<>) = HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
union
  {-# INLINE (<>) #-}
#endif

-- | 'mempty' = 'empty'
--
-- 'mappend' = 'union'
--
-- If a key occurs in both maps, the mapping from the first will be the mapping in the result.
--
-- ==== __Examples__
--
-- >>> mappend (fromList [(1,'a'),(2,'b')]) (fromList [(2,'c'),(3,'d')])
-- fromList [(1,'a'),(2,'b'),(3,'d')]
instance (Eq k, Hashable k) => Monoid (HashMap k v) where
  mempty :: HashMap k v
mempty = HashMap k v
forall k v. HashMap k v
empty
  {-# INLINE mempty #-}
#if __GLASGOW_HASKELL__ >= 711
  mappend :: HashMap k v -> HashMap k v -> HashMap k v
mappend = HashMap k v -> HashMap k v -> HashMap k v
forall a. Semigroup a => a -> a -> a
(<>)
#else
  mappend = union
#endif
  {-# INLINE mappend #-}

instance (Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashMap k v -> c (HashMap k v)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z HashMap k v
m   = ([(k, v)] -> HashMap k v) -> c ([(k, v)] -> HashMap k v)
forall g. g -> c g
z [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList c ([(k, v)] -> HashMap k v) -> [(k, v)] -> c (HashMap k v)
forall d b. Data d => c (d -> b) -> d -> c b
`f` HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap k v
m
    toConstr :: HashMap k v -> Constr
toConstr HashMap k v
_     = Constr
fromListConstr
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HashMap k v)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
        Int
1 -> c ([(k, v)] -> HashMap k v) -> c (HashMap k v)
forall b r. Data b => c (b -> r) -> c r
k (([(k, v)] -> HashMap k v) -> c ([(k, v)] -> HashMap k v)
forall r. r -> c r
z [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList)
        Int
_ -> [Char] -> c (HashMap k v)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
    dataTypeOf :: HashMap k v -> DataType
dataTypeOf HashMap k v
_   = DataType
hashMapDataType
    dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HashMap k v))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f    = c (t k v) -> Maybe (c (HashMap k v))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t k v)
forall d e. (Data d, Data e) => c (t d e)
f

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
hashMapDataType [Char]
"fromList" [] Fixity
Prefix

hashMapDataType :: DataType
hashMapDataType :: DataType
hashMapDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.HashMap.Internal.HashMap" [Constr
fromListConstr]

type Hash   = Word
type Bitmap = Word
type Shift  = Int

#if MIN_VERSION_base(4,9,0)
instance Show2 HashMap where
    liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> HashMap a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
d HashMap a b
m =
        (Int -> [(a, b)] -> ShowS) -> [Char] -> Int -> [(a, b)] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith ((Int -> (a, b) -> ShowS)
-> ([(a, b)] -> ShowS) -> Int -> [(a, b)] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> (a, b) -> ShowS
sp [(a, b)] -> ShowS
sl) [Char]
"fromList" Int
d (HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap a b
m)
      where
        sp :: Int -> (a, b) -> ShowS
sp = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv
        sl :: [(a, b)] -> ShowS
sl = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv

instance Show k => Show1 (HashMap k) where
    liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> HashMap k a -> ShowS
liftShowsPrec = (Int -> k -> ShowS)
-> ([k] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> HashMap k a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [k] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance (Eq k, Hashable k, Read k) => Read1 (HashMap k) where
    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (HashMap k a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = ([Char] -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a)
forall a. ([Char] -> ReadS a) -> Int -> ReadS a
readsData (([Char] -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a))
-> ([Char] -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a)
forall a b. (a -> b) -> a -> b
$
        (Int -> ReadS [(k, a)])
-> [Char]
-> ([(k, a)] -> HashMap k a)
-> [Char]
-> ReadS (HashMap k a)
forall a t.
(Int -> ReadS a) -> [Char] -> (a -> t) -> [Char] -> ReadS t
readsUnaryWith ((Int -> ReadS (k, a)) -> ReadS [(k, a)] -> Int -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (k, a)
rp' ReadS [(k, a)]
rl') [Char]
"fromList" [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList
      where
        rp' :: Int -> ReadS (k, a)
rp' = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (k, a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl
        rl' :: ReadS [(k, a)]
rl' = (Int -> ReadS a) -> ReadS [a] -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
#endif

instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where
    readPrec :: ReadPrec (HashMap k e)
readPrec = ReadPrec (HashMap k e) -> ReadPrec (HashMap k e)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (HashMap k e) -> ReadPrec (HashMap k e))
-> ReadPrec (HashMap k e) -> ReadPrec (HashMap k e)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (HashMap k e) -> ReadPrec (HashMap k e)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (HashMap k e) -> ReadPrec (HashMap k e))
-> ReadPrec (HashMap k e) -> ReadPrec (HashMap k e)
forall a b. (a -> b) -> a -> b
$ do
      Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
      [(k, e)]
xs <- ReadPrec [(k, e)]
forall a. Read a => ReadPrec a
readPrec
      HashMap k e -> ReadPrec (HashMap k e)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, e)] -> HashMap k e
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList [(k, e)]
xs)

    readListPrec :: ReadPrec [HashMap k e]
readListPrec = ReadPrec [HashMap k e]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance (Show k, Show v) => Show (HashMap k v) where
    showsPrec :: Int -> HashMap k v -> ShowS
showsPrec Int
d HashMap k v
m = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> ShowS
forall a. Show a => a -> ShowS
shows (HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap k v
m)

instance Traversable (HashMap k) where
    traverse :: (a -> f b) -> HashMap k a -> f (HashMap k b)
traverse a -> f b
f = (k -> a -> f b) -> HashMap k a -> f (HashMap k b)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
traverseWithKey ((a -> f b) -> k -> a -> f b
forall a b. a -> b -> a
const a -> f b
f)
    {-# INLINABLE traverse #-}

#if MIN_VERSION_base(4,9,0)
instance Eq2 HashMap where
    liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
liftEq2 = (a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
equal2

instance Eq k => Eq1 (HashMap k) where
    liftEq :: (a -> b -> Bool) -> HashMap k a -> HashMap k b -> Bool
liftEq = (a -> b -> Bool) -> HashMap k a -> HashMap k b -> Bool
forall k v v'.
Eq k =>
(v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1
#endif

-- | Note that, in the presence of hash collisions, equal @HashMap@s may
-- behave differently, i.e. substitutivity may be violated:
--
-- >>> data D = A | B deriving (Eq, Show)
-- >>> instance Hashable D where hashWithSalt salt _d = salt
--
-- >>> x = fromList [(A,1), (B,2)]
-- >>> y = fromList [(B,2), (A,1)]
--
-- >>> x == y
-- True
-- >>> toList x
-- [(A,1),(B,2)]
-- >>> toList y
-- [(B,2),(A,1)]
--
-- In general, the lack of substitutivity can be observed with any function
-- that depends on the key ordering, such as folds and traversals.
instance (Eq k, Eq v) => Eq (HashMap k v) where
    == :: HashMap k v -> HashMap k v -> Bool
(==) = (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall k v v'.
Eq k =>
(v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- We rely on there being no Empty constructors in the tree!
-- This ensures that two equal HashMaps will have the same
-- shape, modulo the order of entries in Collisions.
equal1 :: Eq k
       => (v -> v' -> Bool)
       -> HashMap k v -> HashMap k v' -> Bool
equal1 :: (v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1 v -> v' -> Bool
eq = HashMap k v -> HashMap k v' -> Bool
go
  where
    go :: HashMap k v -> HashMap k v' -> Bool
go HashMap k v
Empty HashMap k v'
Empty = Bool
True
    go (BitmapIndexed Hash
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Hash
bm2 Array (HashMap k v')
ary2)
      = Hash
bm1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
bm2 Bool -> Bool -> Bool
&& (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Leaf Hash
h1 Leaf k v
l1) (Leaf Hash
h2 Leaf k v'
l2) = Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2 Bool -> Bool -> Bool
&& Leaf k v -> Leaf k v' -> Bool
leafEq Leaf k v
l1 Leaf k v'
l2
    go (Full Array (HashMap k v)
ary1) (Full Array (HashMap k v')
ary2) = (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Collision Hash
h1 Array (Leaf k v)
ary1) (Collision Hash
h2 Array (Leaf k v')
ary2)
      = Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2 Bool -> Bool -> Bool
&& (Leaf k v -> Leaf k v' -> Bool)
-> [Leaf k v] -> [Leaf k v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k v') -> [Leaf k v']
forall a. Array a -> [a]
A.toList Array (Leaf k v')
ary2)
    go HashMap k v
_ HashMap k v'
_ = Bool
False

    leafEq :: Leaf k v -> Leaf k v' -> Bool
leafEq (L k
k1 v
v1) (L k
k2 v'
v2) = k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2 Bool -> Bool -> Bool
&& v -> v' -> Bool
eq v
v1 v'
v2

equal2 :: (k -> k' -> Bool) -> (v -> v' -> Bool)
      -> HashMap k v -> HashMap k' v' -> Bool
equal2 :: (k -> k' -> Bool)
-> (v -> v' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equal2 k -> k' -> Bool
eqk v -> v' -> Bool
eqv HashMap k v
t1 HashMap k' v'
t2 = [HashMap k v] -> [HashMap k' v'] -> Bool
go (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k' v'
t2 [])
  where
    -- If the two trees are the same, then their lists of 'Leaf's and
    -- 'Collision's read from left to right should be the same (modulo the
    -- order of elements in 'Collision').

    go :: [HashMap k v] -> [HashMap k' v'] -> Bool
go (Leaf Hash
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Hash
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Hash
k1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
k2 Bool -> Bool -> Bool
&&
        Leaf k v -> Leaf k' v' -> Bool
leafEq Leaf k v
l1 Leaf k' v'
l2
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Collision Hash
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Hash
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Hash
k1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
k2 Bool -> Bool -> Bool
&&
        Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        (Leaf k v -> Leaf k' v' -> Bool)
-> [Leaf k v] -> [Leaf k' v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2)
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go [] [] = Bool
True
    go [HashMap k v]
_  [HashMap k' v']
_  = Bool
False

    leafEq :: Leaf k v -> Leaf k' v' -> Bool
leafEq (L k
k v
v) (L k'
k' v'
v') = k -> k' -> Bool
eqk k
k k'
k' Bool -> Bool -> Bool
&& v -> v' -> Bool
eqv v
v v'
v'

#if MIN_VERSION_base(4,9,0)
instance Ord2 HashMap where
    liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
liftCompare2 = (a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
cmp

instance Ord k => Ord1 (HashMap k) where
    liftCompare :: (a -> b -> Ordering) -> HashMap k a -> HashMap k b -> Ordering
liftCompare = (k -> k -> Ordering)
-> (a -> b -> Ordering) -> HashMap k a -> HashMap k b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
cmp k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#endif

-- | The ordering is total and consistent with the `Eq` instance. However,
-- nothing else about the ordering is specified, and it may change from
-- version to version of either this package or of hashable.
instance (Ord k, Ord v) => Ord (HashMap k v) where
    compare :: HashMap k v -> HashMap k v -> Ordering
compare = (k -> k -> Ordering)
-> (v -> v -> Ordering) -> HashMap k v -> HashMap k v -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
cmp k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
    -> HashMap k v -> HashMap k' v' -> Ordering
cmp :: (k -> k' -> Ordering)
-> (v -> v' -> Ordering)
-> HashMap k v
-> HashMap k' v'
-> Ordering
cmp k -> k' -> Ordering
cmpk v -> v' -> Ordering
cmpv HashMap k v
t1 HashMap k' v'
t2 = [HashMap k v] -> [HashMap k' v'] -> Ordering
go (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k' v'
t2 [])
  where
    go :: [HashMap k v] -> [HashMap k' v'] -> Ordering
go (Leaf Hash
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Hash
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      = Hash -> Hash -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Hash
k1 Hash
k2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        Leaf k v -> Leaf k' v' -> Ordering
leafCompare Leaf k v
l1 Leaf k' v'
l2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        [HashMap k v] -> [HashMap k' v'] -> Ordering
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Collision Hash
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Hash
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      = Hash -> Hash -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Hash
k1 Hash
k2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1) (Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        (Leaf k v -> Leaf k' v' -> Ordering)
-> [Leaf k v] -> [Leaf k' v'] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
unorderedCompare Leaf k v -> Leaf k' v' -> Ordering
leafCompare (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        [HashMap k v] -> [HashMap k' v'] -> Ordering
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Leaf Hash
_ Leaf k v
_ : [HashMap k v]
_) (Collision Hash
_ Array (Leaf k' v')
_ : [HashMap k' v']
_) = Ordering
LT
    go (Collision Hash
_ Array (Leaf k v)
_ : [HashMap k v]
_) (Leaf Hash
_ Leaf k' v'
_ : [HashMap k' v']
_) = Ordering
GT
    go [] [] = Ordering
EQ
    go [] [HashMap k' v']
_  = Ordering
LT
    go [HashMap k v]
_  [] = Ordering
GT
    go [HashMap k v]
_ [HashMap k' v']
_ = [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"cmp: Should never happen, toList' includes non Leaf / Collision"

    leafCompare :: Leaf k v -> Leaf k' v' -> Ordering
leafCompare (L k
k v
v) (L k'
k' v'
v') = k -> k' -> Ordering
cmpk k
k k'
k' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` v -> v' -> Ordering
cmpv v
v v'
v'

-- Same as 'equal' but doesn't compare the values.
equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equalKeys1 k -> k' -> Bool
eq HashMap k v
t1 HashMap k' v'
t2 = [HashMap k v] -> [HashMap k' v'] -> Bool
go (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap k' v'
t2 [])
  where
    go :: [HashMap k v] -> [HashMap k' v'] -> Bool
go (Leaf Hash
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Hash
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Hash
k1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
k2 Bool -> Bool -> Bool
&& Leaf k v -> Leaf k' v' -> Bool
leafEq Leaf k v
l1 Leaf k' v'
l2
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Collision Hash
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Hash
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Hash
k1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
k2 Bool -> Bool -> Bool
&& Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        (Leaf k v -> Leaf k' v' -> Bool)
-> [Leaf k v] -> [Leaf k' v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2)
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go [] [] = Bool
True
    go [HashMap k v]
_  [HashMap k' v']
_  = Bool
False

    leafEq :: Leaf k v -> Leaf k' v' -> Bool
leafEq (L k
k v
_) (L k'
k' v'
_) = k -> k' -> Bool
eq k
k k'
k'

-- Same as 'equal1' but doesn't compare the values.
equalKeys :: Eq k => HashMap k v -> HashMap k v' -> Bool
equalKeys :: HashMap k v -> HashMap k v' -> Bool
equalKeys = HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go
  where
    go :: Eq k => HashMap k v -> HashMap k v' -> Bool
    go :: HashMap k v -> HashMap k v' -> Bool
go HashMap k v
Empty HashMap k v'
Empty = Bool
True
    go (BitmapIndexed Hash
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Hash
bm2 Array (HashMap k v')
ary2)
      = Hash
bm1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
bm2 Bool -> Bool -> Bool
&& (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Leaf Hash
h1 Leaf k v
l1) (Leaf Hash
h2 Leaf k v'
l2) = Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2 Bool -> Bool -> Bool
&& Leaf k v -> Leaf k v' -> Bool
forall a v v. Eq a => Leaf a v -> Leaf a v -> Bool
leafEq Leaf k v
l1 Leaf k v'
l2
    go (Full Array (HashMap k v)
ary1) (Full Array (HashMap k v')
ary2) = (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Collision Hash
h1 Array (Leaf k v)
ary1) (Collision Hash
h2 Array (Leaf k v')
ary2)
      = Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2 Bool -> Bool -> Bool
&& (Leaf k v -> Leaf k v' -> Bool)
-> [Leaf k v] -> [Leaf k v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k v' -> Bool
forall a v v. Eq a => Leaf a v -> Leaf a v -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k v') -> [Leaf k v']
forall a. Array a -> [a]
A.toList Array (Leaf k v')
ary2)
    go HashMap k v
_ HashMap k v'
_ = Bool
False

    leafEq :: Leaf a v -> Leaf a v -> Bool
leafEq (L a
k1 v
_) (L a
k2 v
_) = a
k1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k2

#if MIN_VERSION_hashable(1,2,5)
instance H.Hashable2 HashMap where
    liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> HashMap a b -> Int
liftHashWithSalt2 Int -> a -> Int
hk Int -> b -> Int
hv Int
salt HashMap a b
hm = Int -> [HashMap a b] -> Int
go Int
salt (HashMap a b -> [HashMap a b] -> [HashMap a b]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' HashMap a b
hm [])
      where
        -- go :: Int -> [HashMap k v] -> Int
        go :: Int -> [HashMap a b] -> Int
go Int
s [] = Int
s
        go Int
s (Leaf Hash
_ Leaf a b
l : [HashMap a b]
tl)
          = Int
s Int -> Leaf a b -> Int
`hashLeafWithSalt` Leaf a b
l Int -> [HashMap a b] -> Int
`go` [HashMap a b]
tl
        -- For collisions we hashmix hash value
        -- and then array of values' hashes sorted
        go Int
s (Collision Hash
h Array (Leaf a b)
a : [HashMap a b]
tl)
          = (Int
s Int -> Hash -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Hash
h) Int -> Array (Leaf a b) -> Int
`hashCollisionWithSalt` Array (Leaf a b)
a Int -> [HashMap a b] -> Int
`go` [HashMap a b]
tl
        go Int
s (HashMap a b
_ : [HashMap a b]
tl) = Int
s Int -> [HashMap a b] -> Int
`go` [HashMap a b]
tl

        -- hashLeafWithSalt :: Int -> Leaf k v -> Int
        hashLeafWithSalt :: Int -> Leaf a b -> Int
hashLeafWithSalt Int
s (L a
k b
v) = (Int
s Int -> a -> Int
`hk` a
k) Int -> b -> Int
`hv` b
v

        -- hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int
        hashCollisionWithSalt :: Int -> Array (Leaf a b) -> Int
hashCollisionWithSalt Int
s
          = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s ([Int] -> Int)
-> (Array (Leaf a b) -> [Int]) -> Array (Leaf a b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Array (Leaf a b) -> [Int]
arrayHashesSorted Int
s

        -- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]
        arrayHashesSorted :: Int -> Array (Leaf a b) -> [Int]
arrayHashesSorted Int
s = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int])
-> (Array (Leaf a b) -> [Int]) -> Array (Leaf a b) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Leaf a b -> Int) -> [Leaf a b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int -> Leaf a b -> Int
hashLeafWithSalt Int
s) ([Leaf a b] -> [Int])
-> (Array (Leaf a b) -> [Leaf a b]) -> Array (Leaf a b) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Leaf a b) -> [Leaf a b]
forall a. Array a -> [a]
A.toList

instance (Hashable k) => H.Hashable1 (HashMap k) where
    liftHashWithSalt :: (Int -> a -> Int) -> Int -> HashMap k a -> Int
liftHashWithSalt = (Int -> k -> Int) -> (Int -> a -> Int) -> Int -> HashMap k a -> Int
forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
H.liftHashWithSalt2 Int -> k -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt
#endif

instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
    hashWithSalt :: Int -> HashMap k v -> Int
hashWithSalt Int
salt HashMap k v
hm = Int -> HashMap k v -> Int
go Int
salt HashMap k v
hm
      where
        go :: Int -> HashMap k v -> Int
        go :: Int -> HashMap k v -> Int
go Int
s HashMap k v
Empty = Int
s
        go Int
s (BitmapIndexed Hash
_ Array (HashMap k v)
a) = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' Int -> HashMap k v -> Int
go Int
s Array (HashMap k v)
a
        go Int
s (Leaf Hash
h (L k
_ v
v))
          = Int
s Int -> Hash -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Hash
h Int -> v -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` v
v
        -- For collisions we hashmix hash value
        -- and then array of values' hashes sorted
        go Int
s (Full Array (HashMap k v)
a) = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' Int -> HashMap k v -> Int
go Int
s Array (HashMap k v)
a
        go Int
s (Collision Hash
h Array (Leaf k v)
a)
          = (Int
s Int -> Hash -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Hash
h) Int -> Array (Leaf k v) -> Int
`hashCollisionWithSalt` Array (Leaf k v)
a

        hashLeafWithSalt :: Int -> Leaf k v -> Int
        hashLeafWithSalt :: Int -> Leaf k v -> Int
hashLeafWithSalt Int
s (L k
k v
v) = Int
s Int -> k -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` k
k Int -> v -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` v
v

        hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int
        hashCollisionWithSalt :: Int -> Array (Leaf k v) -> Int
hashCollisionWithSalt Int
s
          = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s ([Int] -> Int)
-> (Array (Leaf k v) -> [Int]) -> Array (Leaf k v) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Array (Leaf k v) -> [Int]
arrayHashesSorted Int
s

        arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]
        arrayHashesSorted :: Int -> Array (Leaf k v) -> [Int]
arrayHashesSorted Int
s = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int])
-> (Array (Leaf k v) -> [Int]) -> Array (Leaf k v) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Leaf k v -> Int) -> [Leaf k v] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int -> Leaf k v -> Int
hashLeafWithSalt Int
s) ([Leaf k v] -> [Int])
-> (Array (Leaf k v) -> [Leaf k v]) -> Array (Leaf k v) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList

  -- Helper to get 'Leaf's and 'Collision's as a list.
toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' (BitmapIndexed Hash
_ Array (HashMap k v)
ary) [HashMap k v]
a = (HashMap k v -> [HashMap k v] -> [HashMap k v])
-> [HashMap k v] -> Array (HashMap k v) -> [HashMap k v]
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' [HashMap k v]
a Array (HashMap k v)
ary
toList' (Full Array (HashMap k v)
ary)            [HashMap k v]
a = (HashMap k v -> [HashMap k v] -> [HashMap k v])
-> [HashMap k v] -> Array (HashMap k v) -> [HashMap k v]
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
toList' [HashMap k v]
a Array (HashMap k v)
ary
toList' l :: HashMap k v
l@(Leaf Hash
_ Leaf k v
_)          [HashMap k v]
a = HashMap k v
l HashMap k v -> [HashMap k v] -> [HashMap k v]
forall a. a -> [a] -> [a]
: [HashMap k v]
a
toList' c :: HashMap k v
c@(Collision Hash
_ Array (Leaf k v)
_)     [HashMap k v]
a = HashMap k v
c HashMap k v -> [HashMap k v] -> [HashMap k v]
forall a. a -> [a] -> [a]
: [HashMap k v]
a
toList' HashMap k v
Empty                 [HashMap k v]
a = [HashMap k v]
a

-- Helper function to detect 'Leaf's and 'Collision's.
isLeafOrCollision :: HashMap k v -> Bool
isLeafOrCollision :: HashMap k v -> Bool
isLeafOrCollision (Leaf Hash
_ Leaf k v
_)      = Bool
True
isLeafOrCollision (Collision Hash
_ Array (Leaf k v)
_) = Bool
True
isLeafOrCollision HashMap k v
_               = Bool
False

------------------------------------------------------------------------
-- * Construction

-- | /O(1)/ Construct an empty map.
empty :: HashMap k v
empty :: HashMap k v
empty = HashMap k v
forall k v. HashMap k v
Empty

-- | /O(1)/ Construct a map with a single element.
singleton :: (Hashable k) => k -> v -> HashMap k v
singleton :: k -> v -> HashMap k v
singleton k
k v
v = Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf (k -> Hash
forall a. Hashable a => a -> Hash
hash k
k) (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v)

------------------------------------------------------------------------
-- * Basic interface

-- | /O(1)/ Return 'True' if this map is empty, 'False' otherwise.
null :: HashMap k v -> Bool
null :: HashMap k v -> Bool
null HashMap k v
Empty = Bool
True
null HashMap k v
_   = Bool
False

-- | /O(n)/ Return the number of key-value mappings in this map.
size :: HashMap k v -> Int
size :: HashMap k v -> Int
size HashMap k v
t = HashMap k v -> Int -> Int
forall k v. HashMap k v -> Int -> Int
go HashMap k v
t Int
0
  where
    go :: HashMap k v -> Int -> Int
go HashMap k v
Empty                !Int
n = Int
n
    go (Leaf Hash
_ Leaf k v
_)            Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    go (BitmapIndexed Hash
_ Array (HashMap k v)
ary) Int
n = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' ((HashMap k v -> Int -> Int) -> Int -> HashMap k v -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> Int -> Int
go) Int
n Array (HashMap k v)
ary
    go (Full Array (HashMap k v)
ary)            Int
n = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' ((HashMap k v -> Int -> Int) -> Int -> HashMap k v -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> Int -> Int
go) Int
n Array (HashMap k v)
ary
    go (Collision Hash
_ Array (Leaf k v)
ary)     Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary

-- | /O(log n)/ Return 'True' if the specified key is present in the
-- map, 'False' otherwise.
member :: (Eq k, Hashable k) => k -> HashMap k a -> Bool
member :: k -> HashMap k a -> Bool
member k
k HashMap k a
m = case k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k a
m of
    Maybe a
Nothing -> Bool
False
    Just a
_  -> Bool
True
{-# INLINABLE member #-}

-- | /O(log n)/ Return the value to which the specified key is mapped,
-- or 'Nothing' if this map contains no mapping for the key.
lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
#if __GLASGOW_HASKELL__ >= 802
-- GHC does not yet perform a worker-wrapper transformation on
-- unboxed sums automatically. That seems likely to happen at some
-- point (possibly as early as GHC 8.6) but for now we do it manually.
lookup :: k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m = case k -> HashMap k v -> (# (# #) | v #)
forall k v.
(Eq k, Hashable k) =>
k -> HashMap k v -> (# (# #) | v #)
lookup# k
k HashMap k v
m of
  (# (# #) | #) -> Maybe v
forall a. Maybe a
Nothing
  (# | v
a #) -> v -> Maybe v
forall a. a -> Maybe a
Just v
a
{-# INLINE lookup #-}

lookup# :: (Eq k, Hashable k) => k -> HashMap k v -> (# (# #) | v #)
lookup# :: k -> HashMap k v -> (# (# #) | v #)
lookup# k
k HashMap k v
m = ((# #) -> (# (# #) | v #))
-> (v -> Int -> (# (# #) | v #))
-> Hash
-> k
-> Int
-> HashMap k v
-> (# (# #) | v #)
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Hash -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> (# (# #) | #)) (\v
v Int
_i -> (# | v
v #)) (k -> Hash
forall a. Hashable a => a -> Hash
hash k
k) k
k Int
0 HashMap k v
m
{-# INLINABLE lookup# #-}

#else

lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hash k) k 0 m
{-# INLINABLE lookup #-}
#endif

-- | lookup' is a version of lookup that takes the hash separately.
-- It is used to implement alterF.
lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v
#if __GLASGOW_HASKELL__ >= 802
-- GHC does not yet perform a worker-wrapper transformation on
-- unboxed sums automatically. That seems likely to happen at some
-- point (possibly as early as GHC 8.6) but for now we do it manually.
-- lookup' would probably prefer to be implemented in terms of its own
-- lookup'#, but it's not important enough and we don't want too much
-- code.
lookup' :: Hash -> k -> HashMap k v -> Maybe v
lookup' Hash
h k
k HashMap k v
m = case Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Hash
h k
k HashMap k v
m of
  (# (# #) | #) -> Maybe v
forall a. Maybe a
Nothing
  (# | (# v
a, Int#
_i #) #) -> v -> Maybe v
forall a. a -> Maybe a
Just v
a
{-# INLINE lookup' #-}
#else
lookup' h k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h k 0 m
{-# INLINABLE lookup' #-}
#endif

-- The result of a lookup, keeping track of if a hash collision occured.
-- If a collision did not occur then it will have the Int value (-1).
data LookupRes a = Absent | Present a !Int

-- Internal helper for lookup. This version takes the precomputed hash so
-- that functions that make multiple calls to lookup and related functions
-- (insert, delete) only need to calculate the hash once.
--
-- It is used by 'alterF' so that hash computation and key comparison only needs
-- to be performed once. With this information you can use the more optimized
-- versions of insert ('insertNewKey', 'insertKeyExists') and delete
-- ('deleteKeyExists')
--
-- Outcomes:
--   Key not in map           => Absent
--   Key in map, no collision => Present v (-1)
--   Key in map, collision    => Present v position
lookupRecordCollision :: Eq k => Hash -> k -> HashMap k v -> LookupRes v
#if __GLASGOW_HASKELL__ >= 802
lookupRecordCollision :: Hash -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Hash
h k
k HashMap k v
m = case Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Hash
h k
k HashMap k v
m of
  (# (# #) | #) -> LookupRes v
forall a. LookupRes a
Absent
  (# | (# v
a, Int#
i #) #) -> v -> Int -> LookupRes v
forall a. a -> Int -> LookupRes a
Present v
a (Int# -> Int
I# Int#
i) -- GHC will eliminate the I#
{-# INLINE lookupRecordCollision #-}

-- Why do we produce an Int# instead of an Int? Unfortunately, GHC is not
-- yet any good at unboxing things *inside* products, let alone sums. That
-- may be changing in GHC 8.6 or so (there is some work in progress), but
-- for now we use Int# explicitly here. We don't need to push the Int#
-- into lookupCont because inlining takes care of that.
lookupRecordCollision# :: Eq k => Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# :: Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Hash
h k
k HashMap k v
m =
    ((# #) -> (# (# #) | (# v, Int# #) #))
-> (v -> Int -> (# (# #) | (# v, Int# #) #))
-> Hash
-> k
-> Int
-> HashMap k v
-> (# (# #) | (# v, Int# #) #)
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Hash -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> (# (# #) | #)) (\v
v (I# Int#
i) -> (# | (# v
v, Int#
i #) #)) Hash
h k
k Int
0 HashMap k v
m
-- INLINABLE to specialize to the Eq instance.
{-# INLINABLE lookupRecordCollision# #-}

#else /* GHC < 8.2 so there are no unboxed sums */

lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k 0 m
{-# INLINABLE lookupRecordCollision #-}
#endif

-- A two-continuation version of lookupRecordCollision. This lets us
-- share source code between lookup and lookupRecordCollision without
-- risking any performance degradation.
--
-- The absent continuation has type @((# #) -> r)@ instead of just @r@
-- so we can be representation-polymorphic in the result type. Since
-- this whole thing is always inlined, we don't have to worry about
-- any extra CPS overhead.
--
-- The @Int@ argument is the offset of the subkey in the hash. When looking up
-- keys at the top-level of a hashmap, the offset should be 0. When looking up
-- keys at level @n@ of a hashmap, the offset should be @n * bitsPerSubkey@.
lookupCont ::
#if __GLASGOW_HASKELL__ >= 802
  forall rep (r :: TYPE rep) k v.
#else
  forall r k v.
#endif
     Eq k
  => ((# #) -> r)    -- Absent continuation
  -> (v -> Int -> r) -- Present continuation
  -> Hash -- The hash of the key
  -> k
  -> Int -- The offset of the subkey in the hash.
  -> HashMap k v -> r
lookupCont :: ((# #) -> r)
-> (v -> Int -> r) -> Hash -> k -> Int -> HashMap k v -> r
lookupCont (# #) -> r
absent v -> Int -> r
present !Hash
h0 !k
k0 !Int
s0 !HashMap k v
m0 = Eq k => Hash -> k -> Int -> HashMap k v -> r
Hash -> k -> Int -> HashMap k v -> r
go Hash
h0 k
k0 Int
s0 HashMap k v
m0
  where
    go :: Eq k => Hash -> k -> Int -> HashMap k v -> r
    go :: Hash -> k -> Int -> HashMap k v -> r
go !Hash
_ !k
_ !Int
_ HashMap k v
Empty = (# #) -> r
absent (# #)
    go Hash
h k
k Int
_ (Leaf Hash
hx (L k
kx v
x))
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hx Bool -> Bool -> Bool
&& k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx = v -> Int -> r
present v
x (-Int
1)
        | Bool
otherwise          = (# #) -> r
absent (# #)
    go Hash
h k
k Int
s (BitmapIndexed Hash
b Array (HashMap k v)
v)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = (# #) -> r
absent (# #)
        | Bool
otherwise    =
            Eq k => Hash -> k -> Int -> HashMap k v -> r
Hash -> k -> Int -> HashMap k v -> r
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) (Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
v (Hash -> Hash -> Int
sparseIndex Hash
b Hash
m))
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
    go Hash
h k
k Int
s (Full Array (HashMap k v)
v) =
      Eq k => Hash -> k -> Int -> HashMap k v -> r
Hash -> k -> Int -> HashMap k v -> r
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) (Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
v (Hash -> Int -> Int
index Hash
h Int
s))
    go Hash
h k
k Int
_ (Collision Hash
hx Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hx   = ((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (# #) -> r
absent v -> Int -> r
present k
k Array (Leaf k v)
v
        | Bool
otherwise = (# #) -> r
absent (# #)
{-# INLINE lookupCont #-}

-- | /O(log n)/ Return the value to which the specified key is mapped,
-- or 'Nothing' if this map contains no mapping for the key.
--
-- This is a flipped version of 'lookup'.
--
-- @since 0.2.11
(!?) :: (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? :: HashMap k v -> k -> Maybe v
(!?) HashMap k v
m k
k = k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m
{-# INLINE (!?) #-}


-- | /O(log n)/ Return the value to which the specified key is mapped,
-- or the default value if this map contains no mapping for the key.
--
-- @since 0.2.11
findWithDefault :: (Eq k, Hashable k)
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
findWithDefault :: v -> k -> HashMap k v -> v
findWithDefault v
def k
k HashMap k v
t = case k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
t of
    Just v
v -> v
v
    Maybe v
_      -> v
def
{-# INLINABLE findWithDefault #-}


-- | /O(log n)/ Return the value to which the specified key is mapped,
-- or the default value if this map contains no mapping for the key.
--
-- DEPRECATED: lookupDefault is deprecated as of version 0.2.11, replaced
-- by 'findWithDefault'.
lookupDefault :: (Eq k, Hashable k)
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
lookupDefault :: v -> k -> HashMap k v -> v
lookupDefault v
def k
k HashMap k v
t = v -> k -> HashMap k v -> v
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
findWithDefault v
def k
k HashMap k v
t
{-# INLINE lookupDefault #-}

-- | /O(log n)/ Return the value to which the specified key is mapped.
-- Calls 'error' if this map contains no mapping for the key.
#if MIN_VERSION_base(4,9,0)
(!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v
#else
(!) :: (Eq k, Hashable k) => HashMap k v -> k -> v
#endif
(!) HashMap k v
m k
k = case k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m of
    Just v
v  -> v
v
    Maybe v
Nothing -> [Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.HashMap.Internal.(!): key not found"
{-# INLINABLE (!) #-}

infixl 9 !

-- | Create a 'Collision' value with two 'Leaf' values.
collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h !Leaf k v
e1 !Leaf k v
e2 =
    let v :: Array (Leaf k v)
v = (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v))
-> (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ do MArray s (Leaf k v)
mary <- Int -> Leaf k v -> ST s (MArray s (Leaf k v))
forall a s. Int -> a -> ST s (MArray s a)
A.new Int
2 Leaf k v
e1
                       MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
1 Leaf k v
e2
                       MArray s (Leaf k v) -> ST s (MArray s (Leaf k v))
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s (Leaf k v)
mary
    in Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h Array (Leaf k v)
v
{-# INLINE collision #-}

-- | Create a 'BitmapIndexed' or 'Full' node.
bitmapIndexedOrFull :: Bitmap -> A.Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull :: Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Hash
b Array (HashMap k v)
ary
    | Hash
b Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
fullNodeMask = Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary
    | Bool
otherwise         = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b Array (HashMap k v)
ary
{-# INLINE bitmapIndexedOrFull #-}

-- | /O(log n)/ Associate the specified value with the specified
-- key in this map.  If this map previously contained a mapping for
-- the key, the old value is replaced.
insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
insert :: k -> v -> HashMap k v -> HashMap k v
insert k
k v
v HashMap k v
m = Hash -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
insert' (k -> Hash
forall a. Hashable a => a -> Hash
hash k
k) k
k v
v HashMap k v
m
{-# INLINABLE insert #-}

insert' :: Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
insert' :: Hash -> k -> v -> HashMap k v -> HashMap k v
insert' Hash
h0 k
k0 v
v0 HashMap k v
m0 = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
forall k v.
Eq k =>
Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h0 k
k0 v
v0 Int
0 HashMap k v
m0
  where
    go :: Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go !Hash
h !k
k v
x !Int
_ HashMap k v
Empty = Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Hash
hy l :: Leaf k v
l@(L k
ky v
y))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h = if k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k
                    then if v
x v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
y
                         then HashMap k v
t
                         else Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
                    else Hash -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two Int
s Hash
h k
k v
x Hash
hy HashMap k v
t)
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 =
            let !ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
               then HashMap k v
t
               else Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
            then HashMap k v
t
            else Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update16 Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h ((v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith (\v
a v
_ -> (# v
a #)) k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x Int
s (HashMap k v -> HashMap k v) -> HashMap k v -> HashMap k v
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash -> Int -> Hash
mask Hash
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE insert' #-}

-- Insert optimized for the case when we know the key is not in the map.
--
-- It is only valid to call this when the key does not exist in the map.
--
-- We can skip:
--  - the key equality check on a Leaf
--  - check for its existence in the array for a hash collision
insertNewKey :: Hash -> k -> v -> HashMap k v -> HashMap k v
insertNewKey :: Hash -> k -> v -> HashMap k v -> HashMap k v
insertNewKey !Hash
h0 !k
k0 v
x0 !HashMap k v
m0 = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
forall k v. Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h0 k
k0 v
x0 Int
0 HashMap k v
m0
  where
    go :: Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go !Hash
h !k
k v
x !Int
_ HashMap k v
Empty = Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Hash
hy Leaf k v
l)
      | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h = Hash -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
      | Bool
otherwise = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two Int
s Hash
h k
k v
x Hash
hy HashMap k v
t)
    go Hash
h k
k v
x Int
s (BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 =
            let !ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k v
x Int
s (Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update16 Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Leaf k v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v. Leaf k v -> Array (Leaf k v) -> Array (Leaf k v)
snocNewLeaf (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x) Array (Leaf k v)
v)
        | Bool
otherwise =
            Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k v
x Int
s (HashMap k v -> HashMap k v) -> HashMap k v -> HashMap k v
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash -> Int -> Hash
mask Hash
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
      where
        snocNewLeaf :: Leaf k v -> A.Array (Leaf k v) -> A.Array (Leaf k v)
        snocNewLeaf :: Leaf k v -> Array (Leaf k v) -> Array (Leaf k v)
snocNewLeaf Leaf k v
leaf Array (Leaf k v)
ary = (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v))
-> (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ do
          let n :: Int
n = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary
          MArray s (Leaf k v)
mary <- Int -> ST s (MArray s (Leaf k v))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          Array (Leaf k v)
-> Int -> MArray s (Leaf k v) -> Int -> Int -> ST s ()
forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
A.copy Array (Leaf k v)
ary Int
0 MArray s (Leaf k v)
mary Int
0 Int
n
          MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
n Leaf k v
leaf
          MArray s (Leaf k v) -> ST s (MArray s (Leaf k v))
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s (Leaf k v)
mary
{-# NOINLINE insertNewKey #-}


-- Insert optimized for the case when we know the key is in the map.
--
-- It is only valid to call this when the key exists in the map and you know the
-- hash collision position if there was one. This information can be obtained
-- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos
-- (first argument).
--
-- We can skip the key equality check on a Leaf because we know the leaf must be
-- for this key.
insertKeyExists :: Int -> Hash -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists :: Int -> Hash -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists !Int
collPos0 !Hash
h0 !k
k0 v
x0 !HashMap k v
m0 = Int -> Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
forall k v.
Int -> Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Int
collPos0 Hash
h0 k
k0 v
x0 Int
0 HashMap k v
m0
  where
    go :: Int -> Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go !Int
_collPos !Hash
h !k
k v
x !Int
_s (Leaf Hash
_hy Leaf k v
_kx)
        = Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Int
collPos Hash
h k
k v
x Int
s (BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 =
            let !ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Int -> Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Int
collPos Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Int
collPos Hash
h k
k v
x Int
s (Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st  = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Int -> Hash -> k -> v -> Int -> HashMap k v -> HashMap k v
go Int
collPos Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update16 Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Int
collPos Hash
h k
k v
x Int
_s (Collision Hash
_hy Array (Leaf k v)
v)
        | Int
collPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v. Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
setAtPosition Int
collPos k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = HashMap k v
forall k v. HashMap k v
Empty -- error "Internal error: go {collPos negative}"
    go Int
_ Hash
_ k
_ v
_ Int
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty -- error "Internal error: go Empty"

{-# NOINLINE insertKeyExists #-}

-- Replace the ith Leaf with Leaf k v.
--
-- This does not check that @i@ is within bounds of the array.
setAtPosition :: Int -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v)
setAtPosition :: Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
setAtPosition Int
i k
k v
x Array (Leaf k v)
ary = Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
{-# INLINE setAtPosition #-}


-- | In-place update version of insert
unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
unsafeInsert :: k -> v -> HashMap k v -> HashMap k v
unsafeInsert k
k0 v
v0 HashMap k v
m0 = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Eq k =>
Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Hash
h0 = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k0
    go :: Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !Hash
h !k
k v
x !Int
_ HashMap k v
Empty = HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Hash
hy l :: Leaf k v
l@(L k
ky v
y))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h = if k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k
                    then if v
x v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
y
                         then HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
                         else HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
                    else HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two Int
s Hash
h k
k v
x Hash
hy HashMap k v
t
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = do
            Array (HashMap k v)
ary' <- Array (HashMap k v)
-> Int -> HashMap k v -> ST s (Array (HashMap k v))
forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap k v)
ary Int
i (HashMap k v -> ST s (Array (HashMap k v)))
-> HashMap k v -> ST s (Array (HashMap k v))
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise = do
            HashMap k v
st <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
            HashMap k v
st' <- Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) = do
        HashMap k v
st <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
        HashMap k v
st' <- Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
        HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   = HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h ((v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith (\v
a v
_ -> (# v
a #)) k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x Int
s (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash -> Int -> Hash
mask Hash
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE unsafeInsert #-}

-- | Create a map from two key-value pairs which hashes don't collide. To
-- enhance sharing, the second key-value pair is represented by the hash of its
-- key and a singleton HashMap pairing its key with its value.
--
-- Note: to avoid silly thunks, this function must be strict in the
-- key. See issue #232. We don't need to force the HashMap argument
-- because it's already in WHNF (having just been matched) and we
-- just put it directly in an array.
two :: Shift -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two :: Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two = Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
go
  where
    go :: Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
go Int
s Hash
h1 k
k1 v
v1 Hash
h2 HashMap k v
t2
        | Hash
bp1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
bp2 = do
            HashMap k v
st <- Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) Hash
h1 k
k1 v
v1 Hash
h2 HashMap k v
t2
            Array (HashMap k v)
ary <- HashMap k v -> ST s (Array (HashMap k v))
forall a s. a -> ST s (Array a)
A.singletonM HashMap k v
st
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
bp1 Array (HashMap k v)
ary
        | Bool
otherwise  = do
            MArray s (HashMap k v)
mary <- Int -> HashMap k v -> ST s (MArray s (HashMap k v))
forall a s. Int -> a -> ST s (MArray s a)
A.new Int
2 (HashMap k v -> ST s (MArray s (HashMap k v)))
-> HashMap k v -> ST s (MArray s (HashMap k v))
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k1 v
v1)
            MArray s (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v)
mary Int
idx2 HashMap k v
t2
            Array (HashMap k v)
ary <- MArray s (HashMap k v) -> ST s (Array (HashMap k v))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (HashMap k v)
mary
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash
bp1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
bp2) Array (HashMap k v)
ary
      where
        bp1 :: Hash
bp1  = Hash -> Int -> Hash
mask Hash
h1 Int
s
        bp2 :: Hash
bp2  = Hash -> Int -> Hash
mask Hash
h2 Int
s
        idx2 :: Int
idx2 | Hash -> Int -> Int
index Hash
h1 Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Hash -> Int -> Int
index Hash
h2 Int
s = Int
1
             | Bool
otherwise               = Int
0
{-# INLINE two #-}

-- | /O(log n)/ Associate the value with the key in this map.  If
-- this map previously contained a mapping for the key, the old value
-- is replaced by the result of applying the given function to the new
-- and old value.  Example:
--
-- > insertWith f k v map
-- >   where f new old = new + old
insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
            -> HashMap k v
-- We're not going to worry about allocating a function closure
-- to pass to insertModifying. See comments at 'adjust'.
insertWith :: (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
insertWith v -> v -> v
f k
k v
new HashMap k v
m = v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
insertModifying v
new (\v
old -> (# v -> v -> v
f v
new v
old #)) k
k HashMap k v
m
{-# INLINE insertWith #-}

-- | @insertModifying@ is a lot like insertWith; we use it to implement alterF.
-- It takes a value to insert when the key is absent and a function
-- to apply to calculate a new value when the key is present. Thanks
-- to the unboxed unary tuple, we avoid introducing any unnecessary
-- thunks in the tree.
insertModifying :: (Eq k, Hashable k) => v -> (v -> (# v #)) -> k -> HashMap k v
            -> HashMap k v
insertModifying :: v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
insertModifying v
x v -> (# v #)
f k
k0 HashMap k v
m0 = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h0 k
k0 Int
0 HashMap k v
m0
  where
    !h0 :: Hash
h0 = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k0
    go :: Hash -> k -> Int -> HashMap k v -> HashMap k v
go !Hash
h !k
k !Int
_ HashMap k v
Empty = Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Hash
h k
k Int
s t :: HashMap k v
t@(Leaf Hash
hy l :: Leaf k v
l@(L k
ky v
y))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h = if k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k
                    then case v -> (# v #)
f v
y of
                      (# v
v' #) | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
v' -> HashMap k v
t
                               | Bool
otherwise -> Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k (v
v'))
                    else Hash -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two Int
s Hash
h k
k v
x Hash
hy HashMap k v
t)
    go Hash
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 =
            let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st'  = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
                ary' :: Array (HashMap k v)
ary'  = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
            in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
               then HashMap k v
t
               else Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b Array (HashMap k v)
ary'
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st'  = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update16 Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
        in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
           then HashMap k v
t
           else Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k Int
s t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   =
            let !v' :: Array (Leaf k v)
v' = v -> (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
v -> (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
insertModifyingArr v
x v -> (# v #)
f k
k Array (Leaf k v)
v
            in if Array (Leaf k v) -> Array (Leaf k v) -> Bool
forall a b. Array a -> Array b -> Bool
A.unsafeSameArray Array (Leaf k v)
v Array (Leaf k v)
v'
               then HashMap k v
t
               else Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h Array (Leaf k v)
v'
        | Bool
otherwise = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k Int
s (HashMap k v -> HashMap k v) -> HashMap k v -> HashMap k v
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash -> Int -> Hash
mask Hash
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE insertModifying #-}

-- Like insertModifying for arrays; used to implement insertModifying
insertModifyingArr :: Eq k => v -> (v -> (# v #)) -> k -> A.Array (Leaf k v)
                 -> A.Array (Leaf k v)
insertModifyingArr :: v -> (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
insertModifyingArr v
x v -> (# v #)
f k
k0 Array (Leaf k v)
ary0 = k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k0 Array (Leaf k v)
ary0 Int
0 (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary0)
  where
    go :: k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go !k
k !Array (Leaf k v)
ary !Int
i !Int
n
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v))
-> (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ do
            -- Not found, append to the end.
            MArray s (Leaf k v)
mary <- Int -> ST s (MArray s (Leaf k v))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Array (Leaf k v)
-> Int -> MArray s (Leaf k v) -> Int -> Int -> ST s ()
forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
A.copy Array (Leaf k v)
ary Int
0 MArray s (Leaf k v)
mary Int
0 Int
n
            MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
n (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            MArray s (Leaf k v) -> ST s (MArray s (Leaf k v))
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s (Leaf k v)
mary
        | Bool
otherwise = case Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
y) | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx   -> case v -> (# v #)
f v
y of
                                      (# v
y' #) -> if v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y'
                                                  then Array (Leaf k v)
ary
                                                  else Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
y')
                     | Bool
otherwise -> k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE insertModifyingArr #-}

-- | In-place update version of insertWith
unsafeInsertWith :: forall k v. (Eq k, Hashable k)
                 => (v -> v -> v) -> k -> v -> HashMap k v
                 -> HashMap k v
unsafeInsertWith :: (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWith v -> v -> v
f k
k0 v
v0 HashMap k v
m0 = (k -> v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWithKey ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
f) k
k0 v
v0 HashMap k v
m0
{-# INLINABLE unsafeInsertWith #-}

unsafeInsertWithKey :: forall k v. (Eq k, Hashable k)
                 => (k -> v -> v -> v) -> k -> v -> HashMap k v
                 -> HashMap k v
unsafeInsertWithKey :: (k -> v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWithKey k -> v -> v -> v
f k
k0 v
v0 HashMap k v
m0 = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Hash
h0 = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k0
    go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
    go :: Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !Hash
h !k
k v
x !Int
_ HashMap k v
Empty = HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Hash
hy l :: Leaf k v
l@(L k
ky v
y))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h = if k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k
                    then HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k (k -> v -> v -> v
f k
k v
x v
y))
                    else HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision Hash
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two Int
s Hash
h k
k v
x Hash
hy HashMap k v
t
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = do
            Array (HashMap k v)
ary' <- Array (HashMap k v)
-> Int -> HashMap k v -> ST s (Array (HashMap k v))
forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap k v)
ary Int
i (HashMap k v -> ST s (Array (HashMap k v)))
-> HashMap k v -> ST s (Array (HashMap k v))
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m) Array (HashMap k v)
ary'
        | Bool
otherwise = do
            HashMap k v
st <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
            HashMap k v
st' <- Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
            HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) = do
        HashMap k v
st <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
        HashMap k v
st' <- Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
        HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k v
x Int
s t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   = HashMap k v -> ST s (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h ((k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey (\k
key v
a v
b -> (# k -> v -> v -> v
f k
key v
a v
b #) ) k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Hash
h k
k v
x Int
s (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash -> Int -> Hash
mask Hash
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE unsafeInsertWithKey #-}

-- | /O(log n)/ Remove the mapping for the specified key from this map
-- if present.
delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete :: k -> HashMap k v -> HashMap k v
delete k
k HashMap k v
m = Hash -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' (k -> Hash
forall a. Hashable a => a -> Hash
hash k
k) k
k HashMap k v
m
{-# INLINABLE delete #-}

delete' :: Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' :: Hash -> k -> HashMap k v -> HashMap k v
delete' Hash
h0 k
k0 HashMap k v
m0 = Hash -> k -> Int -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h0 k
k0 Int
0 HashMap k v
m0
  where
    go :: Hash -> k -> Int -> HashMap k v -> HashMap k v
go !Hash
_ !k
_ !Int
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty
    go Hash
h k
k Int
_ t :: HashMap k v
t@(Leaf Hash
hy (L k
ky v
_))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h Bool -> Bool -> Bool
&& k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k = HashMap k v
forall k v. HashMap k v
Empty
        | Bool
otherwise          = HashMap k v
t
    go Hash
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = HashMap k v
t
        | Bool
otherwise =
            let !st :: HashMap k v
st = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
                then HashMap k v
t
                else case HashMap k v
st' of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
forall k v. HashMap k v
Empty
                      | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
1) of
                          (Int
0, HashMap k v
_, HashMap k v
l) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int
1, HashMap k v
l, HashMap k v
_) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int, HashMap k v, HashMap k v)
_                               -> HashMap k v
bIndexed
                      | Bool
otherwise -> HashMap k v
bIndexed
                    where
                      bIndexed :: HashMap k v
bIndexed = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Bits a => a -> a
complement Hash
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
            then HashMap k v
t
            else case HashMap k v
st' of
            HashMap k v
Empty ->
                let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Hash
bm   = Hash
fullNodeMask Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Bits a => a -> a
complement (Hash
1 Hash -> Int -> Hash
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Hash
h k
k Int
_ t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy = case k -> Array (Leaf k v) -> Maybe Int
forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k Array (Leaf k v)
v of
            Just Int
i
                | Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                    if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
                    else Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
                | Bool
otherwise -> Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
v Int
i)
            Maybe Int
Nothing -> HashMap k v
t
        | Bool
otherwise = HashMap k v
t
{-# INLINABLE delete' #-}

-- | Delete optimized for the case when we know the key is in the map.
--
-- It is only valid to call this when the key exists in the map and you know the
-- hash collision position if there was one. This information can be obtained
-- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos.
--
-- We can skip:
--  - the key equality check on the leaf, if we reach a leaf it must be the key
deleteKeyExists :: Int -> Hash -> k -> HashMap k v -> HashMap k v
deleteKeyExists :: Int -> Hash -> k -> HashMap k v -> HashMap k v
deleteKeyExists !Int
collPos0 !Hash
h0 !k
k0 !HashMap k v
m0 = Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
forall k v. Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos0 Hash
h0 k
k0 Int
0 HashMap k v
m0
  where
    go :: Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
    go :: Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
go !Int
_collPos !Hash
_h !k
_k !Int
_s (Leaf Hash
_ Leaf k v
_) = HashMap k v
forall k v. HashMap k v
Empty
    go Int
collPos Hash
h k
k Int
s (BitmapIndexed Hash
b Array (HashMap k v)
ary) =
            let !st :: HashMap k v
st = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
forall k v. Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in case HashMap k v
st' of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
forall k v. HashMap k v
Empty
                      | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
1) of
                          (Int
0, HashMap k v
_, HashMap k v
l) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int
1, HashMap k v
l, HashMap k v
_) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int, HashMap k v, HashMap k v)
_                               -> HashMap k v
bIndexed
                      | Bool
otherwise -> HashMap k v
bIndexed
                    where
                      bIndexed :: HashMap k v
bIndexed = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Bits a => a -> a
complement Hash
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Int
collPos Hash
h k
k Int
s (Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
forall k v. Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in case HashMap k v
st' of
            HashMap k v
Empty ->
                let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Hash
bm   = Hash
fullNodeMask Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Bits a => a -> a
complement (Hash
1 Hash -> Int -> Hash
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Hash -> Int -> Int
index Hash
h Int
s
    go Int
collPos Hash
h k
_ Int
_ (Collision Hash
_hy Array (Leaf k v)
v)
      | Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
      = if Int
collPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
        else Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
      | Bool
otherwise = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
v Int
collPos)
    go !Int
_ !Hash
_ !k
_ !Int
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty -- error "Internal error: deleteKeyExists empty"
{-# NOINLINE deleteKeyExists #-}

-- | /O(log n)/ Adjust the value tied to a given key in this map only
-- if it is present. Otherwise, leave the map alone.
adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
-- This operation really likes to leak memory, so using this
-- indirect implementation shouldn't hurt much. Furthermore, it allows
-- GHC to avoid a leak when the function is lazy. In particular,
--
--     adjust (const x) k m
-- ==> adjust# (\v -> (# const x v #)) k m
-- ==> adjust# (\_ -> (# x #)) k m
adjust :: (v -> v) -> k -> HashMap k v -> HashMap k v
adjust v -> v
f k
k HashMap k v
m = (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# (\v
v -> (# v -> v
f v
v #)) k
k HashMap k v
m
{-# INLINE adjust #-}

-- | Much like 'adjust', but not inherently leaky.
adjust# :: (Eq k, Hashable k) => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# :: (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# v -> (# v #)
f k
k0 HashMap k v
m0 = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h0 k
k0 Int
0 HashMap k v
m0
  where
    h0 :: Hash
h0 = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k0
    go :: Hash -> k -> Int -> HashMap k v -> HashMap k v
go !Hash
_ !k
_ !Int
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty
    go Hash
h k
k Int
_ t :: HashMap k v
t@(Leaf Hash
hy (L k
ky v
y))
        | Hash
hy Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h Bool -> Bool -> Bool
&& k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k = case v -> (# v #)
f v
y of
            (# v
y' #) | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y' -> HashMap k v
t
                     | Bool
otherwise -> Hash -> Leaf k v -> HashMap k v
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
y')
        | Bool
otherwise          = HashMap k v
t
    go Hash
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Hash
b Array (HashMap k v)
ary)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = HashMap k v
t
        | Bool
otherwise = let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                          !st' :: HashMap k v
st'  = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
                          ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
                      in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
                         then HashMap k v
t
                         else Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b Array (HashMap k v)
ary'
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h Int
s
            i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b Hash
m
    go Hash
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let i :: Int
i    = Hash -> Int -> Int
index Hash
h Int
s
            !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st'  = Hash -> k -> Int -> HashMap k v -> HashMap k v
go Hash
h k
k (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update16 Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
        in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
           then HashMap k v
t
           else Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Hash
h k
k Int
_ t :: HashMap k v
t@(Collision Hash
hy Array (Leaf k v)
v)
        | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hy   = let !v' :: Array (Leaf k v)
v' = (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
updateWith# v -> (# v #)
f k
k Array (Leaf k v)
v
                      in if Array (Leaf k v) -> Array (Leaf k v) -> Bool
forall a b. Array a -> Array b -> Bool
A.unsafeSameArray Array (Leaf k v)
v Array (Leaf k v)
v'
                         then HashMap k v
t
                         else Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h Array (Leaf k v)
v'
        | Bool
otherwise = HashMap k v
t
{-# INLINABLE adjust# #-}

-- | /O(log n)/  The expression @('update' f k map)@ updates the value @x@ at @k@
-- (if it is in the map). If @(f x)@ is 'Nothing', the element is deleted.
-- If it is @('Just' y)@, the key @k@ is bound to the new value @y@.
update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
update :: (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
update a -> Maybe a
f = (Maybe a -> Maybe a) -> k -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
alter (Maybe a -> (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe a
f)
{-# INLINABLE update #-}


-- | /O(log n)/  The expression @('alter' f k map)@ alters the value @x@ at @k@, or
-- absence thereof.
--
-- 'alter' can be used to insert, delete, or update a value in a map. In short:
--
-- @
-- 'lookup' k ('alter' f k m) = f ('lookup' k m)
-- @
alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
-- TODO(m-renaud): Consider using specialized insert and delete for alter.
alter :: (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
alter Maybe v -> Maybe v
f k
k HashMap k v
m =
  case Maybe v -> Maybe v
f (k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m) of
    Maybe v
Nothing -> k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete k
k HashMap k v
m
    Just v
v  -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert k
k v
v HashMap k v
m
{-# INLINABLE alter #-}

-- | /O(log n)/  The expression @('alterF' f k map)@ alters the value @x@ at
-- @k@, or absence thereof.
--
--  'alterF' can be used to insert, delete, or update a value in a map.
--
-- Note: 'alterF' is a flipped version of the 'at' combinator from
-- <https://hackage.haskell.org/package/lens/docs/Control-Lens-At.html#v:at Control.Lens.At>.
--
-- @since 0.2.10
alterF :: (Functor f, Eq k, Hashable k)
       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
-- We only calculate the hash once, but unless this is rewritten
-- by rules we may test for key equality multiple times.
-- We force the value of the map for consistency with the rewritten
-- version; otherwise someone could tell the difference using a lazy
-- @f@ and a functor that is similar to Const but not actually Const.
alterF :: (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterF Maybe v -> f (Maybe v)
f = \ !k
k !HashMap k v
m ->
  let
    !h :: Hash
h = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k
    mv :: Maybe v
mv = Hash -> k -> HashMap k v -> Maybe v
forall k v. Eq k => Hash -> k -> HashMap k v -> Maybe v
lookup' Hash
h k
k HashMap k v
m
  in ((Maybe v -> HashMap k v) -> f (Maybe v) -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f Maybe v
mv) ((Maybe v -> HashMap k v) -> f (HashMap k v))
-> (Maybe v -> HashMap k v) -> f (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \Maybe v
fres ->
    case Maybe v
fres of
      Maybe v
Nothing -> HashMap k v -> (v -> HashMap k v) -> Maybe v -> HashMap k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k v
m (HashMap k v -> v -> HashMap k v
forall a b. a -> b -> a
const (Hash -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' Hash
h k
k HashMap k v
m)) Maybe v
mv
      Just v
v' -> Hash -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
insert' Hash
h k
k v
v' HashMap k v
m

-- We unconditionally rewrite alterF in RULES, but we expose an
-- unfolding just in case it's used in some way that prevents the
-- rule from firing.
{-# INLINABLE [0] alterF #-}

#if MIN_VERSION_base(4,8,0)
-- This is just a bottom value. See the comment on the "alterFWeird"
-- rule.
test_bottom :: a
test_bottom :: a
test_bottom = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.HashMap.alterF internal error: hit test_bottom"

-- We use this as an error result in RULES to ensure we don't get
-- any useless CallStack nonsense.
bogus# :: (# #) -> (# a #)
bogus# :: (# #) -> (# a #)
bogus# (# #)
_ = [Char] -> (# a #)
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.HashMap.alterF internal error: hit bogus#"

{-# RULES
-- We probe the behavior of @f@ by applying it to Nothing and to
-- Just test_bottom. Based on the results, and how they relate to
-- each other, we choose the best implementation.

"alterFWeird" forall f. alterF f =
   alterFWeird (f Nothing) (f (Just test_bottom)) f

-- This rule covers situations where alterF is used to simply insert or
-- delete in Identity (most likely via Control.Lens.At). We recognize here
-- (through the repeated @x@ on the LHS) that
--
-- @f Nothing = f (Just bottom)@,
--
-- which guarantees that @f@ doesn't care what its argument is, so
-- we don't have to either.
--
-- Why only Identity? A variant of this rule is actually valid regardless of
-- the functor, but for some functors (e.g., []), it can lead to the
-- same keys being compared multiple times, which is bad if they're
-- ugly things like strings. This is unfortunate, since the rule is likely
-- a good idea for almost all realistic uses, but I don't like nasty
-- edge cases.
"alterFconstant" forall (f :: Maybe a -> Identity (Maybe a)) x.
  alterFWeird x x f = \ !k !m ->
    Identity (case runIdentity x of {Nothing -> delete k m; Just a -> insert k a m})

-- This rule handles the case where 'alterF' is used to do 'insertWith'-like
-- things. Whenever possible, GHC will get rid of the Maybe nonsense for us.
-- We delay this rule to stage 1 so alterFconstant has a chance to fire.
"alterFinsertWith" [1] forall (f :: Maybe a -> Identity (Maybe a)) x y.
  alterFWeird (coerce (Just x)) (coerce (Just y)) f =
    coerce (insertModifying x (\mold -> case runIdentity (f (Just mold)) of
                                            Nothing -> bogus# (# #)
                                            Just new -> (# new #)))

-- Handle the case where someone uses 'alterF' instead of 'adjust'. This
-- rule is kind of picky; it will only work if the function doesn't
-- do anything between case matching on the Maybe and producing a result.
"alterFadjust" forall (f :: Maybe a -> Identity (Maybe a)) _y.
  alterFWeird (coerce Nothing) (coerce (Just _y)) f =
    coerce (adjust# (\x -> case runIdentity (f (Just x)) of
                               Just x' -> (# x' #)
                               Nothing -> bogus# (# #)))

-- The simple specialization to Const; in this case we can look up
-- the key without caring what position it's in. This is only a tiny
-- optimization.
"alterFlookup" forall _ign1 _ign2 (f :: Maybe a -> Const r (Maybe a)).
  alterFWeird _ign1 _ign2 f = \ !k !m -> Const (getConst (f (lookup k m)))
 #-}

-- This is a very unsafe version of alterF used for RULES. When calling
-- alterFWeird x y f, the following *must* hold:
--
-- x = f Nothing
-- y = f (Just _|_)
--
-- Failure to abide by these laws will make demons come out of your nose.
alterFWeird
       :: (Functor f, Eq k, Hashable k)
       => f (Maybe v)
       -> f (Maybe v)
       -> (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFWeird :: f (Maybe v)
-> f (Maybe v)
-> (Maybe v -> f (Maybe v))
-> k
-> HashMap k v
-> f (HashMap k v)
alterFWeird f (Maybe v)
_ f (Maybe v)
_ Maybe v -> f (Maybe v)
f = (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFEager Maybe v -> f (Maybe v)
f
{-# INLINE [0] alterFWeird #-}

-- | This is the default version of alterF that we use in most non-trivial
-- cases. It's called "eager" because it looks up the given key in the map
-- eagerly, whether or not the given function requires that information.
alterFEager :: (Functor f, Eq k, Hashable k)
       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFEager :: (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFEager Maybe v -> f (Maybe v)
f !k
k HashMap k v
m = ((Maybe v -> HashMap k v) -> f (Maybe v) -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f Maybe v
mv) ((Maybe v -> HashMap k v) -> f (HashMap k v))
-> (Maybe v -> HashMap k v) -> f (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \Maybe v
fres ->
  case Maybe v
fres of

    ------------------------------
    -- Delete the key from the map.
    Maybe v
Nothing -> case LookupRes v
lookupRes of

      -- Key did not exist in the map to begin with, no-op
      LookupRes v
Absent -> HashMap k v
m

      -- Key did exist
      Present v
_ Int
collPos -> Int -> Hash -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Hash -> k -> HashMap k v -> HashMap k v
deleteKeyExists Int
collPos Hash
h k
k HashMap k v
m

    ------------------------------
    -- Update value
    Just v
v' -> case LookupRes v
lookupRes of

      -- Key did not exist before, insert v' under a new key
      LookupRes v
Absent -> Hash -> k -> v -> HashMap k v -> HashMap k v
forall k v. Hash -> k -> v -> HashMap k v -> HashMap k v
insertNewKey Hash
h k
k v
v' HashMap k v
m

      -- Key existed before
      Present v
v Int
collPos ->
        if v
v v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
v'
        -- If the value is identical, no-op
        then HashMap k v
m
        -- If the value changed, update the value.
        else Int -> Hash -> k -> v -> HashMap k v -> HashMap k v
forall k v. Int -> Hash -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists Int
collPos Hash
h k
k v
v' HashMap k v
m

  where !h :: Hash
h = k -> Hash
forall a. Hashable a => a -> Hash
hash k
k
        !lookupRes :: LookupRes v
lookupRes = Hash -> k -> HashMap k v -> LookupRes v
forall k v. Eq k => Hash -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Hash
h k
k HashMap k v
m
        !mv :: Maybe v
mv = case LookupRes v
lookupRes of
           LookupRes v
Absent -> Maybe v
forall a. Maybe a
Nothing
           Present v
v Int
_ -> v -> Maybe v
forall a. a -> Maybe a
Just v
v
{-# INLINABLE alterFEager #-}
#endif

-- | /O(n*log m)/ Inclusion of maps. A map is included in another map if the keys
-- are subsets and the corresponding values are equal:
--
-- > isSubmapOf m1 m2 = keys m1 `isSubsetOf` keys m2 &&
-- >                    and [ v1 == v2 | (k1,v1) <- toList m1; let v2 = m2 ! k1 ]
--
-- ==== __Examples__
--
-- >>> fromList [(1,'a')] `isSubmapOf` fromList [(1,'a'),(2,'b')]
-- True
--
-- >>> fromList [(1,'a'),(2,'b')] `isSubmapOf` fromList [(1,'a')]
-- False
--
-- @since 0.2.12
isSubmapOf :: (Eq k, Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool
isSubmapOf :: HashMap k v -> HashMap k v -> Bool
isSubmapOf = (((v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool)
-> (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall a. a -> a
inline (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall k v1 v2.
(Eq k, Hashable k) =>
(v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
isSubmapOfBy) v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINABLE isSubmapOf #-}

-- | /O(n*log m)/ Inclusion of maps with value comparison. A map is included in
-- another map if the keys are subsets and if the comparison function is true
-- for the corresponding values:
--
-- > isSubmapOfBy cmpV m1 m2 = keys m1 `isSubsetOf` keys m2 &&
-- >                           and [ v1 `cmpV` v2 | (k1,v1) <- toList m1; let v2 = m2 ! k1 ]
--
-- ==== __Examples__
--
-- >>> isSubmapOfBy (<=) (fromList [(1,'a')]) (fromList [(1,'b'),(2,'c')])
-- True
--
-- >>> isSubmapOfBy (<=) (fromList [(1,'b')]) (fromList [(1,'a'),(2,'c')])
-- False
--
-- @since 0.2.12
isSubmapOfBy :: (Eq k, Hashable k) => (v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
-- For maps without collisions the complexity is O(n*log m), where n is the size
-- of m1 and m the size of m2: the inclusion operation visits every leaf in m1 at least once.
-- For each leaf in m1, it looks up the key in m2.
--
-- The worst case complexity is O(n*m). The worst case is when both hashmaps m1
-- and m2 are collision nodes for the same hash. Since collision nodes are
-- unsorted arrays, it requires for every key in m1 a linear search to to find a
-- matching key in m2, hence O(n*m).
isSubmapOfBy :: (v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
isSubmapOfBy v1 -> v2 -> Bool
comp !HashMap k v1
m1 !HashMap k v2
m2 = Int -> HashMap k v1 -> HashMap k v2 -> Bool
go Int
0 HashMap k v1
m1 HashMap k v2
m2
  where
    -- An empty map is always a submap of any other map.
    go :: Int -> HashMap k v1 -> HashMap k v2 -> Bool
go Int
_ HashMap k v1
Empty HashMap k v2
_ = Bool
True

    -- If the second map is empty and the first is not, it cannot be a submap.
    go Int
_ HashMap k v1
_ HashMap k v2
Empty = Bool
False

    -- If the first map contains only one entry, lookup the key in the second map.
    go Int
s (Leaf Hash
h1 (L k
k1 v1
v1)) HashMap k v2
t2 = ((# #) -> Bool)
-> (v2 -> Int -> Bool) -> Hash -> k -> Int -> HashMap k v2 -> Bool
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Hash -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> Bool
False) (\v2
v2 Int
_ -> v1 -> v2 -> Bool
comp v1
v1 v2
v2) Hash
h1 k
k1 Int
s HashMap k v2
t2

    -- In this case, we need to check that for each x in ls1, there is a y in
    -- ls2 such that x `comp` y. This is the worst case complexity-wise since it
    -- requires a O(m*n) check.
    go Int
_ (Collision Hash
h1 Array (Leaf k v1)
ls1) (Collision Hash
h2 Array (Leaf k v2)
ls2) =
      Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2 Bool -> Bool -> Bool
&& (v1 -> v2 -> Bool)
-> Array (Leaf k v1) -> Array (Leaf k v2) -> Bool
forall k v1 v2.
Eq k =>
(v1 -> v2 -> Bool)
-> Array (Leaf k v1) -> Array (Leaf k v2) -> Bool
subsetArray v1 -> v2 -> Bool
comp Array (Leaf k v1)
ls1 Array (Leaf k v2)
ls2

    -- In this case, we only need to check the entries in ls2 with the hash h1.
    go Int
s t1 :: HashMap k v1
t1@(Collision Hash
h1 Array (Leaf k v1)
_) (BitmapIndexed Hash
b Array (HashMap k v2)
ls2)
        | Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = Bool
False
        | Bool
otherwise    =
            Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ls2 (Hash -> Hash -> Int
sparseIndex Hash
b Hash
m))
      where m :: Hash
m = Hash -> Int -> Hash
mask Hash
h1 Int
s

    -- Similar to the previous case we need to traverse l2 at the index for the hash h1.
    go Int
s t1 :: HashMap k v1
t1@(Collision Hash
h1 Array (Leaf k v1)
_) (Full Array (HashMap k v2)
ls2) =
      Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ls2 (Hash -> Int -> Int
index Hash
h1 Int
s))

    -- In cases where the first and second map are BitmapIndexed or Full,
    -- traverse down the tree at the appropriate indices.
    go Int
s (BitmapIndexed Hash
b1 Array (HashMap k v1)
ls1) (BitmapIndexed Hash
b2 Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
b1 Array (HashMap k v1)
ls1 Hash
b2 Array (HashMap k v2)
ls2
    go Int
s (BitmapIndexed Hash
b1 Array (HashMap k v1)
ls1) (Full Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
b1 Array (HashMap k v1)
ls1 Hash
fullNodeMask Array (HashMap k v2)
ls2
    go Int
s (Full Array (HashMap k v1)
ls1) (Full Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
fullNodeMask Array (HashMap k v1)
ls1 Hash
fullNodeMask Array (HashMap k v2)
ls2

    -- Collision and Full nodes always contain at least two entries. Hence it
    -- cannot be a map of a leaf.
    go Int
_ (Collision {}) (Leaf {}) = Bool
False
    go Int
_ (BitmapIndexed {}) (Leaf {}) = Bool
False
    go Int
_ (Full {}) (Leaf {}) = Bool
False
    go Int
_ (BitmapIndexed {}) (Collision {}) = Bool
False
    go Int
_ (Full {}) (Collision {}) = Bool
False
    go Int
_ (Full {}) (BitmapIndexed {}) = Bool
False
{-# INLINABLE isSubmapOfBy #-}

-- | /O(min n m))/ Checks if a bitmap indexed node is a submap of another.
submapBitmapIndexed :: (HashMap k v1 -> HashMap k v2 -> Bool) -> Bitmap -> A.Array (HashMap k v1) -> Bitmap -> A.Array (HashMap k v2) -> Bool
submapBitmapIndexed :: (HashMap k v1 -> HashMap k v2 -> Bool)
-> Hash
-> Array (HashMap k v1)
-> Hash
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed HashMap k v1 -> HashMap k v2 -> Bool
comp !Hash
b1 !Array (HashMap k v1)
ary1 !Hash
b2 !Array (HashMap k v2)
ary2 = Bool
subsetBitmaps Bool -> Bool -> Bool
&& Int -> Int -> Hash -> Bool
go Int
0 Int
0 (Hash
b1Orb2 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Num a => a -> a
negate Hash
b1Orb2)
  where
    go :: Int -> Int -> Bitmap -> Bool
    go :: Int -> Int -> Hash -> Bool
go !Int
i !Int
j !Hash
m
      | Hash
m Hash -> Hash -> Bool
forall a. Ord a => a -> a -> Bool
> Hash
b1Orb2 = Bool
True

      -- In case a key is both in ary1 and ary2, check ary1[i] <= ary2[j] and
      -- increment the indices i and j.
      | Hash
b1Andb2 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash
0 = HashMap k v1 -> HashMap k v2 -> Bool
comp (Array (HashMap k v1) -> Int -> HashMap k v1
forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary1 Int
i) (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ary2 Int
j) Bool -> Bool -> Bool
&&
                             Int -> Int -> Hash -> Bool
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Hash
m Hash -> Int -> Hash
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)

      -- In case a key occurs in ary1, but not ary2, only increment index j.
      | H