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

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

      -- * Construction
    , empty
    , singleton

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

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

      -- * Transformations
    , map
    , mapWithKey
    , traverseWithKey

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

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

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

      -- * Conversions
    , keys
    , elems

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type role HashMap nominal representational

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

#else

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

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

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

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

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

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

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

-- A two-continuation version of lookupRecordCollision. This lets us
-- share source code between lookup and lookupRecordCollision without
-- risking any performance degradation.
--
-- The absent continuation has type @((# #) -> r)@ instead of just @r@
-- so we can be representation-polymorphic in the result type. Since
-- this whole thing is always inlined, we don't have to worry about
-- any extra CPS overhead.
lookupCont ::
#if __GLASGOW_HASKELL__ >= 802
  forall rep (r :: TYPE rep) k v.
#else
  forall r k v.
#endif
     Eq k
  => ((# #) -> r)    -- Absent continuation
  -> (v -> Int -> r) -- Present continuation
  -> Hash -- The hash of the key
  -> k -> HashMap k v -> r
lookupCont :: ((# #) -> r) -> (v -> Int -> r) -> Hash -> k -> HashMap k v -> r
lookupCont (# #) -> r
absent v -> Int -> r
present !Hash
h0 !k
k0 !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
0 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.10, replaced
-- by 'findWithDefault'.
lookupDefault :: (Eq k, Hashable k)
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
lookupDefault :: v -> k -> HashMap k v -> v
lookupDefault v
def k
k HashMap k v
t = v -> k -> HashMap k v -> v
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
findWithDefault v
def k
k HashMap k v
t
{-# INLINE lookupDefault #-}

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

infixl 9 !

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

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

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

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

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


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

{-# NOINLINE insertKeyExists #-}

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


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

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

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

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

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

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

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

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

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

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

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

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


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

-- | /O(log n)/  The expression (@'alterF' f k map@) alters the value @x@ at
-- @k@, or absence thereof. @alterF@ can be used to insert, delete, or update
-- a value in a map.
--
-- Note: 'alterF' is a flipped version of the 'at' combinator from
-- <https://hackage.haskell.org/package/lens-4.15.4/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 -> 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
      Just v
v' -> Hash -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
insert' Hash
h k
k v
v' HashMap k v
m

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


------------------------------------------------------------------------
-- * Combine

-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, the
-- mapping from the first will be the mapping in the result.
--
-- ==== __Examples__
--
-- >>> union (fromList [(1,'a'),(2,'b')]) (fromList [(2,'c'),(3,'d')])
-- fromList [(1,'a'),(2,'b'),(3,'d')]
union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v
union :: HashMap k v -> HashMap k v -> HashMap k v
union = (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWith v -> v -> v
forall a b. a -> b -> a
const
{-# INLINABLE union #-}

-- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
-- the provided function (first argument) will be used to compute the
-- result.
unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v
          -> HashMap k v
unionWith :: (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWith v -> v -> v
f = (k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWithKey ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
f)
{-# INLINE unionWith #-}

-- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
-- the provided function (first argument) will be used to compute the
-- result.
unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
          -> HashMap k v
unionWithKey :: (k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWithKey k -> v -> v -> v
f = Int -> HashMap k v -> HashMap k v -> HashMap k v
go Int
0
  where
    -- empty vs. anything
    go :: Int -> HashMap k v -> HashMap k v -> HashMap k v
go !Int
_ HashMap k v
t1 HashMap k v
Empty = HashMap k v
t1
    go Int
_ HashMap k v
Empty HashMap k v
t2 = HashMap k v
t2
    -- leaf vs. leaf
    go Int
s t1 :: HashMap k v
t1@(Leaf Hash
h1 l1 :: Leaf k v
l1@(L k
k1 v
v1)) t2 :: HashMap k v
t2@(Leaf Hash
h2 l2 :: Leaf k v
l2@(L k
k2 v
v2))
        | Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2  = if k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2
                      then 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 (k -> v -> v -> v
f k
k1 v
v1 v
v2))
                      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
h1 Leaf k v
l1 Leaf k v
l2
        | Bool
otherwise = Int -> Hash -> Hash -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Hash
h1 Hash
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Leaf Hash
h1 (L k
k1 v
v1)) t2 :: HashMap k v
t2@(Collision Hash
h2 Array (Leaf k v)
ls2)
        | Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2  = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h1 ((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
k v
a v
b -> (# k -> v -> v -> v
f k
k v
a v
b #)) k
k1 v
v1 Array (Leaf k v)
ls2)
        | Bool
otherwise = Int -> Hash -> Hash -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Hash
h1 Hash
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Hash
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Leaf Hash
h2 (L k
k2 v
v2))
        | Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2  = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h1 ((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
k v
a v
b -> (# k -> v -> v -> v
f k
k v
b v
a #)) k
k2 v
v2 Array (Leaf k v)
ls1)
        | Bool
otherwise = Int -> Hash -> Hash -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Hash
h1 Hash
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Hash
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Collision Hash
h2 Array (Leaf k v)
ls2)
        | Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h2  = Hash -> Array (Leaf k v) -> HashMap k v
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h1 ((k -> v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWithKey k -> v -> v -> v
f Array (Leaf k v)
ls1 Array (Leaf k v)
ls2)
        | Bool
otherwise = Int -> Hash -> Hash -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Hash
h1 Hash
h2 HashMap k v
t1 HashMap k v
t2
    -- branch vs. branch
    go Int
s (BitmapIndexed Hash
b1 Array (HashMap k v)
ary1) (BitmapIndexed Hash
b2 Array (HashMap k v)
ary2) =
        let b' :: Hash
b'   = Hash
b1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
b2
            ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Hash
-> Hash
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Hash -> Hash -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
b1 Hash
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Hash
b' Array (HashMap k v)
ary'
    go Int
s (BitmapIndexed Hash
b1 Array (HashMap k v)
ary1) (Full Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Hash
-> Hash
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Hash -> Hash -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
b1 Hash
fullNodeMask Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s (Full Array (HashMap k v)
ary1) (BitmapIndexed Hash
b2 Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Hash
-> Hash
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Hash -> Hash -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
fullNodeMask Hash
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s (Full Array (HashMap k v)
ary1) (Full Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Hash
-> Hash
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Hash -> Hash -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Hash
fullNodeMask Hash
fullNodeMask
                   Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    -- leaf vs. branch
    go Int
s (BitmapIndexed Hash
b1 Array (HashMap k v)
ary1) HashMap k v
t2
        | Hash
b1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m2 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)
ary1 Int
i HashMap k v
t2
                               b' :: Hash
b'   = Hash
b1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m2
                           in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Hash
b' Array (HashMap k v)
ary'
        | Bool
otherwise      = let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary1 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st1 HashMap k v
t2
                           in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b1 Array (HashMap k v)
ary'
        where
          h2 :: Hash
h2 = HashMap k v -> Hash
forall k v. HashMap k v -> Hash
leafHashCode HashMap k v
t2
          m2 :: Hash
m2 = Hash -> Int -> Hash
mask Hash
h2 Int
s
          i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b1 Hash
m2
    go Int
s HashMap k v
t1 (BitmapIndexed Hash
b2 Array (HashMap k v)
ary2)
        | Hash
b2 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
m1 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)
ary2 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
t1
                               b' :: Hash
b'   = Hash
b2 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m1
                           in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Hash
b' Array (HashMap k v)
ary'
        | Bool
otherwise      = let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary2 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
t1 HashMap k v
st2
                           in Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b2 Array (HashMap k v)
ary'
      where
        h1 :: Hash
h1 = HashMap k v -> Hash
forall k v. HashMap k v -> Hash
leafHashCode HashMap k v
t1
        m1 :: Hash
m1 = Hash -> Int -> Hash
mask Hash
h1 Int
s
        i :: Int
i = Hash -> Hash -> Int
sparseIndex Hash
b2 Hash
m1
    go Int
s (Full Array (HashMap k v)
ary1) HashMap k v
t2 =
        let h2 :: Hash
h2   = HashMap k v -> Hash
forall k v. HashMap k v -> Hash
leafHashCode HashMap k v
t2
            i :: Int
i    = Hash -> Int -> Int
index Hash
h2 Int
s
            ary' :: Array (HashMap k v)
ary' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
update16With' Array (HashMap k v)
ary1 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st1 HashMap k v
t2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s HashMap k v
t1 (Full Array (HashMap k v)
ary2) =
        let h1 :: Hash
h1   = HashMap k v -> Hash
forall k v. HashMap k v -> Hash
leafHashCode HashMap k v
t1
            i :: Int
i    = Hash -> Int -> Int
index Hash
h1 Int
s
            ary' :: Array (HashMap k v)
ary' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
update16With' Array (HashMap k v)
ary2 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
t1 HashMap k v
st2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'

    leafHashCode :: HashMap k v -> Hash
leafHashCode (Leaf Hash
h Leaf k v
_) = Hash
h
    leafHashCode (Collision Hash
h Array (Leaf k v)
_) = Hash
h
    leafHashCode HashMap k v
_ = [Char] -> Hash
forall a. HasCallStack => [Char] -> a
error [Char]
"leafHashCode"

    goDifferentHash :: Int -> Hash -> Hash -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Hash
h1 Hash
h2 HashMap k v
t1 HashMap k v
t2
        | Hash
m1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
m2  = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
m1 (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
t1 HashMap k v
t2)
        | Hash
m1 Hash -> Hash -> Bool
forall a. Ord a => a -> a -> Bool
<  Hash
m2  = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash
m1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m2) (HashMap k v -> HashMap k v -> Array (HashMap k v)
forall a. a -> a -> Array a
A.pair HashMap k v
t1 HashMap k v
t2)
        | Bool
otherwise = Hash -> Array (HashMap k v) -> HashMap k v
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Hash
m1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
m2) (HashMap k v -> HashMap k v -> Array (HashMap k v)
forall a. a -> a -> Array a
A.pair HashMap k v
t2 HashMap k v
t1)
      where
        m1 :: Hash
m1 = Hash -> Int -> Hash
mask Hash
h1 Int
s
        m2 :: Hash
m2 = Hash -> Int -> Hash
mask Hash
h2 Int
s
{-# INLINE unionWithKey #-}

-- | Strict in the result of @f@.
unionArrayBy :: (a -> a -> a) -> Bitmap -> Bitmap -> A.Array a -> A.Array a
             -> A.Array a
unionArrayBy :: (a -> a -> a) -> Hash -> Hash -> Array a -> Array a -> Array a
unionArrayBy a -> a -> a
f Hash
b1 Hash
b2 Array a
ary1 Array a
ary2 = (forall s. ST s (MArray s a)) -> Array a
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s a)) -> Array a)
-> (forall s. ST s (MArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
    let b' :: Hash
b' = Hash
b1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.|. Hash
b2
    MArray s a
mary <- Int -> ST s (MArray s a)
forall s a. Int -> ST s (MArray s a)
A.new_ (Hash -> Int
forall a. Bits a => a -> Int
popCount Hash
b')
    -- iterate over nonzero bits of b1 .|. b2
    -- it would be nice if we could shift m by more than 1 each time
    let ba :: Hash
ba = Hash
b1 Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
b2
        go :: Int -> Int -> Int -> Hash -> ST s ()
go !Int
i !Int
i1 !Int
i2 !Hash
m
            | Hash
m Hash -> Hash -> Bool
forall a. Ord a => a -> a -> Bool
> Hash
b'        = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | 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 = Int -> Int -> Int -> Hash -> ST s ()
go Int
i Int
i1 Int
i2 (Hash
m Hash -> Int -> Hash
`unsafeShiftL` Int
1)
            | Hash
ba 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
                a
x1 <- Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                a
x2 <- Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$! a -> a -> a
f a
x1 a
x2
                Int -> Int -> Int -> Hash -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Hash
m Hash -> Int -> Hash
`unsafeShiftL` Int
1)
            | Hash
b1 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
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> ST s a -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                Int -> Int -> Int -> Hash -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i2  ) (Hash
m Hash -> Int -> Hash
`unsafeShiftL` Int
1)
            | Bool
otherwise     = do
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> ST s a -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                Int -> Int -> Int -> Hash -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i1  ) (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Hash
m Hash -> Int -> Hash
`unsafeShiftL` Int
1)
    Int -> Int -> Int -> Hash -> ST s ()
go Int
0 Int
0 Int
0 (Hash
b' Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Num a => a -> a
negate Hash
b') -- XXX: b' must be non-zero
    MArray s a -> ST s (MArray s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
mary
    -- TODO: For the case where b1 .&. b2 == b1, i.e. when one is a
    -- subset of the other, we could use a slightly simpler algorithm,
    -- where we copy one array, and then update.
{-# INLINE unionArrayBy #-}

-- TODO: Figure out the time complexity of 'unions'.

-- | Construct a set containing all elements from a list of sets.
unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
unions :: [HashMap k v] -> HashMap k v
unions = (HashMap k v -> HashMap k v -> HashMap k v)
-> HashMap k v -> [HashMap k v] -> HashMap k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' 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 HashMap k v
forall k v. HashMap k v
empty
{-# INLINE unions #-}

------------------------------------------------------------------------
-- * Transformations

-- | /O(n)/ Transform this map by applying a function to every value.
mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
mapWithKey k -> v1 -> v2
f = HashMap k v1 -> HashMap k v2
go
  where
    go :: HashMap k v1 -> HashMap k v2
go HashMap k v1
Empty = HashMap k v2
forall k v. HashMap k v
Empty
    go (Leaf Hash
h (L k
k v1
v)) = Hash -> Leaf k v2 -> HashMap k v2
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Leaf k v2 -> HashMap k v2) -> Leaf k v2 -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (k -> v1 -> v2
f k
k v1
v)
    go (BitmapIndexed Hash
b Array (HashMap k v1)
ary) = Hash -> Array (HashMap k v2) -> HashMap k v2
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v2) -> HashMap k v2)
-> Array (HashMap k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ (HashMap k v1 -> HashMap k v2)
-> Array (HashMap k v1) -> Array (HashMap k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map HashMap k v1 -> HashMap k v2
go Array (HashMap k v1)
ary
    go (Full Array (HashMap k v1)
ary) = Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v2) -> HashMap k v2)
-> Array (HashMap k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ (HashMap k v1 -> HashMap k v2)
-> Array (HashMap k v1) -> Array (HashMap k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map HashMap k v1 -> HashMap k v2
go Array (HashMap k v1)
ary
    -- Why map strictly over collision arrays? Because there's no
    -- point suspending the O(1) work this does for each leaf.
    go (Collision Hash
h Array (Leaf k v1)
ary) = Hash -> Array (Leaf k v2) -> HashMap k v2
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Array (Leaf k v2) -> HashMap k v2)
-> Array (Leaf k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$
                           (Leaf k v1 -> Leaf k v2) -> Array (Leaf k v1) -> Array (Leaf k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map' (\ (L k
k v1
v) -> k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (k -> v1 -> v2
f k
k v1
v)) Array (Leaf k v1)
ary
{-# INLINE mapWithKey #-}

-- | /O(n)/ Transform this map by applying a function to every value.
map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
map v1 -> v2
f = (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
mapWithKey ((v1 -> v2) -> k -> v1 -> v2
forall a b. a -> b -> a
const v1 -> v2
f)
{-# INLINE map #-}

-- TODO: We should be able to use mutation to create the new
-- 'HashMap'.

-- | /O(n)/ Perform an 'Applicative' action for each key-value pair
-- in a 'HashMap' and produce a 'HashMap' of all the results.
--
-- Note: the order in which the actions occur is unspecified. In particular,
-- when the map contains hash collisions, the order in which the actions
-- associated with the keys involved will depend in an unspecified way on
-- their insertion order.
traverseWithKey
  :: Applicative f
  => (k -> v1 -> f v2)
  -> HashMap k v1 -> f (HashMap k v2)
traverseWithKey :: (k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
traverseWithKey k -> v1 -> f v2
f = HashMap k v1 -> f (HashMap k v2)
go
  where
    go :: HashMap k v1 -> f (HashMap k v2)
go HashMap k v1
Empty                 = HashMap k v2 -> f (HashMap k v2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v2
forall k v. HashMap k v
Empty
    go (Leaf Hash
h (L k
k v1
v))      = Hash -> Leaf k v2 -> HashMap k v2
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (Leaf k v2 -> HashMap k v2)
-> (v2 -> Leaf k v2) -> v2 -> HashMap k v2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (v2 -> HashMap k v2) -> f v2 -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> f v2
f k
k v1
v
    go (BitmapIndexed Hash
b Array (HashMap k v1)
ary) = Hash -> Array (HashMap k v2) -> HashMap k v2
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v2) -> HashMap k v2)
-> f (Array (HashMap k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap k v1 -> f (HashMap k v2))
-> Array (HashMap k v1) -> f (Array (HashMap k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse HashMap k v1 -> f (HashMap k v2)
go Array (HashMap k v1)
ary
    go (Full Array (HashMap k v1)
ary)            = Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v2) -> HashMap k v2)
-> f (Array (HashMap k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap k v1 -> f (HashMap k v2))
-> Array (HashMap k v1) -> f (Array (HashMap k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse HashMap k v1 -> f (HashMap k v2)
go Array (HashMap k v1)
ary
    go (Collision Hash
h Array (Leaf k v1)
ary)     =
        Hash -> Array (Leaf k v2) -> HashMap k v2
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h (Array (Leaf k v2) -> HashMap k v2)
-> f (Array (Leaf k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Leaf k v1 -> f (Leaf k v2))
-> Array (Leaf k v1) -> f (Array (Leaf k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse' (\ (L k
k v1
v) -> k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (v2 -> Leaf k v2) -> f v2 -> f (Leaf k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> f v2
f k
k v1
v) Array (Leaf k v1)
ary
{-# INLINE traverseWithKey #-}

------------------------------------------------------------------------
-- * Difference and intersection

-- | /O(n*log m)/ Difference of two maps. Return elements of the first map
-- not existing in the second.
difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
difference :: HashMap k v -> HashMap k w -> HashMap k v
difference HashMap k v
a HashMap k w
b = (HashMap k v -> k -> v -> HashMap k v)
-> HashMap k v -> HashMap k v -> HashMap k v
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go HashMap k v
forall k v. HashMap k v
empty HashMap k v
a
  where
    go :: HashMap k v -> k -> v -> HashMap k v
go HashMap k v
m k
k v
v = case k -> HashMap k w -> Maybe w
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> 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
                 Maybe w
_       -> HashMap k v
m
{-# INLINABLE difference #-}

-- | /O(n*log m)/ Difference with a combining function. When two equal keys are
-- encountered, the combining function is applied to the values of these keys.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@.
differenceWith :: (Eq k, Hashable k) => (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
differenceWith :: (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
differenceWith v -> w -> Maybe v
f HashMap k v
a HashMap k w
b = (HashMap k v -> k -> v -> HashMap k v)
-> HashMap k v -> HashMap k v -> HashMap k v
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go HashMap k v
forall k v. HashMap k v
empty HashMap k v
a
  where
    go :: HashMap k v -> k -> v -> HashMap k v
go HashMap k v
m k
k v
v = case k -> HashMap k w -> Maybe w
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> 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
                 Just w
w  -> 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 (\v
y -> 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
y HashMap k v
m) (v -> w -> Maybe v
f v
v w
w)
{-# INLINABLE differenceWith #-}

-- | /O(n*log m)/ Intersection of two maps. Return elements of the first
-- map for keys existing in the second.
intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
intersection :: HashMap k v -> HashMap k w -> HashMap k v
intersection HashMap k v
a HashMap k w
b = (HashMap k v -> k -> v -> HashMap k v)
-> HashMap k v -> HashMap k v -> HashMap k v
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go HashMap k v
forall k v. HashMap k v
empty HashMap k v
a
  where
    go :: HashMap k v -> k -> v -> HashMap k v
go HashMap k v
m k
k v
v = case k -> HashMap k w -> Maybe w
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Just w
_ -> 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
                 Maybe w
_      -> HashMap k v
m
{-# INLINABLE intersection #-}

-- | /O(n*log m)/ Intersection of two maps. If a key occurs in both maps
-- the provided function is used to combine the values from the two
-- maps.
intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1
                 -> HashMap k v2 -> HashMap k v3
intersectionWith :: (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith v1 -> v2 -> v3
f HashMap k v1
a HashMap k v2
b = (HashMap k v3 -> k -> v1 -> HashMap k v3)
-> HashMap k v3 -> HashMap k v1 -> HashMap k v3
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v3 -> k -> v1 -> HashMap k v3
go HashMap k v3
forall k v. HashMap k v
empty HashMap k v1
a
  where
    go :: HashMap k v3 -> k -> v1 -> HashMap k v3
go HashMap k v3
m k
k v1
v = case k -> HashMap k v2 -> Maybe v2
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v2
b of
                 Just v2
w -> k -> v3 -> HashMap k v3 -> HashMap k v3
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert k
k (v1 -> v2 -> v3
f v1
v v2
w) HashMap k v3
m
                 Maybe v2
_      -> HashMap k v3
m
{-# INLINABLE intersectionWith #-}

-- | /O(n*log m)/ Intersection of two maps. If a key occurs in both maps
-- the provided function is used to combine the values from the two
-- maps.
intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3)
                    -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey :: (k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey k -> v1 -> v2 -> v3
f HashMap k v1
a HashMap k v2
b = (HashMap k v3 -> k -> v1 -> HashMap k v3)
-> HashMap k v3 -> HashMap k v1 -> HashMap k v3
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v3 -> k -> v1 -> HashMap k v3
go HashMap k v3
forall k v. HashMap k v
empty HashMap k v1
a
  where
    go :: HashMap k v3 -> k -> v1 -> HashMap k v3
go HashMap k v3
m k
k v1
v = case k -> HashMap k v2 -> Maybe v2
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v2
b of
                 Just v2
w -> k -> v3 -> HashMap k v3 -> HashMap k v3
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert k
k (k -> v1 -> v2 -> v3
f k
k v1
v v2
w) HashMap k v3
m
                 Maybe v2
_      -> HashMap k v3
m
{-# INLINABLE intersectionWithKey #-}

------------------------------------------------------------------------
-- * Folds

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- left-identity of the operator).  Each application of the operator
-- is evaluated before using the result in the next application.
-- This function is strict in the starting value.
foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
foldl' a -> v -> a
f = (a -> k -> v -> a) -> a -> HashMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' (\ a
z k
_ v
v -> a -> v -> a
f a
z v
v)
{-# INLINE foldl' #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).  Each application of the operator
-- is evaluated before using the result in the next application.
-- This function is strict in the starting value.
foldr' :: (v -> a -> a) -> a -> HashMap k v -> a
foldr' :: (v -> a -> a) -> a -> HashMap k v -> a
foldr' v -> a -> a
f = (k -> v -> a -> a) -> a -> HashMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey' (\ k
_ v
v a
z -> v -> a -> a
f v
v a
z)
{-# INLINE foldr' #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- left-identity of the operator).  Each application of the operator
-- is evaluated before using the result in the next application.
-- This function is strict in the starting value.
foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' a -> k -> v -> a
f = a -> HashMap k v -> a
go
  where
    go :: a -> HashMap k v -> a
go !a
z HashMap k v
Empty                = a
z
    go a
z (Leaf Hash
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Hash
_ Array (HashMap k v)
ary) = (a -> HashMap k v -> a) -> a -> Array (HashMap k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' a -> HashMap k v -> a
go a
z Array (HashMap k v)
ary
    go a
z (Full Array (HashMap k v)
ary)            = (a -> HashMap k v -> a) -> a -> Array (HashMap k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' a -> HashMap k v -> a
go a
z Array (HashMap k v)
ary
    go a
z (Collision Hash
_ Array (Leaf k v)
ary)     = (a -> Leaf k v -> a) -> a -> Array (Leaf k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (\ a
z' (L k
k v
v) -> a -> k -> v -> a
f a
z' k
k v
v) a
z Array (Leaf k v)
ary
{-# INLINE foldlWithKey' #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).  Each application of the operator
-- is evaluated before using the result in the next application.
-- This function is strict in the starting value.
foldrWithKey' :: (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey' :: (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey' k -> v -> a -> a
f = (HashMap k v -> a -> a) -> a -> HashMap k v -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> a -> a
go
  where
    go :: HashMap k v -> a -> a
go HashMap k v
Empty a
z                 = a
z
    go (Leaf Hash
_ (L k
k v
v)) !a
z     = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Hash
_ Array (HashMap k v)
ary) !a
z = (HashMap k v -> a -> a) -> a -> Array (HashMap k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' HashMap k v -> a -> a
go a
z Array (HashMap k v)
ary
    go (Full Array (HashMap k v)
ary) !a
z           = (HashMap k v -> a -> a) -> a -> Array (HashMap k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' HashMap k v -> a -> a
go a
z Array (HashMap k v)
ary
    go (Collision Hash
_ Array (Leaf k v)
ary) !a
z    = (Leaf k v -> a -> a) -> a -> Array (Leaf k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' (\ (L k
k v
v) a
z' -> k -> v -> a -> a
f k
k v
v a
z') a
z Array (Leaf k v)
ary
{-# INLINE foldrWithKey' #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
foldr :: (v -> a -> a) -> a -> HashMap k v -> a
foldr :: (v -> a -> a) -> a -> HashMap k v -> a
foldr v -> a -> a
f = (k -> v -> a -> a) -> a -> HashMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey ((v -> a -> a) -> k -> v -> a -> a
forall a b. a -> b -> a
const v -> a -> a
f)
{-# INLINE foldr #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- left-identity of the operator).
foldl :: (a -> v -> a) -> a -> HashMap k v -> a
foldl :: (a -> v -> a) -> a -> HashMap k v -> a
foldl a -> v -> a
f = (a -> k -> v -> a) -> a -> HashMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey (\a
a k
_k v
v -> a -> v -> a
f a
a v
v)
{-# INLINE foldl #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey k -> v -> a -> a
f = (HashMap k v -> a -> a) -> a -> HashMap k v -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> a -> a
go
  where
    go :: HashMap k v -> a -> a
go HashMap k v
Empty a
z                 = a
z
    go (Leaf Hash
_ (L k
k v
v)) a
z      = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Hash
_ Array (HashMap k v)
ary) a
z = (HashMap k v -> a -> a) -> a -> Array (HashMap k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> a -> a
go a
z Array (HashMap k v)
ary
    go (Full Array (HashMap k v)
ary) a
z            = (HashMap k v -> a -> a) -> a -> Array (HashMap k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> a -> a
go a
z Array (HashMap k v)
ary
    go (Collision Hash
_ Array (Leaf k v)
ary) a
z     = (Leaf k v -> a -> a) -> a -> Array (Leaf k v) -> a
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr (\ (L k
k v
v) a
z' -> k -> v -> a -> a
f k
k v
v a
z') a
z Array (Leaf k v)
ary
{-# INLINE foldrWithKey #-}

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- left-identity of the operator).
foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey a -> k -> v -> a
f = a -> HashMap k v -> a
go
  where
    go :: a -> HashMap k v -> a
go a
z HashMap k v
Empty                 = a
z
    go a
z (Leaf Hash
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Hash
_ Array (HashMap k v)
ary) = (a -> HashMap k v -> a) -> a -> Array (HashMap k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl a -> HashMap k v -> a
go a
z Array (HashMap k v)
ary
    go a
z (Full Array (HashMap k v)
ary)            = (a -> HashMap k v -> a) -> a -> Array (HashMap k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl a -> HashMap k v -> a
go a
z Array (HashMap k v)
ary
    go a
z (Collision Hash
_ Array (Leaf k v)
ary)     = (a -> Leaf k v -> a) -> a -> Array (Leaf k v) -> a
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl (\ a
z' (L k
k v
v) -> a -> k -> v -> a
f a
z' k
k v
v) a
z Array (Leaf k v)
ary
{-# INLINE foldlWithKey #-}

-- | /O(n)/ Reduce the map by applying a function to each element
-- and combining the results with a monoid operation.
foldMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m
foldMapWithKey :: (k -> v -> m) -> HashMap k v -> m
foldMapWithKey k -> v -> m
f = HashMap k v -> m
go
  where
    go :: HashMap k v -> m
go HashMap k v
Empty = m
forall a. Monoid a => a
mempty
    go (Leaf Hash
_ (L k
k v
v)) = k -> v -> m
f k
k v
v
    go (BitmapIndexed Hash
_ Array (HashMap k v)
ary) = (HashMap k v -> m) -> Array (HashMap k v) -> m
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap HashMap k v -> m
go Array (HashMap k v)
ary
    go (Full Array (HashMap k v)
ary) = (HashMap k v -> m) -> Array (HashMap k v) -> m
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap HashMap k v -> m
go Array (HashMap k v)
ary
    go (Collision Hash
_ Array (Leaf k v)
ary) = (Leaf k v -> m) -> Array (Leaf k v) -> m
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap (\ (L k
k v
v) -> k -> v -> m
f k
k v
v) Array (Leaf k v)
ary
{-# INLINE foldMapWithKey #-}

------------------------------------------------------------------------
-- * Filter

-- | /O(n)/ Transform this map by applying a function to every value
--   and retaining only some of them.
mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybeWithKey k -> v1 -> Maybe v2
f = (HashMap k v1 -> Maybe (HashMap k v2))
-> (Leaf k v1 -> Maybe (Leaf k v2)) -> HashMap k v1 -> HashMap k v2
forall k v1 v2.
(HashMap k v1 -> Maybe (HashMap k v2))
-> (Leaf k v1 -> Maybe (Leaf k v2)) -> HashMap k v1 -> HashMap k v2
filterMapAux HashMap k v1 -> Maybe (HashMap k v2)
onLeaf Leaf k v1 -> Maybe (Leaf k v2)
onColl
  where onLeaf :: HashMap k v1 -> Maybe (HashMap k v2)
onLeaf (Leaf Hash
h (L k
k v1
v)) | Just v2
v' <- k -> v1 -> Maybe v2
f k
k v1
v = HashMap k v2 -> Maybe (HashMap k v2)
forall a. a -> Maybe a
Just (Hash -> Leaf k v2 -> HashMap k v2
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h (k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k v2
v'))
        onLeaf HashMap k v1
_ = Maybe (HashMap k v2)
forall a. Maybe a
Nothing

        onColl :: Leaf k v1 -> Maybe (Leaf k v2)
onColl (L k
k v1
v) | Just v2
v' <- k -> v1 -> Maybe v2
f k
k v1
v = Leaf k v2 -> Maybe (Leaf k v2)
forall a. a -> Maybe a
Just (k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k v2
v')
                       | Bool
otherwise = Maybe (Leaf k v2)
forall a. Maybe a
Nothing
{-# INLINE mapMaybeWithKey #-}

-- | /O(n)/ Transform this map by applying a function to every value
--   and retaining only some of them.
mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybe v1 -> Maybe v2
f = (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybeWithKey ((v1 -> Maybe v2) -> k -> v1 -> Maybe v2
forall a b. a -> b -> a
const v1 -> Maybe v2
f)
{-# INLINE mapMaybe #-}

-- | /O(n)/ Filter this map by retaining only elements satisfying a
-- predicate.
filterWithKey :: forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v
filterWithKey k -> v -> Bool
pred = (HashMap k v -> Maybe (HashMap k v))
-> (Leaf k v -> Maybe (Leaf k v)) -> HashMap k v -> HashMap k v
forall k v1 v2.
(HashMap k v1 -> Maybe (HashMap k v2))
-> (Leaf k v1 -> Maybe (Leaf k v2)) -> HashMap k v1 -> HashMap k v2
filterMapAux HashMap k v -> Maybe (HashMap k v)
onLeaf Leaf k v -> Maybe (Leaf k v)
onColl
  where onLeaf :: HashMap k v -> Maybe (HashMap k v)
onLeaf t :: HashMap k v
t@(Leaf Hash
_ (L k
k v
v)) | k -> v -> Bool
pred k
k v
v = HashMap k v -> Maybe (HashMap k v)
forall a. a -> Maybe a
Just HashMap k v
t
        onLeaf HashMap k v
_ = Maybe (HashMap k v)
forall a. Maybe a
Nothing

        onColl :: Leaf k v -> Maybe (Leaf k v)
onColl el :: Leaf k v
el@(L k
k v
v) | k -> v -> Bool
pred k
k v
v = Leaf k v -> Maybe (Leaf k v)
forall a. a -> Maybe a
Just Leaf k v
el
        onColl Leaf k v
_ = Maybe (Leaf k v)
forall a. Maybe a
Nothing
{-# INLINE filterWithKey #-}


-- | Common implementation for 'filterWithKey' and 'mapMaybeWithKey',
--   allowing the former to former to reuse terms.
filterMapAux :: forall k v1 v2
              . (HashMap k v1 -> Maybe (HashMap k v2))
             -> (Leaf k v1 -> Maybe (Leaf k v2))
             -> HashMap k v1
             -> HashMap k v2
filterMapAux :: (HashMap k v1 -> Maybe (HashMap k v2))
-> (Leaf k v1 -> Maybe (Leaf k v2)) -> HashMap k v1 -> HashMap k v2
filterMapAux HashMap k v1 -> Maybe (HashMap k v2)
onLeaf Leaf k v1 -> Maybe (Leaf k v2)
onColl = HashMap k v1 -> HashMap k v2
go
  where
    go :: HashMap k v1 -> HashMap k v2
go HashMap k v1
Empty = HashMap k v2
forall k v. HashMap k v
Empty
    go t :: HashMap k v1
t@Leaf{}
        | Just HashMap k v2
t' <- HashMap k v1 -> Maybe (HashMap k v2)
onLeaf HashMap k v1
t = HashMap k v2
t'
        | Bool
otherwise = HashMap k v2
forall k v. HashMap k v
Empty
    go (BitmapIndexed Hash
b Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Hash -> HashMap k v2
filterA Array (HashMap k v1)
ary Hash
b
    go (Full Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Hash -> HashMap k v2
filterA Array (HashMap k v1)
ary Hash
fullNodeMask
    go (Collision Hash
h Array (Leaf k v1)
ary) = Array (Leaf k v1) -> Hash -> HashMap k v2
filterC Array (Leaf k v1)
ary Hash
h

    filterA :: Array (HashMap k v1) -> Hash -> HashMap k v2
filterA Array (HashMap k v1)
ary0 Hash
b0 =
        let !n :: Int
n = Array (HashMap k v1) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v1)
ary0
        in (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v2)) -> HashMap k v2)
-> (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ do
            MArray s (HashMap k v2)
mary <- Int -> ST s (MArray s (HashMap k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary0 MArray s (HashMap k v2)
mary Hash
b0 Int
0 Int
0 Hash
1 Int
n
      where
        step :: A.Array (HashMap k v1) -> A.MArray s (HashMap k v2)
             -> Bitmap -> Int -> Int -> Bitmap -> Int
             -> ST s (HashMap k v2)
        step :: Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
step !Array (HashMap k v1)
ary !MArray s (HashMap k v2)
mary !Hash
b Int
i !Int
j !Hash
bi Int
n
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = case Int
j of
                Int
0 -> HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
forall k v. HashMap k v
Empty
                Int
1 -> do
                    HashMap k v2
ch <- MArray s (HashMap k v2) -> Int -> ST s (HashMap k v2)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v2)
mary Int
0
                    case HashMap k v2
ch of
                      HashMap k v2
t | HashMap k v2 -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v2
t -> HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
t
                      HashMap k v2
_                       -> Hash -> Array (HashMap k v2) -> HashMap k v2
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b (Array (HashMap k v2) -> HashMap k v2)
-> ST s (Array (HashMap k v2)) -> ST s (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MArray s (HashMap k v2) -> Int -> ST s (Array (HashMap k v2))
forall s a. MArray s a -> Int -> ST s (Array a)
A.trim MArray s (HashMap k v2)
mary Int
1
                Int
_ -> do
                    Array (HashMap k v2)
ary2 <- MArray s (HashMap k v2) -> Int -> ST s (Array (HashMap k v2))
forall s a. MArray s a -> Int -> ST s (Array a)
A.trim MArray s (HashMap k v2)
mary Int
j
                    HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxChildren
                              then Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v2)
ary2
                              else Hash -> Array (HashMap k v2) -> HashMap k v2
forall k v. Hash -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Hash
b Array (HashMap k v2)
ary2
            | Hash
bi Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
b Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
0 = Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary Hash
b Int
i Int
j (Hash
bi Hash -> Int -> Hash
`unsafeShiftL` Int
1) Int
n
            | Bool
otherwise = case HashMap k v1 -> HashMap k v2
go (Array (HashMap k v1) -> Int -> HashMap k v1
forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary Int
i) of
                HashMap k v2
Empty -> Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash -> Hash
forall a. Bits a => a -> a
complement Hash
bi) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j
                         (Hash
bi Hash -> Int -> Hash
`unsafeShiftL` Int
1) Int
n
                HashMap k v2
t     -> do MArray s (HashMap k v2) -> Int -> HashMap k v2 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v2)
mary Int
j HashMap k v2
t
                            Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Hash
-> Int
-> Int
-> Hash
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary Hash
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Hash
bi Hash -> Int -> Hash
`unsafeShiftL` Int
1) Int
n

    filterC :: Array (Leaf k v1) -> Hash -> HashMap k v2
filterC Array (Leaf k v1)
ary0 Hash
h =
        let !n :: Int
n = Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary0
        in (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v2)) -> HashMap k v2)
-> (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ do
            MArray s (Leaf k v2)
mary <- Int -> ST s (MArray s (Leaf k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary0 MArray s (Leaf k v2)
mary Int
0 Int
0 Int
n
      where
        step :: A.Array (Leaf k v1) -> A.MArray s (Leaf k v2)
             -> Int -> Int -> Int
             -> ST s (HashMap k v2)
        step :: Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step !Array (Leaf k v1)
ary !MArray s (Leaf k v2)
mary Int
i !Int
j Int
n
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = case Int
j of
                Int
0 -> HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
forall k v. HashMap k v
Empty
                Int
1 -> do Leaf k v2
l <- MArray s (Leaf k v2) -> Int -> ST s (Leaf k v2)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v2)
mary Int
0
                        HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Hash -> Leaf k v2 -> HashMap k v2
forall k v. Hash -> Leaf k v -> HashMap k v
Leaf Hash
h Leaf k v2
l
                Int
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> do Array (Leaf k v2)
ary2 <- MArray s (Leaf k v2) -> ST s (Array (Leaf k v2))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (Leaf k v2)
mary
                                 HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (Leaf k v2) -> HashMap k v2
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h Array (Leaf k v2)
ary2
                  | Bool
otherwise -> do Array (Leaf k v2)
ary2 <- MArray s (Leaf k v2) -> Int -> ST s (Array (Leaf k v2))
forall s a. MArray s a -> Int -> ST s (Array a)
A.trim MArray s (Leaf k v2)
mary Int
j
                                    HashMap k v2 -> ST s (HashMap k v2)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Hash -> Array (Leaf k v2) -> HashMap k v2
forall k v. Hash -> Array (Leaf k v) -> HashMap k v
Collision Hash
h Array (Leaf k v2)
ary2
            | Just Leaf k v2
el <- Leaf k v1 -> Maybe (Leaf k v2)
onColl (Leaf k v1 -> Maybe (Leaf k v2)) -> Leaf k v1 -> Maybe (Leaf k v2)
forall a b. (a -> b) -> a -> b
$! Array (Leaf k v1) -> Int -> Leaf k v1
forall a. Array a -> Int -> a
A.index Array (Leaf k v1)
ary Int
i
                = MArray s (Leaf k v2) -> Int -> Leaf k v2 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v2)
mary Int
j Leaf k v2
el ST s () -> ST s (HashMap k v2) -> ST s (HashMap k v2)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary MArray s (Leaf k v2)
mary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
            | Bool
otherwise = Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary MArray s (Leaf k v2)
mary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j Int
n
{-# INLINE filterMapAux #-}

-- | /O(n)/ Filter this map by retaining only elements which values
-- satisfy a predicate.
filter :: (v -> Bool) -> HashMap k v -> HashMap k v
filter :: (v -> Bool) -> HashMap k v -> HashMap k v
filter v -> Bool
p = (k -> v -> Bool) -> HashMap k v -> HashMap k v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
filterWithKey (\k
_ v
v -> v -> Bool
p v
v)
{-# INLINE filter #-}

------------------------------------------------------------------------
-- * Conversions

-- TODO: Improve fusion rules by modelled them after the Prelude ones
-- on lists.

-- | /O(n)/ Return a list of this map's keys.  The list is produced
-- lazily.
keys :: HashMap k v -> [k]
keys :: HashMap k v -> [k]
keys = ((k, v) -> k) -> [(k, v)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
L.map (k, v) -> k
forall a b. (a, b) -> a
fst ([(k, v)] -> [k])
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
toList
{-# INLINE keys #-}

-- | /O(n)/ Return a list of this map's values.  The list is produced
-- lazily.
elems :: HashMap k v -> [v]
elems :: HashMap k v -> [v]
elems = ((k, v) -> v) -> [(k, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
L.map (k, v) -> v
forall a b. (a, b) -> b
snd ([(k, v)] -> [v])
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
toList
{-# INLINE elems #-}

------------------------------------------------------------------------
-- ** Lists

-- | /O(n)/ Return a list of this map's elements.  The list is
-- produced lazily. The order of its elements is unspecified.
toList :: HashMap k v -> [(k, v)]
toList :: HashMap k v -> [(k, v)]
toList HashMap k v
t = (forall b. ((k, v) -> b -> b) -> b -> b) -> [(k, v)]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ (k, v) -> b -> b
c b
z -> (k -> v -> b -> b) -> b -> HashMap k v -> b
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (((k, v) -> b -> b) -> k -> v -> b -> b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (k, v) -> b -> b
c) b
z HashMap k v
t)
{-# INLINE toList #-}

-- | /O(n)/ Construct a map with the supplied mappings.  If the list
-- contains duplicate mappings, the later mappings take precedence.
fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList :: [(k, v)] -> HashMap k v
fromList = (HashMap k v -> (k, v) -> HashMap k v)
-> HashMap k v -> [(k, v)] -> HashMap k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\ HashMap k v
m (k
k, 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
unsafeInsert k
k v
v HashMap k v
m) HashMap k v
forall k v. HashMap k v
empty
{-# INLINABLE fromList #-}

-- | /O(n*log n)/ Construct a map from a list of elements.  Uses
-- the provided function @f@ to merge duplicate entries with
-- @(f newVal oldVal)@.
--
-- === Examples
--
-- Given a list @xs@, create a map with the number of occurrences of each
-- element in @xs@:
--
-- > let xs = ['a', 'b', 'a']
-- > in fromListWith (+) [ (x, 1) | x <- xs ]
-- >
-- > = fromList [('a', 2), ('b', 1)]
--
-- Given a list of key-value pairs @xs :: [(k, v)]@, group all values by their
-- keys and return a @HashMap k [v]@.
--
-- > let xs = [('a', 1), ('b', 2), ('a', 3)]
-- > in fromListWith (++) [ (k, [v]) | (k, v) <- xs ]
-- >
-- > = fromList [('a', [3, 1]), ('b', [2])]
--
-- Note that the lists in the resulting map contain elements in reverse order
-- from their occurences in the original list.
--
-- More generally, duplicate entries are accumulated as follows;
-- this matters when @f@ is not commutative or not associative.
--
-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]
-- > = fromList [(k, f d (f c (f b a)))]
fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWith :: (v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWith v -> v -> v
f = (HashMap k v -> (k, v) -> HashMap k v)
-> HashMap k v -> [(k, v)] -> HashMap k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\ HashMap k v
m (k
k, v
v) -> (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWith v -> v -> v
f k
k v
v HashMap k v
m) HashMap k v
forall k v. HashMap k v
empty
{-# INLINE fromListWith #-}

-- | /O(n*log n)/ Construct a map from a list of elements.  Uses
-- the provided function to merge duplicate entries.
--
-- === Examples
--
-- Given a list of key-value pairs where the keys are of different flavours, e.g:
--
-- > data Key = Div | Sub
--
-- and the values need to be combined differently when there are duplicates,
-- depending on the key:
--
-- > combine Div = div
-- > combine Sub = (-)
--
-- then @fromListWithKey@ can be used as follows:
--
-- > fromListWithKey combine [(Div, 2), (Div, 6), (Sub, 2), (Sub, 3)]
-- > = fromList [(Div, 3), (Sub, 1)]
--
-- More generally, duplicate entries are accumulated as follows;
--
-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)]
-- > = fromList [(k, f k d (f k c (f k b a)))]
--
-- @since 0.2.11
fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWithKey :: (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWithKey k -> v -> v -> v
f = (HashMap k v -> (k, v) -> HashMap k v)
-> HashMap k v -> [(k, v)] -> HashMap k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\ HashMap k v
m (k
k, v
v) -> (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 k -> v -> v -> v
f k
k v
v HashMap k v
m) HashMap k v
forall k v. HashMap k v
empty
{-# INLINE fromListWithKey #-}

------------------------------------------------------------------------
-- Array operations

-- | /O(n)/ Look up the value associated with the given key in an
-- array.
lookupInArrayCont ::
#if __GLASGOW_HASKELL__ >= 802
  forall rep (r :: TYPE rep) k v.
#else
  forall r k v.
#endif
  Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
lookupInArrayCont :: ((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (# #) -> r
absent v -> Int -> r
present k
k0 Array (Leaf k v)
ary0 = k -> Array (Leaf k v) -> Int -> Int -> r
Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
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 :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
    go :: k -> Array (Leaf k v) -> Int -> Int -> r
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    = (# #) -> r
absent (# #)
        | 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
v)
                | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx   -> v -> Int -> r
present v
v Int
i
                | Bool
otherwise -> k -> Array (Leaf k v) -> Int -> Int -> r
Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go k
k Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE lookupInArrayCont #-}

-- | /O(n)/ Lookup the value associated with the given key in this
-- array.  Returns 'Nothing' if the key wasn't found.
indexOf :: Eq k => k -> A.Array (Leaf k v) -> Maybe Int
indexOf :: k -> Array (Leaf k v) -> Maybe Int
indexOf k
k0 Array (Leaf k v)
ary0 = k -> Array (Leaf k v) -> Int -> Int -> Maybe Int
forall t v.
Eq t =>
t -> Array (Leaf t v) -> Int -> Int -> Maybe Int
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 :: t -> Array (Leaf t v) -> Int -> Int -> Maybe Int
go !t
k !Array (Leaf t v)
ary !Int
i !Int
n
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = Maybe Int
forall a. Maybe a
Nothing
        | Bool
otherwise = case Array (Leaf t v) -> Int -> Leaf t v
forall a. Array a -> Int -> a
A.index Array (Leaf t v)
ary Int
i of
            (L t
kx v
_)
                | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
kx   -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
                | Bool
otherwise -> t -> Array (Leaf t v) -> Int -> Int -> Maybe Int
go t
k Array (Leaf t v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINABLE indexOf #-}

updateWith# :: Eq k => (v -> (# v #)) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
updateWith# :: (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
updateWith# 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    = Array (Leaf k v)
ary
        | 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' #)
                             | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y' -> Array (Leaf k v)
ary
                             | Bool
otherwise -> 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
{-# INLINABLE updateWith# #-}

updateOrSnocWith :: Eq k => (v -> v -> (# v #)) -> k -> v -> A.Array (Leaf k v)
                 -> A.Array (Leaf k v)
updateOrSnocWith :: (v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith v -> v -> (# v #)
f = (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 ((v -> v -> (# v #)) -> k -> v -> v -> (# v #)
forall a b. a -> b -> a
const v -> v -> (# v #)
f)
{-# INLINABLE updateOrSnocWith #-}

updateOrSnocWithKey :: Eq k => (k -> v -> v -> (# v #)) -> k -> v -> A.Array (Leaf k v)
                 -> A.Array (Leaf k v)
updateOrSnocWithKey :: (k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey k -> v -> v -> (# v #)
f k
k0 v
v0 Array (Leaf k v)
ary0 = k -> v -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k0 v
v0 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 -> v -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go !k
k v
v !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
v)
            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
        | L k
kx v
y <- Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i
        , k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx
        , (# v
v2 #) <- k -> v -> v -> (# v #)
f k
k v
v v
y
            = 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
v2)
        | Bool
otherwise
            = k -> v -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k v
v Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINABLE updateOrSnocWithKey #-}

updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
updateOrConcatWith :: (v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWith v -> v -> v
f = (k -> v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWithKey ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
f)
{-# INLINABLE updateOrConcatWith #-}

updateOrConcatWithKey :: Eq k => (k -> v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
updateOrConcatWithKey :: (k -> v -> v -> v)
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWithKey k -> v -> v -> v
f Array (Leaf k v)
ary1 Array (Leaf k v)
ary2 = (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
    -- TODO: instead of mapping and then folding, should we traverse?
    -- We'll have to be careful to avoid allocating pairs or similar.

    -- first: look up the position of each element of ary2 in ary1
    let indices :: Array (Maybe Int)
indices = (Leaf k v -> Maybe Int) -> Array (Leaf k v) -> Array (Maybe Int)
forall a b. (a -> b) -> Array a -> Array b
A.map' (\(L k
k v
_) -> 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)
ary1) Array (Leaf k v)
ary2
    -- that tells us how large the overlap is:
    -- count number of Nothing constructors
    let nOnly2 :: Int
nOnly2 = (Int -> Maybe Int -> Int) -> Int -> Array (Maybe Int) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (\Int
n -> Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int -> Int
forall a b. a -> b -> a
const Int
n)) Int
0 Array (Maybe Int)
indices
    let n1 :: Int
n1 = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1
    let n2 :: Int
n2 = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary2
    -- copy over all elements from ary1
    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
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nOnly2)
    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)
ary1 Int
0 MArray s (Leaf k v)
mary Int
0 Int
n1
    -- append or update all elements from ary2
    let go :: Int -> Int -> ST s ()
go !Int
iEnd !Int
i2
          | Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n2 = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise = case Array (Maybe Int) -> Int -> Maybe Int
forall a. Array a -> Int -> a
A.index Array (Maybe Int)
indices Int
i2 of
               Just Int
i1 -> do -- key occurs in both arrays, store combination in position i1
                             L k
k v
v1 <- Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary1 Int
i1
                             L k
_ v
v2 <- Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             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
i1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k (k -> v -> v -> v
f k
k v
v1 v
v2))
                             Int -> Int -> ST s ()
go Int
iEnd (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
               Maybe Int
Nothing -> do -- key is only in ary2, append to end
                             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
iEnd (Leaf k v -> ST s ()) -> ST s (Leaf k v) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             Int -> Int -> ST s ()
go (Int
iEndInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Int -> Int -> ST s ()
go Int
n1 Int
0
    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
{-# INLINABLE updateOrConcatWithKey #-}

------------------------------------------------------------------------
-- Manually unrolled loops

-- | /O(n)/ Update the element at the given position in this array.
update16 :: A.Array e -> Int -> e -> A.Array e
update16 :: Array e -> Int -> e -> Array e
update16 Array e
ary Int
idx e
b = (forall s. ST s (Array e)) -> Array e
forall a. (forall s. ST s a) -> a
runST (Array e -> Int -> e -> ST s (Array e)
forall e s. Array e -> Int -> e -> ST s (Array e)
update16M Array e
ary Int
idx e
b)
{-# INLINE update16 #-}

-- | /O(n)/ Update the element at the given position in this array.
update16M :: A.Array e -> Int -> e -> ST s (A.Array e)
update16M :: Array e -> Int -> e -> ST s (Array e)
update16M Array e
ary Int
idx e
b = do
    MArray s e
mary <- Array e -> ST s (MArray s e)
forall e s. Array e -> ST s (MArray s e)
clone16 Array e
ary
    MArray s e -> Int -> e -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s e
mary Int
idx e
b
    MArray s e -> ST s (Array e)
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s e
mary
{-# INLINE update16M #-}

-- | /O(n)/ Update the element at the given position in this array, by applying a function to it.
update16With' :: A.Array e -> Int -> (e -> e) -> A.Array e
update16With' :: Array e -> Int -> (e -> e) -> Array e
update16With' Array e
ary Int
idx e -> e
f
  | (# e
x #) <- Array e -> Int -> (# e #)
forall a. Array a -> Int -> (# a #)
A.index# Array e
ary Int
idx
  = Array e -> Int -> e -> Array e
forall e. Array e -> Int -> e -> Array e
update16 Array e
ary Int
idx (e -> Array e) -> e -> Array e
forall a b. (a -> b) -> a -> b
$! e -> e
f e
x
{-# INLINE update16With' #-}

-- | Unsafely clone an array of 16 elements.  The length of the input
-- array is not checked.
clone16 :: A.Array e -> ST s (A.MArray s e)
clone16 :: Array e -> ST s (MArray s e)
clone16 Array e
ary =
    Array e -> Int -> Int -> ST s (MArray s e)
forall e s. Array e -> Int -> Int -> ST s (MArray s e)
A.thaw Array e
ary Int
0 Int
16

------------------------------------------------------------------------
-- Bit twiddling

bitsPerSubkey :: Int
bitsPerSubkey :: Int
bitsPerSubkey = Int
4

maxChildren :: Int
maxChildren :: Int
maxChildren = Hash -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Hash -> Int) -> Hash -> Int
forall a b. (a -> b) -> a -> b
$ Hash
1 Hash -> Int -> Hash
`unsafeShiftL` Int
bitsPerSubkey

subkeyMask :: Bitmap
subkeyMask :: Hash
subkeyMask = Hash
1 Hash -> Int -> Hash
`unsafeShiftL` Int
bitsPerSubkey Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
- Hash
1

sparseIndex :: Bitmap -> Bitmap -> Int
sparseIndex :: Hash -> Hash -> Int
sparseIndex Hash
b Hash
m = Hash -> Int
forall a. Bits a => a -> Int
popCount (Hash
b Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. (Hash
m Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
- Hash
1))

mask :: Word -> Shift -> Bitmap
mask :: Hash -> Int -> Hash
mask Hash
w Int
s = Hash
1 Hash -> Int -> Hash
`unsafeShiftL` Hash -> Int -> Int
index Hash
w Int
s
{-# INLINE mask #-}

-- | Mask out the 'bitsPerSubkey' bits used for indexing at this level
-- of the tree.
index :: Hash -> Shift -> Int
index :: Hash -> Int -> Int
index Hash
w Int
s = Hash -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Hash -> Int) -> Hash -> Int
forall a b. (a -> b) -> a -> b
$ (Hash -> Int -> Hash
unsafeShiftR Hash
w Int
s) Hash -> Hash -> Hash
forall a. Bits a => a -> a -> a
.&. Hash
subkeyMask
{-# INLINE index #-}

-- | A bitmask with the 'bitsPerSubkey' least significant bits set.
fullNodeMask :: Bitmap
fullNodeMask :: Hash
fullNodeMask = Hash -> Hash
forall a. Bits a => a -> a
complement (Hash -> Hash
forall a. Bits a => a -> a
complement Hash
0 Hash -> Int -> Hash
`unsafeShiftL` Int
maxChildren)
{-# INLINE fullNodeMask #-}

-- | Check if two the two arguments are the same value.  N.B. This
-- function might give false negatives (due to GC moving objects.)
ptrEq :: a -> a -> Bool
ptrEq :: a -> a -> Bool
ptrEq a
x a
y = Int# -> Bool
isTrue# (a -> a -> Int#
forall a. a -> a -> Int#
reallyUnsafePtrEquality# a
x a
y Int# -> Int# -> Int#
==# Int#
1#)
{-# INLINE ptrEq #-}

------------------------------------------------------------------------
-- IsList instance
instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where
    type Item (HashMap k v) = (k, v)
    fromList :: [Item (HashMap k v)] -> HashMap k v
fromList = [Item (HashMap k v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList
    toList :: HashMap k v -> [Item (HashMap k v)]
toList   = HashMap k v -> [Item (HashMap k v)]
forall k v. HashMap k v -> [(k, v)]
toList