{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveLift            #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE RoleAnnotations       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeInType            #-}
{-# LANGUAGE UnboxedSums           #-}
{-# LANGUAGE UnboxedTuples         #-}
{-# 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
    , update32
    , update32M
    , update32With'
    , updateOrConcatWith
    , updateOrConcatWithKey
    , filterMapAux
    , equalKeys
    , equalKeys1
    , lookupRecordCollision
    , LookupRes(..)
    , insert'
    , delete'
    , lookup'
    , insertNewKey
    , insertKeyExists
    , deleteKeyExists
    , insertModifying
    , ptrEq
    , adjust#
    ) where

import Control.Applicative        (Const (..))
import Control.DeepSeq            (NFData (..), NFData1 (..), NFData2 (..))
import Control.Monad.ST           (ST, runST)
import Data.Bifoldable            (Bifoldable (..))
import Data.Bits                  (complement, popCount, unsafeShiftL,
                                   unsafeShiftR, (.&.), (.|.))
import Data.Coerce                (coerce)
import Data.Data                  (Constr, Data (..), DataType)
import Data.Functor.Classes       (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..),
                                   Read1 (..), Show1 (..), Show2 (..))
import Data.Functor.Identity      (Identity (..))
import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare)
import Data.Hashable              (Hashable)
import Data.Hashable.Lifted       (Hashable1, Hashable2)
import Data.Semigroup             (Semigroup (..), stimesIdempotentMonoid)
import GHC.Exts                   (Int (..), Int#, TYPE, (==#))
import GHC.Stack                  (HasCallStack)
import Prelude                    hiding (filter, foldl, foldr, lookup, map,
                                   null, pred)
import Text.Read                  hiding (step)

import qualified Data.Data                   as Data
import qualified Data.Foldable               as Foldable
import qualified Data.Functor.Classes        as FC
import qualified Data.HashMap.Internal.Array as A
import qualified Data.Hashable               as H
import qualified Data.Hashable.Lifted        as H
import qualified Data.List                   as List
import qualified GHC.Exts                    as Exts
import qualified Language.Haskell.TH.Syntax  as TH

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

-- | @since 0.2.17.0
instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Leaf k v -> Q (TExp (Leaf k v))
liftTyped (L k
k v
v) = [|| L k $! v ||]
#else
  lift (L k v) = [| L k $! v |]
#endif

-- | @since 0.2.14.0
instance NFData k => 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 -> ()
liftRnf2 k -> ()
forall a. NFData a => a -> ()
rnf a -> ()
rnf2

-- | @since 0.2.14.0
instance 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

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

type role HashMap nominal representational

-- | @since 0.2.17.0
deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)

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

-- | @since 0.2.14.0
instance NFData k => 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 -> ()
liftRnf2 k -> ()
forall a. NFData a => a -> ()
rnf a -> ()
rnf2

-- | @since 0.2.14.0
instance 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 -> ()
liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
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 -> ()
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 -> ()
liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
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 -> ()
liftRnf ((a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (Leaf a b)
ary

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' #-}
    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 #-}

-- | @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 #-}

-- | '<>' = '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 (<>) #-}
  stimes :: b -> HashMap k v -> HashMap k v
stimes = b -> HashMap k v -> HashMap k v
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
  {-# INLINE stimes #-}

-- | '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 #-}
  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
(<>)
  {-# 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
Data.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
    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (HashMap k v))
dataCast1 forall d. Data d => c (t d)
f    = c (t v) -> Maybe (c (HashMap k v))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
Data.gcast1 c (t v)
forall d. Data d => c (t d)
f
    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))
Data.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
Data.mkConstr DataType
hashMapDataType [Char]
"fromList" [] Fixity
Data.Prefix

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

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

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

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

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

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

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

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

instance 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
List.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]
List.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]
List.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) => 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

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
List.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]
List.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]
List.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
-- 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# #-}

-- | 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
-- 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' #-}

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

-- 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 ::
  forall rep (r :: TYPE rep) k v.
     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.
(!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v
(!) 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
update32 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
update32 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
update32 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
update32 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
update32 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 #-}

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

-- | /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
Exts.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