{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveLift            #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE RoleAnnotations       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeInType            #-}
{-# LANGUAGE UnboxedSums           #-}
{-# LANGUAGE UnboxedTuples         #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

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

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

      -- * Construction
    , empty
    , singleton

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

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

    -- ** Compose
    , compose

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

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

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

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

      -- * Conversions
    , keys
    , elems

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

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

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

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

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

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

data Leaf k v = L !k !v
  deriving (Leaf k v -> Leaf k v -> Bool
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) = forall a. NFData a => a -> ()
rnf k
k seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf v
v

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

-- | @since 0.2.14.0
instance NFData k => NFData1 (Leaf k) where
    liftRnf :: forall a. (a -> ()) -> Leaf k a -> ()
liftRnf = forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 forall a. NFData a => a -> ()
rnf

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

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

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

type role HashMap nominal representational

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

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

-- | @since 0.2.14.0
instance NFData k => NFData1 (HashMap k) where
    liftRnf :: forall a. (a -> ()) -> HashMap k a -> ()
liftRnf = forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 forall a. NFData a => a -> ()
rnf

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

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

instance Foldable.Foldable (HashMap k) where
    foldMap :: forall m a. Monoid m => (a -> m) -> HashMap k a -> m
foldMap a -> m
f = 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 :: forall a b. (a -> b -> b) -> b -> HashMap k a -> b
foldr = forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr
    {-# INLINE foldr #-}
    foldl :: forall b a. (b -> a -> b) -> b -> HashMap k a -> b
foldl = forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl
    {-# INLINE foldl #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> HashMap k a -> b
foldr' = forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr'
    {-# INLINE foldr' #-}
    foldl' :: forall b a. (b -> a -> b) -> b -> HashMap k a -> b
foldl' = forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl'
    {-# INLINE foldl' #-}
    null :: forall a. HashMap k a -> Bool
null = forall k a. HashMap k a -> Bool
null
    {-# INLINE null #-}
    length :: forall a. HashMap k a -> Int
length = forall k a. HashMap k a -> Int
size
    {-# INLINE length #-}

-- | @since 0.2.11
instance Bifoldable HashMap where
    bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> HashMap a b -> m
bifoldMap a -> m
f b -> m
g = forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldMapWithKey (\ a
k b
v -> a -> m
f a
k forall a. Monoid a => a -> a -> a
`mappend` b -> m
g b
v)
    {-# INLINE bifoldMap #-}
    bifoldr :: forall a c b.
(a -> c -> c) -> (b -> c -> c) -> c -> HashMap a b -> c
bifoldr a -> c -> c
f b -> c -> c
g = 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 :: forall c a b.
(c -> a -> c) -> (c -> b -> c) -> c -> HashMap a b -> c
bifoldl c -> a -> c
f c -> b -> c
g = forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey (\ c
acc a
k b
v -> (c
acc c -> a -> c
`f` a
k) c -> b -> c
`g` b
v)
    {-# INLINE bifoldl #-}

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

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

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

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

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

-- | This type is used to store the hash of a key, as produced with 'hash'.
type Hash   = Word

-- | A bitmap as contained by a 'BitmapIndexed' node, or a 'fullNodeMask'
-- corresponding to a 'Full' node.
--
-- Only the lower 'maxChildren' bits are used. The remaining bits must be zeros.
type Bitmap = Word

-- | 'Shift' values correspond to the level of the tree that we're currently
-- operating at. At the root level the 'Shift' is @0@. For the subsequent
-- levels the 'Shift' values are 'bitsPerSubkey', @2*'bitsPerSubkey'@ etc.
--
-- Valid values are non-negative and less than @bitSize (0 :: Word)@.
type Shift  = Int

instance Show2 HashMap where
    liftShowsPrec2 :: forall a b.
(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 =
        forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
FC.showsUnaryWith (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 (forall k v. HashMap k v -> [(k, v)]
toList HashMap a b
m)
      where
        sp :: Int -> (a, b) -> ShowS
sp = 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 = 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 :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> HashMap k a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

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

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

    readListPrec :: ReadPrec [HashMap k e]
readListPrec = 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall k v. HashMap k v -> [(k, v)]
toList HashMap k v
m)

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

instance Eq2 HashMap where
    liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
liftEq2 = 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 :: forall a b. (a -> b -> Bool) -> HashMap k a -> HashMap k b -> Bool
liftEq = forall k v v'.
Eq k =>
(v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1

-- | Note that, in the presence of hash collisions, equal @HashMap@s may
-- behave differently, i.e. substitutivity may be violated:
--
-- >>> data D = A | B deriving (Eq, Show)
-- >>> instance Hashable D where hashWithSalt salt _d = salt
--
-- >>> x = fromList [(A,1), (B,2)]
-- >>> y = fromList [(B,2), (A,1)]
--
-- >>> x == y
-- True
-- >>> toList x
-- [(A,1),(B,2)]
-- >>> toList y
-- [(B,2),(A,1)]
--
-- In general, the lack of substitutivity can be observed with any function
-- that depends on the key ordering, such as folds and traversals.
instance (Eq k, Eq v) => Eq (HashMap k v) where
    == :: HashMap k v -> HashMap k v -> Bool
(==) = forall k v v'.
Eq k =>
(v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1 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 :: forall k v v'.
Eq k =>
(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 Bitmap
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Bitmap
bm2 Array (HashMap k v')
ary2)
      = Bitmap
bm1 forall a. Eq a => a -> a -> Bool
== Bitmap
bm2 Bool -> Bool -> 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 Bitmap
h1 Leaf k v
l1) (Leaf Bitmap
h2 Leaf k v'
l2) = Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
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) = 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 Bitmap
h1 Array (Leaf k v)
ary1) (Collision Bitmap
h2 Array (Leaf k v')
ary2)
      = Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k v' -> Bool
leafEq (forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (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 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 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> 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 (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions 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 Bitmap
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Bitmap
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Bitmap
k1 forall a. Eq a => a -> a -> Bool
== Bitmap
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 Bitmap
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Bitmap
k1 forall a. Eq a => a -> a -> Bool
== Bitmap
k2 Bool -> Bool -> Bool
&&
        forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2)
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go [] [] = Bool
True
    go [HashMap k v]
_  [HashMap k' v']
_  = Bool
False

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

instance Ord2 HashMap where
    liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
liftCompare2 = 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 :: forall a b.
(a -> b -> Ordering) -> HashMap k a -> HashMap k b -> Ordering
liftCompare = forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
cmp forall a. Ord a => a -> a -> Ordering
compare

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

cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
    -> HashMap k v -> HashMap k' v' -> Ordering
cmp :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> 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 (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k' v'
t2 [])
  where
    go :: [HashMap k v] -> [HashMap k' v'] -> Ordering
go (Leaf Bitmap
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Bitmap
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      = forall a. Ord a => a -> a -> Ordering
compare Bitmap
k1 Bitmap
k2 forall a. Monoid a => a -> a -> a
`mappend`
        Leaf k v -> Leaf k' v' -> Ordering
leafCompare Leaf k v
l1 Leaf k' v'
l2 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 Bitmap
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      = forall a. Ord a => a -> a -> Ordering
compare Bitmap
k1 Bitmap
k2 forall a. Monoid a => a -> a -> a
`mappend`
        forall a. Ord a => a -> a -> Ordering
compare (forall a. Array a -> Int
A.length Array (Leaf k v)
ary1) (forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2) forall a. Monoid a => a -> a -> a
`mappend`
        forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
unorderedCompare Leaf k v -> Leaf k' v' -> Ordering
leafCompare (forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2) 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 Bitmap
_ Leaf k v
_ : [HashMap k v]
_) (Collision Bitmap
_ Array (Leaf k' v')
_ : [HashMap k' v']
_) = Ordering
LT
    go (Collision Bitmap
_ Array (Leaf k v)
_ : [HashMap k v]
_) (Leaf Bitmap
_ 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']
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"cmp: Should never happen, leavesAndCollisions 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' forall a. Monoid a => a -> a -> a
`mappend` v -> v' -> Ordering
cmpv v
v v'
v'

-- Same as 'equal2' but doesn't compare the values.
equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equalKeys1 :: forall k k' v v'.
(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 (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k' v'
t2 [])
  where
    go :: [HashMap k v] -> [HashMap k' v'] -> Bool
go (Leaf Bitmap
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Bitmap
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Bitmap
k1 forall a. Eq a => a -> a -> Bool
== Bitmap
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 Bitmap
k1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
k2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Bitmap
k1 forall a. Eq a => a -> a -> Bool
== Bitmap
k2 Bool -> Bool -> Bool
&& forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (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 :: forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
equalKeys = 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 :: forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go HashMap k v
Empty HashMap k v'
Empty = Bool
True
    go (BitmapIndexed Bitmap
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Bitmap
bm2 Array (HashMap k v')
ary2)
      = Bitmap
bm1 forall a. Eq a => a -> a -> Bool
== Bitmap
bm2 Bool -> Bool -> Bool
&& forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 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 Bitmap
h1 Leaf k v
l1) (Leaf Bitmap
h2 Leaf k v'
l2) = Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> 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) = forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 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 Bitmap
h1 Array (Leaf k v)
ary1) (Collision Bitmap
h2 Array (Leaf k v')
ary2)
      = Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy forall {a} {v} {v}. Eq a => Leaf a v -> Leaf a v -> Bool
leafEq (forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (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 forall a. Eq a => a -> a -> Bool
== a
k2

instance Hashable2 HashMap where
    liftHashWithSalt2 :: forall a b.
(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 (forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions 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 Bitmap
_ 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 Bitmap
h Array (Leaf a b)
a : [HashMap a b]
tl)
          = (Int
s forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Bitmap
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
          = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s 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 = forall a. Ord a => [a] -> [a]
List.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> Leaf a b -> Int
hashLeafWithSalt Int
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> [a]
A.toList

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

instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
    hashWithSalt :: Int -> HashMap k v -> Int
hashWithSalt Int
salt HashMap k v
hm = Int -> HashMap k v -> Int
go Int
salt HashMap k v
hm
      where
        go :: Int -> HashMap k v -> Int
        go :: Int -> HashMap k v -> Int
go Int
s HashMap k v
Empty = Int
s
        go Int
s (BitmapIndexed Bitmap
_ Array (HashMap k v)
a) = 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 Bitmap
h (L k
_ v
v))
          = Int
s forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Bitmap
h 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) = 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 Bitmap
h Array (Leaf k v)
a)
          = (Int
s forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Bitmap
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 forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` k
k 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
          = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s 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 = forall a. Ord a => [a] -> [a]
List.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> Leaf k v -> Int
hashLeafWithSalt Int
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> [a]
A.toList

-- | Helper to get 'Leaf's and 'Collision's as a list.
leavesAndCollisions :: HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions :: forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) [HashMap k v]
a = forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions [HashMap k v]
a Array (HashMap k v)
ary
leavesAndCollisions (Full Array (HashMap k v)
ary)            [HashMap k v]
a = forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions [HashMap k v]
a Array (HashMap k v)
ary
leavesAndCollisions l :: HashMap k v
l@(Leaf Bitmap
_ Leaf k v
_)          [HashMap k v]
a = HashMap k v
l forall a. a -> [a] -> [a]
: [HashMap k v]
a
leavesAndCollisions c :: HashMap k v
c@(Collision Bitmap
_ Array (Leaf k v)
_)     [HashMap k v]
a = HashMap k v
c forall a. a -> [a] -> [a]
: [HashMap k v]
a
leavesAndCollisions 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 :: forall k a. HashMap k a -> Bool
isLeafOrCollision (Leaf Bitmap
_ Leaf k v
_)      = Bool
True
isLeafOrCollision (Collision Bitmap
_ Array (Leaf k v)
_) = Bool
True
isLeafOrCollision HashMap k v
_               = Bool
False

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

-- | \(O(1)\) Construct an empty map.
empty :: HashMap k v
empty :: forall k v. HashMap k v
empty = 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 :: forall k v. Hashable k => k -> v -> HashMap k v
singleton k
k v
v = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf (forall a. Hashable a => a -> Bitmap
hash k
k) (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 :: forall k a. HashMap k a -> 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 :: forall k a. HashMap k a -> Int
size HashMap k v
t = 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 Bitmap
_ Leaf k v
_)            Int
n = Int
n forall a. Num a => a -> a -> a
+ Int
1
    go (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) Int
n = forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (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 = forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (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 Bitmap
_ Array (Leaf k v)
ary)     Int
n = Int
n forall a. Num a => a -> a -> a
+ 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 :: forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
member k
k HashMap k a
m = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k a
m of
    Maybe a
Nothing -> Bool
False
    Just a
_  -> Bool
True
{-# INLINABLE member #-}

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

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

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

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

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

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


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

-- | \(O(\log n)\) Return the value to which the specified key is mapped.
-- Calls 'error' if this map contains no mapping for the key.
(!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v
! :: forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
(!) HashMap k v
m k
k = case 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 -> forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Strict.HashMap.Autogen.Internal.(!): key not found"
{-# INLINABLE (!) #-}

infixl 9 !

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

-- | Create a 'BitmapIndexed' or 'Full' node.
bitmapIndexedOrFull :: Bitmap -> A.Array (HashMap k v) -> HashMap k v
-- The strictness in @ary@ helps achieve a nice code size reduction in
-- @unionWith[Key]@ with GHC 9.2.2. See the Core diffs in
-- https://github.com/haskell-unordered-containers/unordered-containers/pull/376.
bitmapIndexedOrFull :: forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
b !Array (HashMap k v)
ary
    | Bitmap
b forall a. Eq a => a -> a -> Bool
== Bitmap
fullNodeMask = forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary
    | Bool
otherwise         = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
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 :: forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert k
k v
v HashMap k v
m = forall k v. Eq k => Bitmap -> k -> v -> HashMap k v -> HashMap k v
insert' (forall a. Hashable a => a -> Bitmap
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' :: forall k v. Eq k => Bitmap -> k -> v -> HashMap k v -> HashMap k v
insert' Bitmap
h0 k
k0 v
v0 HashMap k v
m0 = forall {t} {t}.
Eq t =>
Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h0 k
k0 v
v0 Int
0 HashMap k v
m0
  where
    go :: Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go !Bitmap
h !t
k t
x !Int
_ HashMap t t
Empty = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Leaf Bitmap
hy l :: Leaf t t
l@(L t
ky t
y))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h = if t
ky forall a. Eq a => a -> a -> Bool
== t
k
                    then if t
x forall a. a -> a -> Bool
`ptrEq` t
y
                         then HashMap t t
t
                         else forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
                    else forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (forall k v. k -> v -> Leaf k v
L t
k t
x)
        | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST (forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two Int
s Bitmap
h t
k t
x Bitmap
hy HashMap t t
t)
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(BitmapIndexed Bitmap
b Array (HashMap t t)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let !ary' :: Array (HashMap t t)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap t t)
ary Int
i forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
                !st' :: HashMap t t
st' = Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
            in if HashMap t t
st' forall a. a -> a -> Bool
`ptrEq` HashMap t t
st
               then HashMap t t
t
               else forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap t t)
ary Int
i HashMap t t
st')
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Full Array (HashMap t t)
ary) =
        let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
            !st' :: HashMap t t
st' = Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
        in if HashMap t t
st' forall a. a -> a -> Bool
`ptrEq` HashMap t t
st
            then HashMap t t
t
            else forall k v. Array (HashMap k v) -> HashMap k v
Full (forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Collision Bitmap
hy Array (Leaf t t)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith (\t
a t
_ -> (# t
a #)) t
k t
x Array (Leaf t t)
v)
        | Bool
otherwise = Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x Int
s forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (forall a. a -> Array a
A.singleton HashMap t t
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 :: forall k v. Bitmap -> k -> v -> HashMap k v -> HashMap k v
insertNewKey !Bitmap
h0 !k
k0 v
x0 !HashMap k v
m0 = forall {t} {t}.
Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h0 k
k0 v
x0 Int
0 HashMap k v
m0
  where
    go :: Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go !Bitmap
h !t
k t
x !Int
_ HashMap t t
Empty = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Leaf Bitmap
hy Leaf t t
l)
      | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h = forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (forall k v. k -> v -> Leaf k v
L t
k t
x)
      | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST (forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two Int
s Bitmap
h t
k t
x Bitmap
hy HashMap t t
t)
    go Bitmap
h t
k t
x Int
s (BitmapIndexed Bitmap
b Array (HashMap t t)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let !ary' :: Array (HashMap t t)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap t t)
ary Int
i forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
                !st' :: HashMap t t
st' = Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap t t)
ary Int
i HashMap t t
st')
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h t
k t
x Int
s (Full Array (HashMap t t)
ary) =
        let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
            !st' :: HashMap t t
st' = Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
        in forall k v. Array (HashMap k v) -> HashMap k v
Full (forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Collision Bitmap
hy Array (Leaf t t)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall a. Array a -> a -> Array a
A.snoc Array (Leaf t t)
v (forall k v. k -> v -> Leaf k v
L t
k t
x))
        | Bool
otherwise =
            Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Bitmap
h t
k t
x Int
s forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (forall a. a -> Array a
A.singleton HashMap t t
t)
{-# 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 :: forall k v. Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists !Int
collPos0 !Bitmap
h0 !k
k0 v
x0 !HashMap k v
m0 = forall {t} {t}.
Int -> Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Int
collPos0 Bitmap
h0 k
k0 v
x0 Int
0 HashMap k v
m0
  where
    go :: Int -> Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go !Int
_collPos !Bitmap
h !t
k t
x !Int
_s (Leaf Bitmap
_hy Leaf t t
_kx)
        = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Int
collPos Bitmap
h t
k t
x Int
s (BitmapIndexed Bitmap
b Array (HashMap t t)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let !ary' :: Array (HashMap t t)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap t t)
ary Int
i forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
                !st' :: HashMap t t
st' = Int -> Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Int
collPos Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap t t)
ary Int
i HashMap t t
st')
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Int
collPos Bitmap
h t
k t
x Int
s (Full Array (HashMap t t)
ary) =
        let !st :: HashMap t t
st  = forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
            !st' :: HashMap t t
st' = Int -> Bitmap -> t -> t -> Int -> HashMap t t -> HashMap t t
go Int
collPos Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
        in forall k v. Array (HashMap k v) -> HashMap k v
Full (forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Int
collPos Bitmap
h t
k t
x Int
_s (Collision Bitmap
_hy Array (Leaf t t)
v)
        | Int
collPos forall a. Ord a => a -> a -> Bool
>= Int
0 = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall k v. Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
setAtPosition Int
collPos t
k t
x Array (Leaf t t)
v)
        | Bool
otherwise = forall k v. HashMap k v
Empty -- error "Internal error: go {collPos negative}"
    go Int
_ Bitmap
_ t
_ t
_ Int
_ HashMap t t
Empty = 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 :: forall k v. Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
setAtPosition Int
i k
k v
x Array (Leaf k v)
ary = forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (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 :: forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
unsafeInsert k
k0 v
v0 HashMap k v
m0 = forall a. (forall s. ST s a) -> a
runST (forall {t} {t} {s}.
Eq t =>
Bitmap -> t -> t -> Int -> HashMap t t -> ST s (HashMap t t)
go Bitmap
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Bitmap
h0 = forall a. Hashable a => a -> Bitmap
hash k
k0
    go :: Bitmap -> t -> t -> Int -> HashMap t t -> ST s (HashMap t t)
go !Bitmap
h !t
k t
x !Int
_ HashMap t t
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Leaf Bitmap
hy l :: Leaf t t
l@(L t
ky t
y))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h = if t
ky forall a. Eq a => a -> a -> Bool
== t
k
                    then if t
x forall a. a -> a -> Bool
`ptrEq` t
y
                         then forall (m :: * -> *) a. Monad m => a -> m a
return HashMap t t
t
                         else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
                    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (forall k v. k -> v -> Leaf k v
L t
k t
x)
        | Bool
otherwise = forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two Int
s Bitmap
h t
k t
x Bitmap
hy HashMap t t
t
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(BitmapIndexed Bitmap
b Array (HashMap t t)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 = do
            Array (HashMap t t)
ary' <- forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap t t)
ary Int
i forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L t
k t
x)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise = do
            HashMap t t
st <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap t t)
ary Int
i
            HashMap t t
st' <- Bitmap -> t -> t -> Int -> HashMap t t -> ST s (HashMap t t)
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
            forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap t t)
ary Int
i HashMap t t
st'
            forall (m :: * -> *) a. Monad m => a -> m a
return HashMap t t
t
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Full Array (HashMap t t)
ary) = do
        HashMap t t
st <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap t t)
ary Int
i
        HashMap t t
st' <- Bitmap -> t -> t -> Int -> HashMap t t -> ST s (HashMap t t)
go Bitmap
h t
k t
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap t t
st
        forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap t t)
ary Int
i HashMap t t
st'
        forall (m :: * -> *) a. Monad m => a -> m a
return HashMap t t
t
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h t
k t
x Int
s t :: HashMap t t
t@(Collision Bitmap
hy Array (Leaf t t)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith (\t
a t
_ -> (# t
a #)) t
k t
x Array (Leaf t t)
v)
        | Bool
otherwise = Bitmap -> t -> t -> Int -> HashMap t t -> ST s (HashMap t t)
go Bitmap
h t
k t
x Int
s forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (forall a. a -> Array a
A.singleton HashMap t t
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 :: forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two = forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
go
  where
    go :: Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
go Int
s Bitmap
h1 k
k1 v
v1 Bitmap
h2 HashMap k v
t2
        | Bitmap
bp1 forall a. Eq a => a -> a -> Bool
== Bitmap
bp2 = do
            HashMap k v
st <- Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) Bitmap
h1 k
k1 v
v1 Bitmap
h2 HashMap k v
t2
            Array (HashMap k v)
ary <- forall a s. a -> ST s (Array a)
A.singletonM HashMap k v
st
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bp1 Array (HashMap k v)
ary
        | Bool
otherwise  = do
            MArray s (HashMap k v)
mary <- forall a s. Int -> a -> ST s (MArray s a)
A.new Int
2 forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (forall k v. k -> v -> Leaf k v
L k
k1 v
v1)
            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 <- forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (HashMap k v)
mary
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
bp1 forall a. Bits a => a -> a -> a
.|. Bitmap
bp2) Array (HashMap k v)
ary
      where
        bp1 :: Bitmap
bp1  = Bitmap -> Int -> Bitmap
mask Bitmap
h1 Int
s
        bp2 :: Bitmap
bp2  = Bitmap -> Int -> Bitmap
mask Bitmap
h2 Int
s
        idx2 :: Int
idx2 | Bitmap -> Int -> Int
index Bitmap
h1 Int
s forall a. Ord a => a -> a -> Bool
< Bitmap -> Int -> Int
index Bitmap
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 :: forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
insertWith v -> v -> v
f k
k v
new HashMap k v
m = 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 :: forall k v.
(Eq k, Hashable k) =>
v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
insertModifying v
x v -> (# v #)
f k
k0 HashMap k v
m0 = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h0 k
k0 Int
0 HashMap k v
m0
  where
    !h0 :: Bitmap
h0 = forall a. Hashable a => a -> Bitmap
hash k
k0
    go :: Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go !Bitmap
h !k
k !Int
_ HashMap k v
Empty = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(Leaf Bitmap
hy l :: Leaf k v
l@(L k
ky v
y))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h = if k
ky forall a. Eq a => a -> a -> Bool
== k
k
                    then case v -> (# v #)
f v
y of
                      (# v
v' #) | forall a. a -> a -> Bool
ptrEq v
y v
v' -> HashMap k v
t
                               | Bool
otherwise -> forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
v')
                    else forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf k v
l (forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST (forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two Int
s Bitmap
h k
k v
x Bitmap
hy HashMap k v
t)
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
x)
            in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            let !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
                ary' :: Array (HashMap k v)
ary'  = forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
            in if forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
               then HashMap k v
t
               else forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b Array (HashMap k v)
ary'
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
        in if forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
           then HashMap k v
t
           else forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(Collision Bitmap
hy Array (Leaf k v)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   =
            let !v' :: Array (Leaf k v)
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 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 forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h Array (Leaf k v)
v'
        | Bool
otherwise = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k Int
s forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (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 :: forall k v.
Eq k =>
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 (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
          -- Not found, append to the end.
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = forall a. Array a -> a -> Array a
A.snoc Array (Leaf k v)
ary forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k v
x
        | Bool
otherwise = case forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
y) | k
k forall a. Eq a => a -> a -> Bool
== k
kx   -> case v -> (# v #)
f v
y of
                                      (# v
y' #) -> if forall a. a -> a -> Bool
ptrEq v
y v
y'
                                                  then Array (Leaf k v)
ary
                                                  else forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (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
iforall 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 :: forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWith v -> v -> v
f k
k0 v
v0 HashMap k v
m0 = forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> (# v #)) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWithKey (\k
_ v
a v
b -> (# v -> v -> v
f v
a v
b #)) 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 :: 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
k0 v
v0 HashMap k v
m0 = forall a. (forall s. ST s a) -> a
runST (forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Bitmap
h0 = forall a. Hashable a => a -> Bitmap
hash k
k0
    go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
    go :: forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !Bitmap
h !k
k v
x !Int
_ HashMap k v
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Bitmap
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Bitmap
hy l :: Leaf k v
l@(L k
ky v
y))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h = if k
ky forall a. Eq a => a -> a -> Bool
== k
k
                    then case k -> v -> v -> (# v #)
f k
k v
x v
y of
                        (# v
v #) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
v)
                    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf k v
l (forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = forall k v s.
Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
two Int
s Bitmap
h k
k v
x Bitmap
hy HashMap k v
t
    go Bitmap
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 = do
            Array (HashMap k v)
ary' <- forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
x)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap k v)
ary'
        | Bool
otherwise = do
            HashMap k v
st <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
            HashMap k v
st' <- forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
            forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) = do
        HashMap k v
st <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
        HashMap k v
st' <- forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
        forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
      where i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h k
k v
x Int
s t :: HashMap k v
t@(Collision Bitmap
hy Array (Leaf k v)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey k -> v -> v -> (# v #)
f k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x Int
s forall a b. (a -> b) -> a -> b
$ forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (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 :: forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete k
k HashMap k v
m = forall k v. Eq k => Bitmap -> k -> HashMap k v -> HashMap k v
delete' (forall a. Hashable a => a -> Bitmap
hash k
k) k
k HashMap k v
m
{-# INLINABLE delete #-}

delete' :: Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' :: forall k v. Eq k => Bitmap -> k -> HashMap k v -> HashMap k v
delete' Bitmap
h0 k
k0 HashMap k v
m0 = forall {k} {v}.
Eq k =>
Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h0 k
k0 Int
0 HashMap k v
m0
  where
    go :: Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go !Bitmap
_ !k
_ !Int
_ HashMap k v
Empty = forall k v. HashMap k v
Empty
    go Bitmap
h k
k Int
_ t :: HashMap k v
t@(Leaf Bitmap
hy (L k
ky v
_))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h Bool -> Bool -> Bool
&& k
ky forall a. Eq a => a -> a -> Bool
== k
k = forall k v. HashMap k v
Empty
        | Bool
otherwise          = HashMap k v
t
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v
t
        | Bool
otherwise =
            let !st :: HashMap k v
st = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in if HashMap k v
st' 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 | forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
1 -> forall k v. HashMap k v
Empty
                      | forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, 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) | 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
_) | 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 = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
b forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Bitmap
m) (forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
        in if HashMap k v
st' 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' = forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Bitmap
bm   = Bitmap
fullNodeMask forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> forall k v. Array (HashMap k v) -> HashMap k v
Full (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 = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Bitmap
h k
k Int
_ t :: HashMap k v
t@(Collision Bitmap
hy Array (Leaf k v)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy = case forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k Array (Leaf k v)
v of
            Just Int
i
                | forall a. Array a -> Int
A.length Array (Leaf k v)
v forall a. Eq a => a -> a -> Bool
== Int
2 ->
                    if Int
i forall a. Eq a => a -> a -> Bool
== Int
0
                    then forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
                    else forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
                | Bool
otherwise -> forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (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 :: forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
deleteKeyExists !Int
collPos0 !Bitmap
h0 !k
k0 !HashMap k v
m0 = forall k v. Int -> Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos0 Bitmap
h0 k
k0 Int
0 HashMap k v
m0
  where
    go :: Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
    go :: forall k v. Int -> Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go !Int
_collPos !Bitmap
_h !k
_k !Int
_s (Leaf Bitmap
_ Leaf k v
_) = forall k v. HashMap k v
Empty
    go Int
collPos Bitmap
h k
k Int
s (BitmapIndexed Bitmap
b Array (HashMap k v)
ary) =
            let !st :: HashMap k v
st = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = forall k v. Int -> Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            in case HashMap k v
st' of
                HashMap k v
Empty | forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
1 -> forall k v. HashMap k v
Empty
                      | forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, 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) | 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
_) | 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 = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
b forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Bitmap
m) (forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& forall a. Array a -> Int
A.length Array (HashMap k v)
ary forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Int
collPos Bitmap
h k
k Int
s (Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = forall k v. Int -> Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Int
collPos Bitmap
h k
k (Int
sforall 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' = forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Bitmap
bm   = Bitmap
fullNodeMask forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> forall k v. Array (HashMap k v) -> HashMap k v
Full (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 = Bitmap -> Int -> Int
index Bitmap
h Int
s
    go Int
collPos Bitmap
h k
_ Int
_ (Collision Bitmap
_hy Array (Leaf k v)
v)
      | forall a. Array a -> Int
A.length Array (Leaf k v)
v forall a. Eq a => a -> a -> Bool
== Int
2
      = if Int
collPos forall a. Eq a => a -> a -> Bool
== Int
0
        then forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
        else forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
      | Bool
otherwise = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
v Int
collPos)
    go !Int
_ !Bitmap
_ !k
_ !Int
_ HashMap k v
Empty = 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 :: forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
adjust v -> v
f k
k HashMap k v
m = 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# :: forall k v.
(Eq k, Hashable k) =>
(v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# v -> (# v #)
f k
k0 HashMap k v
m0 = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h0 k
k0 Int
0 HashMap k v
m0
  where
    h0 :: Bitmap
h0 = forall a. Hashable a => a -> Bitmap
hash k
k0
    go :: Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go !Bitmap
_ !k
_ !Int
_ HashMap k v
Empty = forall k v. HashMap k v
Empty
    go Bitmap
h k
k Int
_ t :: HashMap k v
t@(Leaf Bitmap
hy (L k
ky v
y))
        | Bitmap
hy forall a. Eq a => a -> a -> Bool
== Bitmap
h Bool -> Bool -> Bool
&& k
ky forall a. Eq a => a -> a -> Bool
== k
k = case v -> (# v #)
f v
y of
            (# v
y' #) | forall a. a -> a -> Bool
ptrEq v
y v
y' -> HashMap k v
t
                     | Bool
otherwise -> forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v
y')
        | Bool
otherwise          = HashMap k v
t
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v
t
        | Bool
otherwise = let !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                          !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
                          ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
                      in if forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
                         then HashMap k v
t
                         else forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b Array (HashMap k v)
ary'
      where m :: Bitmap
m = Bitmap -> Int -> Bitmap
mask Bitmap
h Int
s
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        let i :: Int
i    = Bitmap -> Int -> Int
index Bitmap
h Int
s
            !st :: HashMap k v
st   = forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st
            ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap k v)
ary Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
        in if forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
           then HashMap k v
t
           else forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Bitmap
h k
k Int
_ t :: HashMap k v
t@(Collision Bitmap
hy Array (Leaf k v)
v)
        | Bitmap
h forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = let !v' :: Array (Leaf k v)
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 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 forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
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 :: forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
update a -> Maybe a
f = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
alter (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 :: forall k v.
(Eq k, Hashable k) =>
(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 (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m) of
    Maybe v
Nothing -> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete k
k HashMap k v
m
    Just v
v  -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert k
k v
v HashMap k v
m
{-# INLINABLE alter #-}

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

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

-- This is just a bottom value. See the comment on the "alterFWeird"
-- rule.
test_bottom :: a
test_bottom :: forall a. a
test_bottom = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Strict.HashMap.Autogen.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# :: forall a. (# #) -> (# a #)
bogus# (# #)
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Strict.HashMap.Autogen.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 :: forall (f :: * -> *) k v.
(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)
f = 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 :: 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 !k
k HashMap k v
m = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f Maybe v
mv) forall a b. (a -> b) -> a -> b
$ \case

    ------------------------------
    -- 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 -> forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
deleteKeyExists Int
collPos Bitmap
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 -> forall k v. Bitmap -> k -> v -> HashMap k v -> HashMap k v
insertNewKey Bitmap
h k
k v
v' HashMap k v
m

      -- Key existed before
      Present v
v Int
collPos ->
        if v
v 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 forall k v. Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists Int
collPos Bitmap
h k
k v
v' HashMap k v
m

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

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

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

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

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

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

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

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

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

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

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

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

      -- In case a key occurs in ary1, but not ary2, only increment index j.
      | Bitmap
b2 forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
/= Bitmap
0 = Int -> Int -> Bitmap -> Bool
go Int
i (Int
jforall a. Num a => a -> a -> a
+Int
1) (Bitmap
m forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)

      -- In case a key neither occurs in ary1 nor ary2, continue.
      | Bool
otherwise = Int -> Int -> Bitmap -> Bool
go Int
i Int
j (Bitmap
m forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)

    b1Andb2 :: Bitmap
b1Andb2 = Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
b2
    b1Orb2 :: Bitmap
b1Orb2  = Bitmap
b1 forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    subsetBitmaps :: Bool
subsetBitmaps = Bitmap
b1Orb2 forall a. Eq a => a -> a -> Bool
== Bitmap
b2
{-# INLINABLE submapBitmapIndexed #-}

------------------------------------------------------------------------
-- * 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 :: forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
union = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWith 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 :: forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWith v -> v -> v
f = forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWithKey (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 :: forall k v.
(Eq k, Hashable k) =>
(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 Bitmap
h1 l1 :: Leaf k v
l1@(L k
k1 v
v1)) t2 :: HashMap k v
t2@(Leaf Bitmap
h2 l2 :: Leaf k v
l2@(L k
k2 v
v2))
        | Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = if k
k1 forall a. Eq a => a -> a -> Bool
== k
k2
                      then forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (forall k v. k -> v -> Leaf k v
L k
k1 (k -> v -> v -> v
f k
k1 v
v1 v
v2))
                      else forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h1 Leaf k v
l1 Leaf k v
l2
        | Bool
otherwise = forall {k} {v}.
Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Leaf Bitmap
h1 (L k
k1 v
v1)) t2 :: HashMap k v
t2@(Collision Bitmap
h2 Array (Leaf k v)
ls2)
        | Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 (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 = forall {k} {v}.
Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Bitmap
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Leaf Bitmap
h2 (L k
k2 v
v2))
        | Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 (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 = forall {k} {v}.
Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Bitmap
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Collision Bitmap
h2 Array (Leaf k v)
ls2)
        | Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 (forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWithKey (\k
k v
a v
b -> (# k -> v -> v -> v
f k
k v
a v
b #)) Array (Leaf k v)
ls1 Array (Leaf k v)
ls2)
        | Bool
otherwise = forall {k} {v}.
Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2
    -- branch vs. branch
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary1) (BitmapIndexed Bitmap
b2 Array (HashMap k v)
ary2) =
        let b' :: Bitmap
b'   = Bitmap
b1 forall a. Bits a => a -> a -> a
.|. Bitmap
b2
            ary' :: Array (HashMap k v)
ary' = forall a.
(a -> a -> a) -> Bitmap -> Bitmap -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Bitmap
b1 Bitmap
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
b' Array (HashMap k v)
ary'
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary1) (Full Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = forall a.
(a -> a -> a) -> Bitmap -> Bitmap -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Bitmap
b1 Bitmap
fullNodeMask Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in 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 Bitmap
b2 Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = forall a.
(a -> a -> a) -> Bitmap -> Bitmap -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Bitmap
fullNodeMask Bitmap
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in 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' = forall a.
(a -> a -> a) -> Bitmap -> Bitmap -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey)) Bitmap
fullNodeMask Bitmap
fullNodeMask
                   Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    -- leaf vs. branch
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary1) HashMap k v
t2
        | Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
m2 forall a. Eq a => a -> a -> Bool
== Bitmap
0 = let ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary1 Int
i HashMap k v
t2
                               b' :: Bitmap
b'   = Bitmap
b1 forall a. Bits a => a -> a -> a
.|. Bitmap
m2
                           in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
b' Array (HashMap k v)
ary'
        | Bool
otherwise      = let ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary1 Int
i forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st1 HashMap k v
t2
                           in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary'
        where
          h2 :: Bitmap
h2 = forall {k} {v}. HashMap k v -> Bitmap
leafHashCode HashMap k v
t2
          m2 :: Bitmap
m2 = Bitmap -> Int -> Bitmap
mask Bitmap
h2 Int
s
          i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b1 Bitmap
m2
    go Int
s HashMap k v
t1 (BitmapIndexed Bitmap
b2 Array (HashMap k v)
ary2)
        | Bitmap
b2 forall a. Bits a => a -> a -> a
.&. Bitmap
m1 forall a. Eq a => a -> a -> Bool
== Bitmap
0 = let ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary2 Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v
t1
                               b' :: Bitmap
b'   = Bitmap
b2 forall a. Bits a => a -> a -> a
.|. Bitmap
m1
                           in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
b' Array (HashMap k v)
ary'
        | Bool
otherwise      = let ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary2 Int
i forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
t1 HashMap k v
st2
                           in forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b2 Array (HashMap k v)
ary'
      where
        h1 :: Bitmap
h1 = forall {k} {v}. HashMap k v -> Bitmap
leafHashCode HashMap k v
t1
        m1 :: Bitmap
m1 = Bitmap -> Int -> Bitmap
mask Bitmap
h1 Int
s
        i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b2 Bitmap
m1
    go Int
s (Full Array (HashMap k v)
ary1) HashMap k v
t2 =
        let h2 :: Bitmap
h2   = forall {k} {v}. HashMap k v -> Bitmap
leafHashCode HashMap k v
t2
            i :: Int
i    = Bitmap -> Int -> Int
index Bitmap
h2 Int
s
            ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> (e -> e) -> Array e
update32With' Array (HashMap k v)
ary1 Int
i forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
st1 HashMap k v
t2
        in 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 :: Bitmap
h1   = forall {k} {v}. HashMap k v -> Bitmap
leafHashCode HashMap k v
t1
            i :: Int
i    = Bitmap -> Int -> Int
index Bitmap
h1 Int
s
            ary' :: Array (HashMap k v)
ary' = forall e. Array e -> Int -> (e -> e) -> Array e
update32With' Array (HashMap k v)
ary2 Int
i forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) HashMap k v
t1 HashMap k v
st2
        in forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'

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

    goDifferentHash :: Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2
        | Bitmap
m1 forall a. Eq a => a -> a -> Bool
== Bitmap
m2  = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
m1 (forall a. a -> Array a
A.singleton forall a b. (a -> b) -> a -> b
$! Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash (Int
sforall a. Num a => a -> a -> a
+Int
bitsPerSubkey) Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2)
        | Bitmap
m1 forall a. Ord a => a -> a -> Bool
<  Bitmap
m2  = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
m1 forall a. Bits a => a -> a -> a
.|. Bitmap
m2) (forall a. a -> a -> Array a
A.pair HashMap k v
t1 HashMap k v
t2)
        | Bool
otherwise = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
m1 forall a. Bits a => a -> a -> a
.|. Bitmap
m2) (forall a. a -> a -> Array a
A.pair HashMap k v
t2 HashMap k v
t1)
      where
        m1 :: Bitmap
m1 = Bitmap -> Int -> Bitmap
mask Bitmap
h1 Int
s
        m2 :: Bitmap
m2 = Bitmap -> Int -> Bitmap
mask Bitmap
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
-- The manual forcing of @b1@, @b2@, @ary1@ and @ary2@ results in handsome
-- Core size reductions with GHC 9.2.2. See the Core diffs in
-- https://github.com/haskell-unordered-containers/unordered-containers/pull/376.
unionArrayBy :: forall a.
(a -> a -> a) -> Bitmap -> Bitmap -> Array a -> Array a -> Array a
unionArrayBy a -> a -> a
f !Bitmap
b1 !Bitmap
b2 !Array a
ary1 !Array a
ary2 = forall e. (forall s. ST s (MArray s e)) -> Array e
A.run forall a b. (a -> b) -> a -> b
$ do
    let bCombined :: Bitmap
bCombined = Bitmap
b1 forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    MArray s a
mary <- forall s a. Int -> ST s (MArray s a)
A.new_ (forall a. Bits a => a -> Int
popCount Bitmap
bCombined)
    -- iterate over nonzero bits of b1 .|. b2
    let go :: Int -> Int -> Int -> Bitmap -> ST s ()
go !Int
i !Int
i1 !Int
i2 !Bitmap
b
            | Bitmap
b forall a. Eq a => a -> a -> Bool
== Bitmap
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bitmap -> Bool
testBit (Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
b2) = do
                a
x1 <- forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                a
x2 <- forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i forall a b. (a -> b) -> a -> b
$! a -> a -> a
f a
x1 a
x2
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
i1forall a. Num a => a -> a -> a
+Int
1) (Int
i2forall a. Num a => a -> a -> a
+Int
1) Bitmap
b'
            | Bitmap -> Bool
testBit Bitmap
b1 = do
                forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
i1forall a. Num a => a -> a -> a
+Int
1) Int
i2 Bitmap
b'
            | Bool
otherwise = do
                forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
i1 (Int
i2forall a. Num a => a -> a -> a
+Int
1) Bitmap
b'
          where
            m :: Bitmap
m = Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` forall b. FiniteBits b => b -> Int
countTrailingZeros Bitmap
b
            testBit :: Bitmap -> Bool
testBit Bitmap
x = Bitmap
x forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
/= Bitmap
0
            b' :: Bitmap
b' = Bitmap
b forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Bitmap
m
    Int -> Int -> Int -> Bitmap -> ST s ()
go Int
0 Int
0 Int
0 Bitmap
bCombined
    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 :: forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
union forall k v. HashMap k v
empty
{-# INLINE unions #-}


------------------------------------------------------------------------
-- * Compose

-- | Relate the keys of one map to the values of
-- the other, by using the values of the former as keys for lookups
-- in the latter.
--
-- Complexity: \( O (n * \log(m)) \), where \(m\) is the size of the first argument
--
-- >>> compose (fromList [('a', "A"), ('b', "B")]) (fromList [(1,'a'),(2,'b'),(3,'z')])
-- fromList [(1,"A"),(2,"B")]
--
-- @
-- ('compose' bc ab '!?') = (bc '!?') <=< (ab '!?')
-- @
--
-- @since 0.2.13.0
compose :: (Eq b, Hashable b) => HashMap b c -> HashMap a b -> HashMap a c
compose :: forall b c a.
(Eq b, Hashable b) =>
HashMap b c -> HashMap a b -> HashMap a c
compose HashMap b c
bc !HashMap a b
ab
  | forall k a. HashMap k a -> Bool
null HashMap b c
bc = forall k v. HashMap k v
empty
  | Bool
otherwise = forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybe (HashMap b c
bc forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!?) HashMap a b
ab

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

-- | \(O(n)\) Transform this map by applying a function to every value.
mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
mapWithKey :: forall k v1 v2. (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 = forall k v. HashMap k v
Empty
    go (Leaf Bitmap
h (L k
k v1
v)) = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k (k -> v1 -> v2
f k
k v1
v)
    go (BitmapIndexed Bitmap
b Array (HashMap k v1)
ary) = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b forall a b. (a -> b) -> a -> b
$ 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) = forall k v. Array (HashMap k v) -> HashMap k v
Full forall a b. (a -> b) -> a -> b
$ 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 Bitmap
h Array (Leaf k v1)
ary) = forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h forall a b. (a -> b) -> a -> b
$
                           forall a b. (a -> b) -> Array a -> Array b
A.map' (\ (L k
k v1
v) -> 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 :: forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
map v1 -> v2
f = forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
mapWithKey (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 :: forall (f :: * -> *) k v1 v2.
Applicative f =>
(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                 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k v. HashMap k v
Empty
    go (Leaf Bitmap
h (L k
k v1
v))      = forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. k -> v -> Leaf k v
L k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> f v2
f k
k v1
v
    go (BitmapIndexed Bitmap
b Array (HashMap k v1)
ary) = forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)            = forall k v. Array (HashMap k v) -> HashMap k v
Full forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Bitmap
h Array (Leaf k v1)
ary)     =
        forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse' (\ (L k
k v1
v) -> forall k v. k -> v -> Leaf k v
L k
k 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 #-}

-- | \(O(n)\).
-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key. In this case there is no guarantee which of the
-- associated values is chosen for the conflicting key.
--
-- >>> mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])
-- fromList [(4,"b"),(6,"a")]
-- >>> mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")])
-- fromList [(1,"c")]
-- >>> mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")])
-- fromList [(3,"c")]
--
-- @since 0.2.14.0
mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys :: forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys k1 -> k2
f = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (\k1
k v
x [(k2, v)]
xs -> (k1 -> k2
f k1
k, v
x) forall a. a -> [a] -> [a]
: [(k2, v)]
xs) []

------------------------------------------------------------------------
-- * 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 :: forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
difference HashMap k v
a HashMap k w
b = forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go 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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
unsafeInsert 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 :: forall k v w.
(Eq k, Hashable k) =>
(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 = forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go 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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
unsafeInsert k
k v
v HashMap k v
m
                 Just w
w  -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k v
m (\v
y -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
unsafeInsert 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 :: forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
intersection = forall a. a -> a
Exts.inline forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith forall a b. a -> b -> a
const
{-# 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 :: forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith v1 -> v2 -> v3
f = forall a. a -> a
Exts.inline forall k v1 v2 v3.
(Eq k, Hashable k) =>
(k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const v1 -> v2 -> v3
f
{-# 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 :: forall k v1 v2 v3.
(Eq k, Hashable k) =>
(k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey k -> v1 -> v2 -> v3
f = forall k v1 v2 v3.
Eq k =>
(k -> v1 -> v2 -> (# v3 #))
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey# forall a b. (a -> b) -> a -> b
$ \k
k v1
v1 v2
v2 -> (# k -> v1 -> v2 -> v3
f k
k v1
v1 v2
v2 #)
{-# INLINABLE intersectionWithKey #-}

intersectionWithKey# :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey# :: forall k v1 v2 v3.
Eq k =>
(k -> v1 -> v2 -> (# v3 #))
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWithKey# k -> v1 -> v2 -> (# v3 #)
f = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go Int
0
  where
    -- empty vs. anything
    go :: Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go !Int
_ HashMap k v1
_ HashMap k v2
Empty = forall k v. HashMap k v
Empty
    go Int
_ HashMap k v1
Empty HashMap k v2
_ = forall k v. HashMap k v
Empty
    -- leaf vs. anything
    go Int
s (Leaf Bitmap
h1 (L k
k1 v1
v1)) HashMap k v2
t2 =
      forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Bitmap -> k -> Int -> HashMap k v -> r
lookupCont
        (\(# #)
_ -> forall k v. HashMap k v
Empty)
        (\v2
v Int
_ -> case k -> v1 -> v2 -> (# v3 #)
f k
k1 v1
v1 v2
v of (# v3
v' #) -> forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k1 v3
v')
        Bitmap
h1 k
k1 Int
s HashMap k v2
t2
    go Int
s HashMap k v1
t1 (Leaf Bitmap
h2 (L k
k2 v2
v2)) =
      forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Bitmap -> k -> Int -> HashMap k v -> r
lookupCont
        (\(# #)
_ -> forall k v. HashMap k v
Empty)
        (\v1
v Int
_ -> case k -> v1 -> v2 -> (# v3 #)
f k
k2 v1
v v2
v2 of (# v3
v' #) -> forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h2 forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k2 v3
v')
        Bitmap
h2 k
k2 Int
s HashMap k v1
t1
    -- collision vs. collision
    go Int
_ (Collision Bitmap
h1 Array (Leaf k v1)
ls1) (Collision Bitmap
h2 Array (Leaf k v2)
ls2) = forall k v1 v2 v3.
Eq k =>
(k -> v1 -> v2 -> (# v3 #))
-> Bitmap
-> Bitmap
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
intersectionCollisions k -> v1 -> v2 -> (# v3 #)
f Bitmap
h1 Bitmap
h2 Array (Leaf k v1)
ls1 Array (Leaf k v2)
ls2
    -- branch vs. branch
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v1)
ary1) (BitmapIndexed Bitmap
b2 Array (HashMap k v2)
ary2) =
      forall k v1 v2 v3.
(HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy (Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey)) Bitmap
b1 Bitmap
b2 Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v1)
ary1) (Full Array (HashMap k v2)
ary2) =
      forall k v1 v2 v3.
(HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy (Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey)) Bitmap
b1 Bitmap
fullNodeMask Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    go Int
s (Full Array (HashMap k v1)
ary1) (BitmapIndexed Bitmap
b2 Array (HashMap k v2)
ary2) =
      forall k v1 v2 v3.
(HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy (Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey)) Bitmap
fullNodeMask Bitmap
b2 Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    go Int
s (Full Array (HashMap k v1)
ary1) (Full Array (HashMap k v2)
ary2) =
      forall k v1 v2 v3.
(HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy (Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey)) Bitmap
fullNodeMask Bitmap
fullNodeMask Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    -- collision vs. branch
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v1)
ary1) t2 :: HashMap k v2
t2@(Collision Bitmap
h2 Array (Leaf k v2)
_ls2)
      | Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
m2 forall a. Eq a => a -> a -> Bool
== Bitmap
0 = forall k v. HashMap k v
Empty
      | Bool
otherwise = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey) (forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary1 Int
i) HashMap k v2
t2
      where
        m2 :: Bitmap
m2 = Bitmap -> Int -> Bitmap
mask Bitmap
h2 Int
s
        i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b1 Bitmap
m2
    go Int
s t1 :: HashMap k v1
t1@(Collision Bitmap
h1 Array (Leaf k v1)
_ls1) (BitmapIndexed Bitmap
b2 Array (HashMap k v2)
ary2)
      | Bitmap
b2 forall a. Bits a => a -> a -> a
.&. Bitmap
m1 forall a. Eq a => a -> a -> Bool
== Bitmap
0 = forall k v. HashMap k v
Empty
      | Bool
otherwise = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey) HashMap k v1
t1 (forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ary2 Int
i)
      where
        m1 :: Bitmap
m1 = Bitmap -> Int -> Bitmap
mask Bitmap
h1 Int
s
        i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b2 Bitmap
m1
    go Int
s (Full Array (HashMap k v1)
ary1) t2 :: HashMap k v2
t2@(Collision Bitmap
h2 Array (Leaf k v2)
_ls2) = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey) (forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary1 Int
i) HashMap k v2
t2
      where
        i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h2 Int
s
    go Int
s t1 :: HashMap k v1
t1@(Collision Bitmap
h1 Array (Leaf k v1)
_ls1) (Full Array (HashMap k v2)
ary2) = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int
s forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey) HashMap k v1
t1 (forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ary2 Int
i)
      where
        i :: Int
i = Bitmap -> Int -> Int
index Bitmap
h1 Int
s
{-# INLINE intersectionWithKey# #-}

intersectionArrayBy ::
  ( HashMap k v1 ->
    HashMap k v2 ->
    HashMap k v3
  ) ->
  Bitmap ->
  Bitmap ->
  A.Array (HashMap k v1) ->
  A.Array (HashMap k v2) ->
  HashMap k v3
intersectionArrayBy :: forall k v1 v2 v3.
(HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy HashMap k v1 -> HashMap k v2 -> HashMap k v3
f !Bitmap
b1 !Bitmap
b2 !Array (HashMap k v1)
ary1 !Array (HashMap k v2)
ary2
  | Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
b2 forall a. Eq a => a -> a -> Bool
== Bitmap
0 = forall k v. HashMap k v
Empty
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MArray s (HashMap k v3)
mary <- forall s a. Int -> ST s (MArray s a)
A.new_ forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int
popCount Bitmap
bIntersect
    -- iterate over nonzero bits of b1 .|. b2
    let go :: Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go !Int
i !Int
i1 !Int
i2 !Bitmap
b !Bitmap
bFinal
          | Bitmap
b forall a. Eq a => a -> a -> Bool
== Bitmap
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, Bitmap
bFinal)
          | Bitmap -> Bool
testBit forall a b. (a -> b) -> a -> b
$ Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
b2 = do
            HashMap k v1
x1 <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v1)
ary1 Int
i1
            HashMap k v2
x2 <- forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v2)
ary2 Int
i2
            case HashMap k v1 -> HashMap k v2 -> HashMap k v3
f HashMap k v1
x1 HashMap k v2
x2 of
              HashMap k v3
Empty -> Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go Int
i (Int
i1 forall a. Num a => a -> a -> a
+ Int
1) (Int
i2 forall a. Num a => a -> a -> a
+ Int
1) Bitmap
b' (Bitmap
bFinal forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Bitmap
m)
              HashMap k v3
_ -> do
                forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v3)
mary Int
i forall a b. (a -> b) -> a -> b
$! HashMap k v1 -> HashMap k v2 -> HashMap k v3
f HashMap k v1
x1 HashMap k v2
x2
                Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int
i1 forall a. Num a => a -> a -> a
+ Int
1) (Int
i2 forall a. Num a => a -> a -> a
+ Int
1) Bitmap
b' Bitmap
bFinal
          | Bitmap -> Bool
testBit Bitmap
b1 = Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go Int
i (Int
i1 forall a. Num a => a -> a -> a
+ Int
1) Int
i2 Bitmap
b' Bitmap
bFinal
          | Bool
otherwise = Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go Int
i Int
i1 (Int
i2 forall a. Num a => a -> a -> a
+ Int
1) Bitmap
b' Bitmap
bFinal
          where
            m :: Bitmap
m = Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` forall b. FiniteBits b => b -> Int
countTrailingZeros Bitmap
b
            testBit :: Bitmap -> Bool
testBit Bitmap
x = Bitmap
x forall a. Bits a => a -> a -> a
.&. Bitmap
m forall a. Eq a => a -> a -> Bool
/= Bitmap
0
            b' :: Bitmap
b' = Bitmap
b forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Bitmap
m
    (Int
len, Bitmap
bFinal) <- Int -> Int -> Int -> Bitmap -> Bitmap -> ST s (Int, Bitmap)
go Int
0 Int
0 Int
0 Bitmap
bCombined Bitmap
bIntersect
    case Int
len of
      Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k v. HashMap k v
Empty
      Int
1 -> do
        HashMap k v3
l <- forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v3)
mary Int
0
        if forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v3
l
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v3
l
          else forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bFinal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v3)
mary Int
1)
      Int
_ -> forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
bFinal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v3)
mary Int
len)
  where
    bCombined :: Bitmap
bCombined = Bitmap
b1 forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    bIntersect :: Bitmap
bIntersect = Bitmap
b1 forall a. Bits a => a -> a -> a
.&. Bitmap
b2
{-# INLINE intersectionArrayBy #-}

intersectionCollisions :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> Hash -> Hash -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> HashMap k v3
intersectionCollisions :: forall k v1 v2 v3.
Eq k =>
(k -> v1 -> v2 -> (# v3 #))
-> Bitmap
-> Bitmap
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
intersectionCollisions k -> v1 -> v2 -> (# v3 #)
f Bitmap
h1 Bitmap
h2 Array (Leaf k v1)
ary1 Array (Leaf k v2)
ary2
  | Bitmap
h1 forall a. Eq a => a -> a -> Bool
== Bitmap
h2 = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MArray s (Leaf k v2)
mary2 <- forall e s. Array e -> Int -> Int -> ST s (MArray s e)
A.thaw Array (Leaf k v2)
ary2 Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2
    MArray s (Leaf k v3)
mary <- forall s a. Int -> ST s (MArray s a)
A.new_ forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1) (forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2)
    let go :: Int -> Int -> ST s Int
go Int
i Int
j
          | Int
i forall a. Ord a => a -> a -> Bool
>= forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1 Bool -> Bool -> Bool
|| Int
j forall a. Ord a => a -> a -> Bool
>= forall s a. MArray s a -> Int
A.lengthM MArray s (Leaf k v2)
mary2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
j
          | Bool
otherwise = do
            L k
k1 v1
v1 <- forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v1)
ary1 Int
i
            forall k s v.
Eq k =>
k -> Int -> MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
searchSwap k
k1 Int
j MArray s (Leaf k v2)
mary2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just (L k
_k2 v2
v2) -> do
                let !(# v3
v3 #) = k -> v1 -> v2 -> (# v3 #)
f k
k1 v1
v1 v2
v2
                forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v3)
mary Int
j forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k1 v3
v3
                Int -> Int -> ST s Int
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int
j forall a. Num a => a -> a -> a
+ Int
1)
              Maybe (Leaf k v2)
Nothing -> do
                Int -> Int -> ST s Int
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
j
    Int
len <- Int -> Int -> ST s Int
go Int
0 Int
0
    case Int
len of
      Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k v. HashMap k v
Empty
      Int
1 -> forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v3)
mary Int
0
      Int
_ -> forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (Leaf k v3)
mary Int
len)
  | Bool
otherwise = forall k v. HashMap k v
Empty
{-# INLINE intersectionCollisions #-}

-- | Say we have
-- @
-- 1 2 3 4
-- @
-- and we search for @3@. Then we can mutate the array to
-- @
-- undefined 2 1 4
-- @
-- We don't actually need to write undefined, we just have to make sure that the next search starts 1 after the current one.
searchSwap :: Eq k => k -> Int -> A.MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
searchSwap :: forall k s v.
Eq k =>
k -> Int -> MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
searchSwap k
toFind Int
start = forall {t} {s} {v}.
Eq t =>
Int -> t -> Int -> MArray s (Leaf t v) -> ST s (Maybe (Leaf t v))
go Int
start k
toFind Int
start
  where
    go :: Int -> t -> Int -> MArray s (Leaf t v) -> ST s (Maybe (Leaf t v))
go Int
i0 t
k Int
i MArray s (Leaf t v)
mary
      | Int
i forall a. Ord a => a -> a -> Bool
>= forall s a. MArray s a -> Int
A.lengthM MArray s (Leaf t v)
mary = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      | Bool
otherwise = do
        l :: Leaf t v
l@(L t
k' v
_v) <- forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf t v)
mary Int
i
        if t
k forall a. Eq a => a -> a -> Bool
== t
k'
          then do
            forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf t v)
mary Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf t v)
mary Int
i0
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Leaf t v
l
          else Int -> t -> Int -> MArray s (Leaf t v) -> ST s (Maybe (Leaf t v))
go Int
i0 t
k (Int
i forall a. Num a => a -> a -> a
+ Int
1) MArray s (Leaf t v)
mary
{-# INLINE searchSwap #-}

------------------------------------------------------------------------
-- * 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' :: forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl' a -> v -> a
f = 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' :: forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr' v -> a -> a
f = 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' :: forall a k v. (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 Bitmap
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) = 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)            = 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 Bitmap
_ Array (Leaf k v)
ary)     = 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' :: forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey' k -> v -> a -> a
f = 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 Bitmap
_ (L k
k v
v)) !a
z     = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) !a
z = 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           = 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 Bitmap
_ Array (Leaf k v)
ary) !a
z    = 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 :: forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
foldr v -> a -> a
f = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (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 :: forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
foldl a -> v -> a
f = 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 :: forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey k -> v -> a -> a
f = 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 Bitmap
_ (L k
k v
v)) a
z      = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) a
z = 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            = 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 Bitmap
_ Array (Leaf k v)
ary) a
z     = 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 :: forall a k v. (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 Bitmap
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) = 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)            = 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 Bitmap
_ Array (Leaf k v)
ary)     = 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 :: forall m k v. Monoid m => (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 = forall a. Monoid a => a
mempty
    go (Leaf Bitmap
_ (L k
k v
v)) = k -> v -> m
f k
k v
v
    go (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) = 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) = forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap HashMap k v -> m
go Array (HashMap k v)
ary
    go (Collision Bitmap
_ Array (Leaf k v)
ary) = 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 :: forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybeWithKey k -> v1 -> Maybe v2
f = 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 Bitmap
h (L k
k v1
v)) | Just v2
v' <- k -> v1 -> Maybe v2
f k
k v1
v = forall a. a -> Maybe a
Just (forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (forall k v. k -> v -> Leaf k v
L k
k v2
v'))
        onLeaf HashMap k v1
_ = 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 = forall a. a -> Maybe a
Just (forall k v. k -> v -> Leaf k v
L k
k v2
v')
                       | Bool
otherwise = 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 :: forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybe v1 -> Maybe v2
f = forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybeWithKey (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 :: forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
filterWithKey k -> v -> Bool
pred = 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 Bitmap
_ (L k
k v
v)) | k -> v -> Bool
pred k
k v
v = forall a. a -> Maybe a
Just HashMap k v
t
        onLeaf 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 = forall a. a -> Maybe a
Just Leaf k v
el
        onColl 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 :: 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 = HashMap k v1 -> HashMap k v2
go
  where
    go :: HashMap k v1 -> HashMap k v2
go HashMap k v1
Empty = 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 = forall k v. HashMap k v
Empty
    go (BitmapIndexed Bitmap
b Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Bitmap -> HashMap k v2
filterA Array (HashMap k v1)
ary Bitmap
b
    go (Full Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Bitmap -> HashMap k v2
filterA Array (HashMap k v1)
ary Bitmap
fullNodeMask
    go (Collision Bitmap
h Array (Leaf k v1)
ary) = Array (Leaf k v1) -> Bitmap -> HashMap k v2
filterC Array (Leaf k v1)
ary Bitmap
h

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

    filterC :: Array (Leaf k v1) -> Bitmap -> HashMap k v2
filterC Array (Leaf k v1)
ary0 Bitmap
h =
        let !n :: Int
n = forall a. Array a -> Int
A.length Array (Leaf k v1)
ary0
        in forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
            MArray s (Leaf k v2)
mary <- forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            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 :: 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
i !Int
j Int
n
            | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n    = case Int
j of
                Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k v. HashMap k v
Empty
                Int
1 -> do Leaf k v2
l <- forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v2)
mary Int
0
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h Leaf k v2
l
                Int
_ | Int
i forall a. Eq a => a -> a -> Bool
== Int
j -> do Array (Leaf k v2)
ary2 <- forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (Leaf k v2)
mary
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h Array (Leaf k v2)
ary2
                  | Bool
otherwise -> do Array (Leaf k v2)
ary2 <- forall s a. MArray s a -> Int -> ST s (Array a)
A.trim MArray s (Leaf k v2)
mary Int
j
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h Array (Leaf k v2)
ary2
            | Just Leaf k v2
el <- Leaf k v1 -> Maybe (Leaf k v2)
onColl forall a b. (a -> b) -> a -> b
$! forall a. Array a -> Int -> a
A.index Array (Leaf k v1)
ary Int
i
                = forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v2)
mary Int
j Leaf k v2
el forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
iforall a. Num a => a -> a -> a
+Int
1) (Int
jforall a. Num a => a -> a -> a
+Int
1) Int
n
            | Bool
otherwise = 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
iforall 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 :: forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
filter v -> Bool
p = 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 :: forall k v. HashMap k v -> [k]
keys = forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall k a. HashMap k a -> [a]
elems = forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall k v. HashMap k v -> [(k, v)]
toList HashMap k v
t = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build (\ (k, v) -> b -> b
c b
z -> forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (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 :: forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ HashMap k v
m (k
k, v
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) 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 :: forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWith v -> v -> v
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ HashMap k v
m (k
k, v
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) 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 :: forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWithKey k -> v -> v -> v
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ HashMap k v
m (k
k, v
v) -> forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> (# v #)) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWithKey (\k
k' v
a v
b -> (# k -> v -> v -> v
f k
k' v
a v
b #)) k
k v
v HashMap k v
m) 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 ::
  forall rep (r :: TYPE rep) k v.
  Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
lookupInArrayCont :: forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (# #) -> r
absent v -> Int -> r
present k
k0 Array (Leaf k v)
ary0 = Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go k
k0 Array (Leaf k v)
ary0 Int
0 (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 :: Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go !k
k !Array (Leaf k v)
ary !Int
i !Int
n
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n    = (# #) -> r
absent (# #)
        | Bool
otherwise = case forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
v)
                | k
k forall a. Eq a => a -> a -> Bool
== k
kx   -> v -> Int -> r
present v
v Int
i
                | Bool
otherwise -> Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go k
k Array (Leaf k v)
ary (Int
iforall 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 :: forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k0 Array (Leaf k v)
ary0 = forall {t} {v}.
Eq t =>
t -> Array (Leaf t v) -> Int -> Int -> Maybe Int
go k
k0 Array (Leaf k v)
ary0 Int
0 (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 forall a. Ord a => a -> a -> Bool
>= Int
n    = forall a. Maybe a
Nothing
        | Bool
otherwise = case forall a. Array a -> Int -> a
A.index Array (Leaf t v)
ary Int
i of
            (L t
kx v
_)
                | t
k forall a. Eq a => a -> a -> Bool
== t
kx   -> 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
iforall 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# :: forall k v.
Eq k =>
(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 (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 forall a. Ord a => a -> a -> Bool
>= Int
n    = Array (Leaf k v)
ary
        | Bool
otherwise = case forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
y) | k
k forall a. Eq a => a -> a -> Bool
== k
kx -> case v -> (# v #)
f v
y of
                          (# v
y' #)
                             | forall a. a -> a -> Bool
ptrEq v
y v
y' -> Array (Leaf k v)
ary
                             | Bool
otherwise -> forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (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
iforall 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 :: forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith v -> v -> (# v #)
f = forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey (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 :: forall k v.
Eq k =>
(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 (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
        -- Not found, append to the end.
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = forall a. Array a -> a -> Array a
A.snoc Array (Leaf k v)
ary forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Leaf k v
L k
k v
v
        | L k
kx v
y <- forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i
        , k
k forall a. Eq a => a -> a -> Bool
== k
kx
        , (# v
v2 #) <- k -> v -> v -> (# v #)
f k
k v
v v
y
            = forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (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
iforall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINABLE updateOrSnocWithKey #-}

updateOrConcatWithKey :: Eq k => (k -> v -> v -> (# v #)) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
updateOrConcatWithKey :: 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)
ary1 Array (Leaf k v)
ary2 = forall e. (forall s. ST s (MArray s e)) -> Array e
A.run 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 = forall a b. (a -> b) -> Array a -> Array b
A.map' (\(L k
k v
_) -> 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 = forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (\Int
n -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
nforall a. Num a => a -> a -> a
+Int
1) (forall a b. a -> b -> a
const Int
n)) Int
0 Array (Maybe Int)
indices
    let n1 :: Int
n1 = forall a. Array a -> Int
A.length Array (Leaf k v)
ary1
    let n2 :: Int
n2 = forall a. Array a -> Int
A.length Array (Leaf k v)
ary2
    -- copy over all elements from ary1
    MArray s (Leaf k v)
mary <- forall s a. Int -> ST s (MArray s a)
A.new_ (Int
n1 forall a. Num a => a -> a -> a
+ Int
nOnly2)
    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 forall a. Ord a => a -> a -> Bool
>= Int
n2 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise = case 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 <- forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary1 Int
i1
                             L k
_ v
v2 <- forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             case k -> v -> v -> (# v #)
f k
k v
v1 v
v2 of (# v
v3 #) -> forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
i1 (forall k v. k -> v -> Leaf k v
L k
k v
v3)
                             Int -> Int -> ST s ()
go Int
iEnd (Int
i2forall a. Num a => a -> a -> a
+Int
1)
               Maybe Int
Nothing -> do -- key is only in ary2, append to end
                             forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
iEnd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             Int -> Int -> ST s ()
go (Int
iEndforall a. Num a => a -> a -> a
+Int
1) (Int
i2forall a. Num a => a -> a -> a
+Int
1)
    Int -> Int -> ST s ()
go Int
n1 Int
0
    forall (m :: * -> *) a. Monad m => a -> m a
return MArray s (Leaf k v)
mary
{-# INLINABLE updateOrConcatWithKey #-}

-- | \(O(n*m)\) Check if the first array is a subset of the second array.
subsetArray :: Eq k => (v1 -> v2 -> Bool) -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> Bool
subsetArray :: forall k v1 v2.
Eq k =>
(v1 -> v2 -> Bool)
-> Array (Leaf k v1) -> Array (Leaf k v2) -> Bool
subsetArray v1 -> v2 -> Bool
cmpV Array (Leaf k v1)
ary1 Array (Leaf k v2)
ary2 = forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1 forall a. Ord a => a -> a -> Bool
<= forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2 Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> Array a -> Bool
A.all Leaf k v1 -> Bool
inAry2 Array (Leaf k v1)
ary1
  where
    inAry2 :: Leaf k v1 -> Bool
inAry2 (L k
k1 v1
v1) = forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (\(# #)
_ -> Bool
False) (\v2
v2 Int
_ -> v1 -> v2 -> Bool
cmpV v1
v1 v2
v2) k
k1 Array (Leaf k v2)
ary2
    {-# INLINE inAry2 #-}

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

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

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

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

-- | Unsafely clone an array of (2^bitsPerSubkey) elements.  The length of the input
-- array is not checked.
clone :: A.Array e -> ST s (A.MArray s e)
clone :: forall e s. Array e -> ST s (MArray s e)
clone Array e
ary =
    forall e s. Array e -> Int -> Int -> ST s (MArray s e)
A.thaw Array e
ary Int
0 (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
bitsPerSubkey)

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

-- TODO: Name this 'bitsPerLevel'?! What is a "subkey"?
-- https://github.com/haskell-unordered-containers/unordered-containers/issues/425

-- | Number of bits that are inspected at each level of the hash tree.
--
-- This constant is named /t/ in the original /Ideal Hash Trees/ paper.
bitsPerSubkey :: Int
bitsPerSubkey :: Int
bitsPerSubkey = Int
5

-- | The size of a 'Full' node, i.e. @2 ^ 'bitsPerSubkey'@.
maxChildren :: Int
maxChildren :: Int
maxChildren = Int
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitsPerSubkey

-- | Bit mask with the lowest 'bitsPerSubkey' bits set, i.e. @0b11111@.
subkeyMask :: Word
subkeyMask :: Bitmap
subkeyMask = Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitsPerSubkey forall a. Num a => a -> a -> a
- Bitmap
1

-- | Given a 'Hash' and a 'Shift' that indicates the level in the tree, compute
-- the index into a 'Full' node or into the bitmap of a `BitmapIndexed` node.
--
-- >>> index 0b0010_0010 0
-- 0b0000_0010
index :: Hash -> Shift -> Int
index :: Bitmap -> Int -> Int
index Bitmap
w Int
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
unsafeShiftR Bitmap
w Int
s forall a. Bits a => a -> a -> a
.&. Bitmap
subkeyMask
{-# INLINE index #-}

-- | Given a 'Hash' and a 'Shift' that indicates the level in the tree, compute
-- the bitmap that contains only the 'index' of the hash at this level.
--
-- The result can be used for constructing one-element 'BitmapIndexed' nodes or
-- to check whether a 'BitmapIndexed' node may possibly contain the given 'Hash'.
--
-- >>> mask 0b0010_0010 0
-- 0b0100
mask :: Hash -> Shift -> Bitmap
mask :: Bitmap -> Int -> Bitmap
mask Bitmap
w Int
s = Bitmap
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Bitmap -> Int -> Int
index Bitmap
w Int
s
{-# INLINE mask #-}

-- | This array index is computed by counting the number of bits below the
-- 'index' represented by the mask.
--
-- >>> sparseIndex 0b0110_0110 0b0010_0000
-- 2
sparseIndex
    :: Bitmap
    -- ^ Bitmap of a 'BitmapIndexed' node
    -> Bitmap
    -- ^ One-bit 'mask' corresponding to the 'index' of a hash
    -> Int
    -- ^ Index into the array of the 'BitmapIndexed' node
sparseIndex :: Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m = forall a. Bits a => a -> Int
popCount (Bitmap
b forall a. Bits a => a -> a -> a
.&. (Bitmap
m forall a. Num a => a -> a -> a
- Bitmap
1))
{-# INLINE sparseIndex #-}

-- TODO: Should be named _(bit)map_ instead of _mask_

-- | A bitmap with the 'maxChildren' least significant bits set, i.e.
-- @0xFF_FF_FF_FF@.
fullNodeMask :: Bitmap
-- This needs to use 'shiftL' instead of 'unsafeShiftL', to avoid UB.
-- See issue #412.
fullNodeMask :: Bitmap
fullNodeMask = forall a. Bits a => a -> a
complement (forall a. Bits a => a -> a
complement Bitmap
0 forall a. Bits a => a -> Int -> a
`shiftL` Int
maxChildren)
{-# INLINE fullNodeMask #-}

------------------------------------------------------------------------
-- Pointer equality

-- | 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 :: forall a. a -> a -> Bool
ptrEq a
x a
y = Int# -> Bool
Exts.isTrue# (forall a. a -> a -> Int#
Exts.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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList
    toList :: HashMap k v -> [Item (HashMap k v)]
toList   = forall k v. HashMap k v -> [(k, v)]
toList