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

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

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

      -- * Construction
    , empty
    , singleton

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

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

    -- ** Compose
    , compose

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

      -- * Difference and intersection
    , difference
    , differenceWith
    , intersection
    , intersectionWith
    , intersectionWithKey
    , 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
    , Shift
    , bitmapIndexedOrFull
    , collision
    , hash
    , mask
    , index
    , bitsPerSubkey
    , maxChildren
    , isLeafOrCollision
    , fullBitmap
    , subkeyMask
    , nextShift
    , sparseIndex
    , two
    , unionArrayBy
    , update32
    , update32M
    , update32With'
    , updateOrConcatWithKey
    , filterMapAux
    , equalKeys
    , equalKeys1
    , lookupRecordCollision
    , LookupRes(..)
    , lookupResToMaybe
    , 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.HashMap.Internal.List (isPermutationBy, unorderedCompare)
import Data.Semigroup             (Semigroup (..), stimesIdempotentMonoid)
import GHC.Exts                   (Int (..), Int#, TYPE, (==#))
import GHC.Stack                  (HasCallStack)
import Prelude                    hiding (Foldable(..), filter, lookup, map,
                                   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.HashMap.Internal.Array as A
import qualified Data.List                   as List
import qualified GHC.Exts                    as Exts
import qualified Language.Haskell.TH.Syntax  as TH

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

data Leaf k v = L !k v
  deriving (Leaf k v -> Leaf k v -> Bool
(Leaf k v -> Leaf k v -> Bool)
-> (Leaf k v -> Leaf k v -> Bool) -> Eq (Leaf k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Leaf k v -> Leaf k v -> Bool
$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
/= :: Leaf k v -> Leaf k v -> Bool
Eq)

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

-- | @since 0.2.17.0
instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => Leaf k v -> Code m (Leaf k v)
liftTyped (L k
k v
v) = [|| k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! v
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 = (k -> ()) -> (a -> ()) -> Leaf k a -> ()
forall a b. (a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 k -> ()
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 () -> () -> ()
forall a b. a -> b -> b
`seq` b -> ()
rnf2 b
v

-- | 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
    -- ^ Invariants:
    --
    -- * 'Empty' is not a valid sub-node. It can only appear at the root. (INV1)
    | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
    -- ^ Invariants:
    --
    -- * Only the lower @maxChildren@ bits of the 'Bitmap' may be set. The
    --   remaining upper bits must be 0. (INV2)
    -- * The array of a 'BitmapIndexed' node stores at least 1 and at most
    --   @'maxChildren' - 1@ sub-nodes. (INV3)
    -- * The number of sub-nodes is equal to the number of 1-bits in its
    --   'Bitmap'. (INV4)
    -- * If a 'BitmapIndexed' node has only one sub-node, this sub-node must
    --   be a 'BitmapIndexed' or a 'Full' node. (INV5)
    | Leaf !Hash !(Leaf k v)
    -- ^ Invariants:
    --
    -- * The location of a 'Leaf' or 'Collision' node in the tree must be
    --   compatible with its 'Hash'. (INV6)
    --   (TODO: Document this properly (#425))
    -- * The 'Hash' of a 'Leaf' node must be the 'hash' of its key. (INV7)
    | Full !(A.Array (HashMap k v))
    -- ^ Invariants:
    --
    -- * The array of a 'Full' node stores exactly 'maxChildren' sub-nodes. (INV8)
    | Collision !Hash !(A.Array (Leaf k v))
    -- ^ Invariants:
    --
    -- * The location of a 'Leaf' or 'Collision' node in the tree must be
    --   compatible with its 'Hash'. (INV6)
    --   (TODO: Document this properly (#425))
    -- * The array of a 'Collision' node must contain at least two sub-nodes. (INV9)
    -- * The 'hash' of each key in a 'Collision' node must be the one stored in
    --   the node. (INV7)
    -- * No two keys stored in a 'Collision' can be equal according to their
    --   'Eq' instance. (INV10)

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) = Array (HashMap k v) -> ()
forall a. NFData a => a -> ()
rnf Array (HashMap k v)
ary
    rnf (Leaf Bitmap
_ Leaf k v
l)            = Leaf k v -> ()
forall a. NFData a => a -> ()
rnf Leaf k v
l
    rnf (Full Array (HashMap k v)
ary)            = Array (HashMap k v) -> ()
forall a. NFData a => a -> ()
rnf Array (HashMap k v)
ary
    rnf (Collision Bitmap
_ Array (Leaf k v)
ary)     = Array (Leaf k v) -> ()
forall a. NFData a => a -> ()
rnf Array (Leaf k v)
ary

-- | @since 0.2.14.0
instance NFData k => NFData1 (HashMap k) where
    liftRnf :: forall a. (a -> ()) -> HashMap k a -> ()
liftRnf = (k -> ()) -> (a -> ()) -> HashMap k a -> ()
forall a b. (a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 k -> ()
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) = (HashMap a b -> ()) -> Array (HashMap a b) -> ()
forall a. (a -> ()) -> Array a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall a b. (a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (HashMap a b)
ary
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Leaf Bitmap
_ Leaf a b
l)            = (a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall a b. (a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2 Leaf a b
l
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Full Array (HashMap a b)
ary)            = (HashMap a b -> ()) -> Array (HashMap a b) -> ()
forall a. (a -> ()) -> Array a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf ((a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall a b. (a -> ()) -> (b -> ()) -> HashMap a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (HashMap a b)
ary
    liftRnf2 a -> ()
rnf1 b -> ()
rnf2 (Collision Bitmap
_ Array (Leaf a b)
ary)     = (Leaf a b -> ()) -> Array (Leaf a b) -> ()
forall a. (a -> ()) -> Array a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf ((a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall a b. (a -> ()) -> (b -> ()) -> Leaf a b -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnf1 b -> ()
rnf2) Array (Leaf a b)
ary

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

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

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

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

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

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

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

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

-- | 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 'fullBitmap'
-- 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 =
        (Int -> [(a, b)] -> ShowS) -> [Char] -> Int -> [(a, b)] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
FC.showsUnaryWith ((Int -> (a, b) -> ShowS)
-> ([(a, b)] -> ShowS) -> Int -> [(a, b)] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> (a, b) -> ShowS
sp [(a, b)] -> ShowS
sl) [Char]
"fromList" Int
d (HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap a b
m)
      where
        sp :: Int -> (a, b) -> ShowS
sp = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv
        sl :: [(a, b)] -> ShowS
sl = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv

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

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

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

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

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

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

instance Eq2 HashMap where
    liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
liftEq2 = (a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> HashMap a c -> HashMap b d -> Bool
equal2

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

-- | Note that, in the presence of hash collisions, equal @HashMap@s may
-- behave differently, i.e. extensionality 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 extensionality can be observed with any function
-- that depends on the key ordering, such as folds and traversals.
instance (Eq k, Eq v) => Eq (HashMap k v) where
    == :: HashMap k v -> HashMap k v -> Bool
(==) = (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall k v v'.
Eq k =>
(v -> v' -> Bool) -> HashMap k v -> HashMap k v' -> Bool
equal1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)

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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
bm2 Bool -> Bool -> Bool
&& (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Leaf Bitmap
h1 Leaf k v
l1) (Leaf Bitmap
h2 Leaf k v'
l2) = Bitmap
h1 Bitmap -> Bitmap -> Bool
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) = (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Collision Bitmap
h1 Array (Leaf k v)
ary1) (Collision Bitmap
h2 Array (Leaf k v')
ary2)
      = Bitmap
h1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& (Leaf k v -> Leaf k v' -> Bool)
-> [Leaf k v] -> [Leaf k v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k v') -> [Leaf k v']
forall a. Array a -> [a]
A.toList Array (Leaf k v')
ary2)
    go HashMap k v
_ HashMap k v'
_ = Bool
False

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

equal2 :: (k -> k' -> Bool) -> (v -> v' -> Bool)
      -> HashMap k v -> HashMap k' v' -> Bool
equal2 :: 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 (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
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 Bitmap -> Bitmap -> Bool
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
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Bitmap
h1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&&
        Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        (Leaf k v -> Leaf k' v' -> Bool)
-> [Leaf k v] -> [Leaf k' v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2)
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go [] [] = Bool
True
    go [HashMap k v]
_  [HashMap k' v']
_  = Bool
False

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

instance Ord2 HashMap where
    liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
liftCompare2 = (a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> HashMap a c -> HashMap b d -> Ordering
cmp

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

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

cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
    -> HashMap k v -> HashMap k' v' -> Ordering
cmp :: 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 (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
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)
      = Bitmap -> Bitmap -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bitmap
k1 Bitmap
k2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        Leaf k v -> Leaf k' v' -> Ordering
leafCompare Leaf k v
l1 Leaf k' v'
l2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        [HashMap k v] -> [HashMap k' v'] -> Ordering
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Collision Bitmap
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      = Bitmap -> Bitmap -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bitmap
h1 Bitmap
h2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1) (Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        (Leaf k v -> Leaf k' v' -> Ordering)
-> [Leaf k v] -> [Leaf k' v'] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
unorderedCompare Leaf k v -> Leaf k' v' -> Ordering
leafCompare (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
        [HashMap k v] -> [HashMap k' v'] -> Ordering
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go (Leaf 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']
_ = [Char] -> Ordering
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' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` v -> v' -> Ordering
cmpv v
v v'
v'

-- Same as 'equal2' but doesn't compare the values.
equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equalKeys1 :: 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 (HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions HashMap k v
t1 []) (HashMap k' v' -> [HashMap k' v'] -> [HashMap k' v']
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
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 Bitmap -> Bitmap -> Bool
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
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Bitmap
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Bitmap
h1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Leaf k' v') -> Int
forall a. Array a -> Int
A.length Array (Leaf k' v')
ary2 Bool -> Bool -> Bool
&&
        (Leaf k v -> Leaf k' v' -> Bool)
-> [Leaf k v] -> [Leaf k' v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k' v' -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k' v') -> [Leaf k' v']
forall a. Array a -> [a]
A.toList Array (Leaf k' v')
ary2)
      = [HashMap k v] -> [HashMap k' v'] -> Bool
go [HashMap k v]
tl1 [HashMap k' v']
tl2
    go [] [] = Bool
True
    go [HashMap k v]
_  [HashMap k' v']
_  = Bool
False

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

-- Same as 'equal1' but doesn't compare the values.
equalKeys :: Eq k => HashMap k v -> HashMap k v' -> Bool
equalKeys :: forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
equalKeys = HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go
  where
    go :: Eq k => HashMap k v -> HashMap k v' -> Bool
    go :: 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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
bm2 Bool -> Bool -> Bool
&& (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Leaf Bitmap
h1 Leaf k v
l1) (Leaf Bitmap
h2 Leaf k v'
l2) = Bitmap
h1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& Leaf k v -> Leaf k v' -> Bool
forall {a} {v} {v}. Eq a => Leaf a v -> Leaf a v -> Bool
leafEq Leaf k v
l1 Leaf k v'
l2
    go (Full Array (HashMap k v)
ary1) (Full Array (HashMap k v')
ary2) = (HashMap k v -> HashMap k v' -> Bool)
-> Array (HashMap k v) -> Array (HashMap k v') -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
A.sameArray1 HashMap k v -> HashMap k v' -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
go Array (HashMap k v)
ary1 Array (HashMap k v')
ary2
    go (Collision Bitmap
h1 Array (Leaf k v)
ary1) (Collision Bitmap
h2 Array (Leaf k v')
ary2)
      = Bitmap
h1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 Bool -> Bool -> Bool
&& (Leaf k v -> Leaf k v' -> Bool)
-> [Leaf k v] -> [Leaf k v'] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy Leaf k v -> Leaf k v' -> Bool
forall {a} {v} {v}. Eq a => Leaf a v -> Leaf a v -> Bool
leafEq (Array (Leaf k v) -> [Leaf k v]
forall a. Array a -> [a]
A.toList Array (Leaf k v)
ary1) (Array (Leaf k v') -> [Leaf k v']
forall a. Array a -> [a]
A.toList Array (Leaf k v')
ary2)
    go HashMap k v
_ HashMap k v'
_ = Bool
False

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

instance Hashable2 HashMap where
    liftHashWithSalt2 :: 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 (HashMap a b -> [HashMap a b] -> [HashMap a b]
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 Int -> Bitmap -> Int
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
          = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s ([Int] -> Int)
-> (Array (Leaf a b) -> [Int]) -> Array (Leaf a b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Array (Leaf a b) -> [Int]
arrayHashesSorted Int
s

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

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

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

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

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

-- | Helper to get 'Leaf's and 'Collision's as a list.
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 = (HashMap k v -> [HashMap k v] -> [HashMap k v])
-> [HashMap k v] -> Array (HashMap k v) -> [HashMap k v]
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
leavesAndCollisions [HashMap k v]
a Array (HashMap k v)
ary
leavesAndCollisions (Full Array (HashMap k v)
ary)            [HashMap k v]
a = (HashMap k v -> [HashMap k v] -> [HashMap k v])
-> [HashMap k v] -> Array (HashMap k v) -> [HashMap k v]
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr HashMap k v -> [HashMap k v] -> [HashMap k v]
forall k v. HashMap k v -> [HashMap k v] -> [HashMap k v]
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 HashMap k v -> [HashMap k v] -> [HashMap k v]
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 HashMap k v -> [HashMap k v] -> [HashMap k v]
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 = HashMap k v
forall k v. HashMap k v
Empty

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

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

-- | \(O(1)\) Return 'True' if this map is empty, 'False' otherwise.
null :: HashMap k v -> Bool
null :: 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 = HashMap k v -> Int -> Int
forall {k} {v}. HashMap k v -> Int -> Int
go HashMap k v
t Int
0
  where
    go :: HashMap k v -> Int -> Int
go HashMap k v
Empty                !Int
n = Int
n
    go (Leaf Bitmap
_ Leaf k v
_)            Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    go (BitmapIndexed Bitmap
_ Array (HashMap k v)
ary) Int
n = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' ((HashMap k v -> Int -> Int) -> Int -> HashMap k v -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> Int -> Int
go) Int
n Array (HashMap k v)
ary
    go (Full Array (HashMap k v)
ary)            Int
n = (Int -> HashMap k v -> Int) -> Int -> Array (HashMap k v) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' ((HashMap k v -> Int -> Int) -> Int -> HashMap k v -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap k v -> Int -> Int
go) Int
n Array (HashMap k v)
ary
    go (Collision Bitmap
_ Array (Leaf k v)
ary)     Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary

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

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

lookup# :: (Eq k, Hashable k) => k -> HashMap k v -> (# (# #) | v #)
lookup# :: forall k v.
(Eq k, Hashable k) =>
k -> HashMap k v -> (# (# #) | v #)
lookup# k
k HashMap k v
m = ((# #) -> (# (# #) | v #))
-> (v -> Int -> (# (# #) | v #))
-> Bitmap
-> k
-> Int
-> HashMap k v
-> (# (# #) | v #)
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Bitmap -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> (# (# #) | #)) (\v
v Int
_i -> (# | v
v #)) (k -> Bitmap
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 Bitmap -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Bitmap -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Bitmap
h k
k HashMap k v
m of
  (# (# #) | #) -> Maybe v
forall a. Maybe a
Nothing
  (# | (# v
a, Int#
_i #) #) -> v -> Maybe v
forall a. a -> Maybe a
Just v
a
{-# INLINE lookup' #-}

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

lookupResToMaybe :: LookupRes a -> Maybe a
lookupResToMaybe :: forall a. LookupRes a -> Maybe a
lookupResToMaybe LookupRes a
Absent        = Maybe a
forall a. Maybe a
Nothing
lookupResToMaybe (Present a
x Int
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
{-# INLINE lookupResToMaybe #-}

-- 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 Bitmap -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Bitmap -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Bitmap
h k
k HashMap k v
m of
  (# (# #) | #) -> LookupRes v
forall a. LookupRes a
Absent
  (# | (# v
a, Int#
i #) #) -> v -> Int -> LookupRes v
forall a. a -> Int -> LookupRes a
Present v
a (Int# -> Int
I# Int#
i) -- GHC will eliminate the I#
{-# INLINE lookupRecordCollision #-}

-- Why do we produce an Int# instead of an Int? Unfortunately, GHC is not
-- yet any good at unboxing things *inside* products, let alone sums. That
-- may be changing in GHC 8.6 or so (there is some work in progress), but
-- for now we use Int# explicitly here. We don't need to push the Int#
-- into lookupCont because inlining takes care of that.
lookupRecordCollision# :: Eq k => Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# :: forall k v.
Eq k =>
Bitmap -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Bitmap
h k
k HashMap k v
m =
    ((# #) -> (# (# #) | (# v, Int# #) #))
-> (v -> Int -> (# (# #) | (# v, Int# #) #))
-> Bitmap
-> k
-> Int
-> HashMap k v
-> (# (# #) | (# v, Int# #) #)
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
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hx Bool -> Bool -> Bool
&& k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx = v -> Int -> r
present v
x (-Int
1)
        | Bool
otherwise          = (# #) -> r
absent (# #)
    go Bitmap
h k
k Int
s (BitmapIndexed Bitmap
b Array (HashMap k v)
v)
        | Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = (# #) -> r
absent (# #)
        | Bool
otherwise    =
            Eq k => Bitmap -> k -> Int -> HashMap k v -> r
Bitmap -> k -> Int -> HashMap k v -> r
go Bitmap
h k
k (Int -> Int
nextShift Int
s) (Array (HashMap k v) -> Int -> HashMap k v
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
Bitmap -> k -> Int -> HashMap k v -> r
go Bitmap
h k
k (Int -> Int
nextShift Int
s) (Array (HashMap k v) -> Int -> HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hx   = ((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (# #) -> r
absent v -> Int -> r
present k
k Array (Leaf k v)
v
        | Bool
otherwise = (# #) -> r
absent (# #)
{-# INLINE lookupCont #-}

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


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


-- | \(O(\log n)\) Return the value to which the specified key is mapped,
-- or the default value if this map contains no mapping for the key.
--
-- DEPRECATED: lookupDefault is deprecated as of version 0.2.11, replaced
-- by 'findWithDefault'.
lookupDefault :: (Eq k, Hashable k)
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
lookupDefault :: forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
lookupDefault = v -> k -> HashMap k v -> v
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 k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m of
    Just v
v  -> v
v
    Maybe v
Nothing -> [Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.HashMap.Internal.(!): key not found"
{-# INLINABLE (!) #-}

infixl 9 !

-- | Create a 'Collision' value with two 'Leaf' values.
collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision :: 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 s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v))
-> (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ do MArray s (Leaf k v)
mary <- Int -> Leaf k v -> ST s (MArray s (Leaf k v))
forall a s. Int -> a -> ST s (MArray s a)
A.new Int
2 Leaf k v
e1
                       MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
1 Leaf k v
e2
                       MArray s (Leaf k v) -> ST s (MArray s (Leaf k v))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s (Leaf k v)
mary
    in Bitmap -> Array (Leaf k v) -> HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
fullBitmap = Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary
    | Bool
otherwise         = Bitmap -> Array (HashMap k v) -> HashMap k v
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 = Bitmap -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Bitmap -> k -> v -> HashMap k v -> HashMap k v
insert' (k -> Bitmap
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 = Bitmap -> k -> v -> Int -> HashMap k v -> HashMap k v
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 = Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h = if t
ky t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
k
                    then if t
x t -> t -> Bool
forall a. a -> a -> Bool
`ptrEq` t
y
                         then HashMap t t
t
                         else Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
                    else Bitmap -> Leaf t t -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
        | Bool
otherwise = (forall s. ST s (HashMap t t)) -> HashMap t t
forall a. (forall s. ST s a) -> a
runST (Int
-> Bitmap -> t -> t -> Bitmap -> HashMap t t -> ST s (HashMap t t)
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let !ary' :: Array (HashMap t t)
ary' = Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap t t)
ary Int
i (HashMap t t -> Array (HashMap t t))
-> HashMap t t -> Array (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
            in Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            let !st :: HashMap t t
st  = Array (HashMap t t) -> Int -> HashMap t t
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 -> Int
nextShift Int
s) HashMap t t
st
            in if HashMap t t
st' HashMap t t -> HashMap t t -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap t t
st
               then HashMap t t
t
               else Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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  = Array (HashMap t t) -> Int -> HashMap t t
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 -> Int
nextShift Int
s) HashMap t t
st
        in if HashMap t t
st' HashMap t t -> HashMap t t -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap t t
st
            then HashMap t t
t
            else Array (HashMap t t) -> HashMap t t
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = Bitmap -> Array (Leaf t t) -> HashMap t t
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h ((t -> t -> (# t #))
-> t -> t -> Array (Leaf t t) -> Array (Leaf t t)
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 (HashMap t t -> HashMap t t) -> HashMap t t -> HashMap t t
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (HashMap t t -> Array (HashMap t t)
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 = Bitmap -> k -> v -> Int -> HashMap k v -> HashMap k v
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 = Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h = Bitmap -> Leaf t t -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
      | Bool
otherwise = (forall s. ST s (HashMap t t)) -> HashMap t t
forall a. (forall s. ST s a) -> a
runST (Int
-> Bitmap -> t -> t -> Bitmap -> HashMap t t -> ST s (HashMap t t)
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 =
            let !ary' :: Array (HashMap t t)
ary' = Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap t t)
ary Int
i (HashMap t t -> Array (HashMap t t))
-> HashMap t t -> Array (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
            in Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            let !st :: HashMap t t
st  = Array (HashMap t t) -> Int -> HashMap t t
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 -> Int
nextShift Int
s) HashMap t t
st
            in Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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  = Array (HashMap t t) -> Int -> HashMap t t
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 -> Int
nextShift Int
s) HashMap t t
st
        in Array (HashMap t t) -> HashMap t t
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = Bitmap -> Array (Leaf t t) -> HashMap t t
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Array (Leaf t t) -> Leaf t t -> Array (Leaf t t)
forall a. Array a -> a -> Array a
A.snoc Array (Leaf t t)
v (t -> t -> Leaf t t
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 (HashMap t t -> HashMap t t) -> HashMap t t -> HashMap t t
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (HashMap t t -> Array (HashMap t t)
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).
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 = Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
forall k v. Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
go Int
collPos0 Bitmap
h0 k
k0 v
x0 HashMap k v
m0
  where
    go :: Int -> Bitmap -> t -> t -> HashMap t t -> HashMap t t
go !Int
_collPos !Bitmap
_shiftedHash !t
k t
x (Leaf Bitmap
h Leaf t t
_kx)
        = Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Int
collPos Bitmap
shiftedHash t
k t
x (BitmapIndexed Bitmap
b Array (HashMap t t)
ary) =
        let !st :: HashMap t t
st  = Array (HashMap t t) -> Int -> HashMap t t
forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
            !st' :: HashMap t t
st' = Int -> Bitmap -> t -> t -> HashMap t t -> HashMap t t
go Int
collPos (Bitmap -> Bitmap
forall {a}. Bits a => a -> a
shiftHash Bitmap
shiftedHash) t
k t
x HashMap t t
st
        in Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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 -> Bitmap
mask' Bitmap
shiftedHash
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Int
collPos Bitmap
shiftedHash t
k t
x (Full Array (HashMap t t)
ary) =
        let !st :: HashMap t t
st  = Array (HashMap t t) -> Int -> HashMap t t
forall a. Array a -> Int -> a
A.index Array (HashMap t t)
ary Int
i
            !st' :: HashMap t t
st' = Int -> Bitmap -> t -> t -> HashMap t t -> HashMap t t
go Int
collPos (Bitmap -> Bitmap
forall {a}. Bits a => a -> a
shiftHash Bitmap
shiftedHash) t
k t
x HashMap t t
st
        in Array (HashMap t t) -> HashMap t t
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap t t) -> Int -> HashMap t t -> Array (HashMap t t)
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
index' Bitmap
shiftedHash
    go Int
collPos Bitmap
_shiftedHash t
k t
x (Collision Bitmap
h Array (Leaf t t)
v)
        | Int
collPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Bitmap -> Array (Leaf t t) -> HashMap t t
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Int -> t -> t -> Array (Leaf t t) -> Array (Leaf t t)
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 = HashMap t t
forall k v. HashMap k v
Empty -- error "Internal error: go {collPos negative}"
    go Int
_ Bitmap
_ t
_ t
_ HashMap t t
Empty = HashMap t t
forall k v. HashMap k v
Empty -- error "Internal error: go Empty"

    -- Customized version of 'index' that doesn't require a 'Shift'.
    index' :: Hash -> Int
    index' :: Bitmap -> Int
index' Bitmap
w = Bitmap -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitmap -> Int) -> Bitmap -> Int
forall a b. (a -> b) -> a -> b
$ Bitmap
w Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
subkeyMask
    {-# INLINE index' #-}

    -- Customized version of 'mask' that doesn't require a 'Shift'.
    mask' :: Word -> Bitmap
    mask' :: Bitmap -> Bitmap
mask' Bitmap
w = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Bitmap -> Int
index' Bitmap
w
    {-# INLINE mask' #-}

    shiftHash :: a -> a
shiftHash a
h = a
h a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitsPerSubkey
    {-# INLINE shiftHash #-}

{-# 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 = Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
{-# INLINE setAtPosition #-}


-- | In-place update version of insert
unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
unsafeInsert :: 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 s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
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 = k -> Bitmap
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 = HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h = if t
ky t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
k
                    then if t
x t -> t -> Bool
forall a. a -> a -> Bool
`ptrEq` t
y
                         then HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap t t
t
                         else HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
                    else HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf t t
l (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
        | Bool
otherwise = Int
-> Bitmap -> t -> t -> Bitmap -> HashMap t t -> ST s (HashMap t t)
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = do
            Array (HashMap t t)
ary' <- Array (HashMap t t)
-> Int -> HashMap t t -> ST s (Array (HashMap t t))
forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap t t)
ary Int
i (HashMap t t -> ST s (Array (HashMap t t)))
-> HashMap t t -> ST s (Array (HashMap t t))
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf t t -> HashMap t t
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
            HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap t t)
ary'
        | Bool
otherwise = do
            HashMap t t
st <- Array (HashMap t t) -> Int -> ST s (HashMap t t)
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 -> Int
nextShift Int
s) HashMap t t
st
            Array (HashMap t t) -> Int -> HashMap t t -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap t t)
ary Int
i HashMap t t
st'
            HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
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 <- Array (HashMap t t) -> Int -> ST s (HashMap t t)
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 -> Int
nextShift Int
s) HashMap t t
st
        Array (HashMap t t) -> Int -> HashMap t t -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap t t)
ary Int
i HashMap t t
st'
        HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = HashMap t t -> ST s (HashMap t t)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (Leaf t t) -> HashMap t t
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h ((t -> t -> (# t #))
-> t -> t -> Array (Leaf t t) -> Array (Leaf t t)
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 (HashMap t t -> ST s (HashMap t t))
-> HashMap t t -> ST s (HashMap t t)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap t t) -> HashMap t t
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (HashMap t t -> Array (HashMap t t)
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 = Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
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 Bitmap -> Bitmap -> Bool
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 -> Int
nextShift Int
s) Bitmap
h1 k
k1 v
v1 Bitmap
h2 HashMap k v
t2
            Array (HashMap k v)
ary <- HashMap k v -> ST s (Array (HashMap k v))
forall a s. a -> ST s (Array a)
A.singletonM HashMap k v
st
            HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap k v) -> HashMap k v
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 <- Int -> HashMap k v -> ST s (MArray s (HashMap k v))
forall a s. Int -> a -> ST s (MArray s a)
A.new Int
2 (HashMap k v -> ST s (MArray s (HashMap k v)))
-> HashMap k v -> ST s (MArray s (HashMap k v))
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k1 v
v1)
            MArray s (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v)
mary Int
idx2 HashMap k v
t2
            Array (HashMap k v)
ary <- MArray s (HashMap k v) -> ST s (Array (HashMap k v))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (HashMap k v)
mary
            HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
bp1 Bitmap -> Bitmap -> Bitmap
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
        !(I# Int#
i1) = Bitmap -> Int -> Int
index Bitmap
h1 Int
s
        !(I# Int#
i2) = Bitmap -> Int -> Int
index Bitmap
h2 Int
s
        idx2 :: Int
idx2 = Int# -> Int
I# (Int#
i1 Int# -> Int# -> Int#
Exts.<# Int#
i2)
        -- This way of computing idx2 saves us a branch compared to the previous approach:
        --
        -- idx2 | index h1 s < index h2 s = 1
        --      | otherwise               = 0
        --
        -- See https://github.com/haskell-unordered-containers/unordered-containers/issues/75#issuecomment-1128419337
{-# 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 = v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
insertModifying v
new (\v
old -> (# v -> v -> v
f v
new v
old #)) k
k HashMap k v
m
{-# INLINE insertWith #-}

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

-- Like insertModifying for arrays; used to implement insertModifying
insertModifyingArr :: Eq k => v -> (v -> (# v #)) -> k -> A.Array (Leaf k v)
                 -> A.Array (Leaf k v)
insertModifyingArr :: 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 (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary0)
  where
    go :: k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go !k
k !Array (Leaf k v)
ary !Int
i !Int
n
          -- Not found, append to the end.
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Array (Leaf k v) -> Leaf k v -> Array (Leaf k v)
forall a. Array a -> a -> Array a
A.snoc Array (Leaf k v)
ary (Leaf k v -> Array (Leaf k v)) -> Leaf k v -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x
        | Bool
otherwise = case Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
y) | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx   -> case v -> (# v #)
f v
y of
                                      (# v
y' #) -> if v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y'
                                                  then Array (Leaf k v)
ary
                                                  else Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
y')
                     | Bool
otherwise -> k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE insertModifyingArr #-}

-- | In-place update version of insertWith
unsafeInsertWith :: forall k v. (Eq k, Hashable k)
                 => (v -> v -> v) -> k -> v -> HashMap k v
                 -> HashMap k v
unsafeInsertWith :: 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 = (k -> v -> v -> (# v #)) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> (# v #)) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWithKey (\k
_ v
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 s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST (Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
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 = k -> Bitmap
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 = HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (k -> v -> Leaf k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h = if k
ky k -> k -> Bool
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 #) -> HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v)
                    else HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
collision Bitmap
h Leaf k v
l (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
        | Bool
otherwise = Int
-> Bitmap -> k -> v -> Bitmap -> HashMap k v -> ST s (HashMap k v)
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = do
            Array (HashMap k v)
ary' <- Array (HashMap k v)
-> Int -> HashMap k v -> ST s (Array (HashMap k v))
forall e s. Array e -> Int -> e -> ST s (Array e)
A.insertM Array (HashMap k v)
ary Int
i (HashMap k v -> ST s (Array (HashMap k v)))
-> HashMap k v -> ST s (Array (HashMap k v))
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m) Array (HashMap k v)
ary'
        | Bool
otherwise = do
            HashMap k v
st <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
            HashMap k v
st' <- Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x (Int -> Int
nextShift Int
s) HashMap k v
st
            Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
            HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
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 <- Array (HashMap k v) -> Int -> ST s (HashMap k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v)
ary Int
i
        HashMap k v
st' <- Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x (Int -> Int
nextShift Int
s) HashMap k v
st
        Array (HashMap k v) -> Int -> HashMap k v -> ST s ()
forall e s. Array e -> Int -> e -> ST s ()
A.unsafeUpdateM Array (HashMap k v)
ary Int
i HashMap k v
st'
        HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h ((k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey k -> v -> v -> (# v #)
f k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Bitmap -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Bitmap
h k
k v
x Int
s (HashMap k v -> ST s (HashMap k v))
-> HashMap k v -> ST s (HashMap k v)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap -> Int -> Bitmap
mask Bitmap
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE unsafeInsertWithKey #-}

-- | \(O(\log n)\) Remove the mapping for the specified key from this map
-- if present.
delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete :: forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete k
k HashMap k v
m = Bitmap -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Bitmap -> k -> HashMap k v -> HashMap k v
delete' (k -> Bitmap
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 = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
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 = HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h Bool -> Bool -> Bool
&& k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k = HashMap k v
forall k v. HashMap k v
Empty
        | Bool
otherwise          = HashMap k v
t
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v
t
        | Bool
otherwise =
            let !st :: HashMap k v
st = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
            in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
                then HashMap k v
t
                else case HashMap k v
st' of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
forall k v. HashMap k v
Empty
                      | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
1) of
                          (Int
0, HashMap k v
_, HashMap k v
l) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int
1, HashMap k v
l, HashMap k v
_) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int, HashMap k v, HashMap k v)
_                               -> HashMap k v
bIndexed
                      | Bool
otherwise -> HashMap k v
bIndexed
                    where
                      bIndexed :: HashMap k v
bIndexed = Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement Bitmap
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: 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   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
        in if HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st
            then HashMap k v
t
            else case HashMap k v
st' of
            HashMap k v
Empty ->
                let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Bitmap
bm   = Bitmap
fullBitmap Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement (Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = 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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy = case k -> Array (Leaf k v) -> Maybe Int
forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k Array (Leaf k v)
v of
            Just Int
i
                | Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                    if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
                    else Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
                | Bool
otherwise -> Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
v Int
i)
            Maybe Int
Nothing -> HashMap k v
t
        | Bool
otherwise = HashMap k v
t
{-# INLINABLE delete' #-}

-- | Delete optimized for the case when we know the key is in the map.
--
-- It is only valid to call this when the key exists in the map and you know the
-- hash collision position if there was one. This information can be obtained
-- from 'lookupRecordCollision'. If there is no collision, pass (-1) as collPos.
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 = Int -> Bitmap -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
go Int
collPos0 Bitmap
h0 k
k0 HashMap k v
m0
  where
    go :: Int -> Word -> k -> HashMap k v -> HashMap k v
    go :: forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
go !Int
_collPos !Bitmap
_shiftedHash !k
_k (Leaf Bitmap
_ Leaf k v
_) = HashMap k v
forall k v. HashMap k v
Empty
    go Int
collPos Bitmap
shiftedHash k
k (BitmapIndexed Bitmap
b Array (HashMap k v)
ary) =
            let !st :: HashMap k v
st = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                !st' :: HashMap k v
st' = Int -> Bitmap -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
go Int
collPos (Bitmap -> Bitmap
forall {a}. Bits a => a -> a
shiftHash Bitmap
shiftedHash) k
k HashMap k v
st
            in case HashMap k v
st' of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
forall k v. HashMap k v
Empty
                      | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
                          case (Int
i, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0, Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
1) of
                          (Int
0, HashMap k v
_, HashMap k v
l) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int
1, HashMap k v
l, HashMap k v
_) | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l -> HashMap k v
l
                          (Int, HashMap k v, HashMap k v)
_                               -> HashMap k v
bIndexed
                      | Bool
otherwise -> HashMap k v
bIndexed
                    where
                      bIndexed :: HashMap k v
bIndexed = Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement Bitmap
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i)
                HashMap k v
l | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
l
                HashMap k v
_ -> Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where m :: Bitmap
m = Bitmap -> Bitmap
mask' Bitmap
shiftedHash
            i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
b Bitmap
m
    go Int
collPos Bitmap
shiftedHash k
k (Full Array (HashMap k v)
ary) =
        let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st' = Int -> Bitmap -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
go Int
collPos (Bitmap -> Bitmap
forall {a}. Bits a => a -> a
shiftHash Bitmap
shiftedHash) k
k HashMap k v
st
        in case HashMap k v
st' of
            HashMap k v
Empty ->
                let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary Int
i
                    bm :: Bitmap
bm   = Bitmap
fullBitmap Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement (Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bm Array (HashMap k v)
ary'
            HashMap k v
_ -> Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Bitmap -> Int
index' Bitmap
shiftedHash
    go Int
collPos Bitmap
_shiftedHash k
_k (Collision Bitmap
h Array (Leaf k v)
v)
      | Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
      = if Int
collPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
1)
        else Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
v Int
0)
      | Bool
otherwise = Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
v Int
collPos)
    go !Int
_ !Bitmap
_ !k
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty -- error "Internal error: deleteKeyExists empty"

    -- Customized version of 'index' that doesn't require a 'Shift'.
    index' :: Hash -> Int
    index' :: Bitmap -> Int
index' Bitmap
w = Bitmap -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitmap -> Int) -> Bitmap -> Int
forall a b. (a -> b) -> a -> b
$ Bitmap
w Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
subkeyMask
    {-# INLINE index' #-}

    -- Customized version of 'mask' that doesn't require a 'Shift'.
    mask' :: Word -> Bitmap
    mask' :: Bitmap -> Bitmap
mask' Bitmap
w = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Bitmap -> Int
index' Bitmap
w
    {-# INLINE mask' #-}

    shiftHash :: a -> a
shiftHash a
h = a
h a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitsPerSubkey
    {-# INLINE shiftHash #-}

{-# 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 = (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# (\v
v -> (# v -> v
f v
v #)) k
k HashMap k v
m
{-# INLINE adjust #-}

-- | Much like 'adjust', but not inherently leaky.
adjust# :: (Eq k, Hashable k) => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# :: 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 = k -> Bitmap
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 = HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h Bool -> Bool -> Bool
&& k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k = case v -> (# v #)
f v
y of
            (# v
y' #) | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y' -> HashMap k v
t
                     | Bool
otherwise -> Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
y')
        | Bool
otherwise          = HashMap k v
t
    go Bitmap
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Bitmap
b Array (HashMap k v)
ary)
        | Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v
t
        | Bool
otherwise = let !st :: HashMap k v
st   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
                          !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
                          ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
                      in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
                         then HashMap k v
t
                         else Bitmap -> Array (HashMap k v) -> HashMap k v
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   = Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i
            !st' :: HashMap k v
st'  = Bitmap -> k -> Int -> HashMap k v -> HashMap k v
go Bitmap
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
            ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
update32 Array (HashMap k v)
ary Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
st'
        in if HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
ptrEq HashMap k v
st HashMap k v
st'
           then HashMap k v
t
           else Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Bitmap
h k
k Int
_ t :: HashMap k v
t@(Collision Bitmap
hy Array (Leaf k v)
v)
        | Bitmap
h Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
hy   = let !v' :: Array (Leaf k v)
v' = (v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(v -> (# v #)) -> k -> Array (Leaf k v) -> Array (Leaf k v)
updateWith# v -> (# v #)
f k
k Array (Leaf k v)
v
                      in if Array (Leaf k v) -> Array (Leaf k v) -> Bool
forall a b. Array a -> Array b -> Bool
A.unsafeSameArray Array (Leaf k v)
v Array (Leaf k v)
v'
                         then HashMap k v
t
                         else Bitmap -> Array (Leaf k v) -> HashMap k v
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 = (Maybe a -> Maybe a) -> k -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
alter (Maybe a -> (a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
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 =
    let !h :: Bitmap
h = k -> Bitmap
forall a. Hashable a => a -> Bitmap
hash k
k
        !lookupRes :: LookupRes v
lookupRes = Bitmap -> k -> HashMap k v -> LookupRes v
forall k v. Eq k => Bitmap -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Bitmap
h k
k HashMap k v
m
    in case Maybe v -> Maybe v
f (LookupRes v -> Maybe v
forall a. LookupRes a -> Maybe a
lookupResToMaybe LookupRes v
lookupRes) of
        Maybe v
Nothing -> case LookupRes v
lookupRes of
            LookupRes v
Absent            -> HashMap k v
m
            Present v
_ Int
collPos -> Int -> Bitmap -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Bitmap -> k -> HashMap k v -> HashMap k v
deleteKeyExists Int
collPos Bitmap
h k
k HashMap k v
m
        Just v
v' -> case LookupRes v
lookupRes of
            LookupRes v
Absent            -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
forall k v. Bitmap -> k -> v -> HashMap k v -> HashMap k v
insertNewKey Bitmap
h k
k v
v' HashMap k v
m
            Present v
v Int
collPos ->
                if v
v v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
v'
                    then HashMap k v
m
                    else Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
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
{-# 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 = k -> Bitmap
forall a. Hashable a => a -> Bitmap
hash k
k
    mv :: Maybe v
mv = Bitmap -> k -> HashMap k v -> Maybe v
forall k v. Eq k => Bitmap -> k -> HashMap k v -> Maybe v
lookup' Bitmap
h k
k HashMap k v
m
  in ((Maybe v -> HashMap k v) -> f (Maybe v) -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f Maybe v
mv) ((Maybe v -> HashMap k v) -> f (HashMap k v))
-> (Maybe v -> HashMap k v) -> f (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \case
    Maybe v
Nothing -> HashMap k v -> (v -> HashMap k v) -> Maybe v -> HashMap k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k v
m (HashMap k v -> v -> HashMap k v
forall a b. a -> b -> a
const (Bitmap -> k -> HashMap k v -> HashMap k v
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' -> Bitmap -> k -> v -> HashMap k v -> HashMap k 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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.HashMap.alterF internal error: hit test_bottom"

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

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

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

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

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

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

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

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

-- | This is the default version of alterF that we use in most non-trivial
-- cases. It's called "eager" because it looks up the given key in the map
-- eagerly, whether or not the given function requires that information.
alterFEager :: (Functor f, Eq k, Hashable k)
       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFEager :: 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 = ((Maybe v -> HashMap k v) -> f (Maybe v) -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f Maybe v
mv) ((Maybe v -> HashMap k v) -> f (HashMap k v))
-> (Maybe v -> HashMap k v) -> f (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \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 -> Int -> Bitmap -> k -> HashMap k v -> HashMap k v
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 -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
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 v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
v'
        -- If the value is identical, no-op
        then HashMap k v
m
        -- If the value changed, update the value.
        else Int -> Bitmap -> k -> v -> HashMap k v -> HashMap k v
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 = k -> Bitmap
forall a. Hashable a => a -> Bitmap
hash k
k
        !lookupRes :: LookupRes v
lookupRes = Bitmap -> k -> HashMap k v -> LookupRes v
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 = LookupRes v -> Maybe v
forall a. LookupRes a -> Maybe a
lookupResToMaybe LookupRes v
lookupRes
{-# 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 = ((v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool)
-> (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall a. a -> a
Exts.inline (v -> v -> Bool) -> HashMap k v -> HashMap k v -> Bool
forall k v1 v2.
(Eq k, Hashable k) =>
(v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
isSubmapOfBy v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINABLE isSubmapOf #-}

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

    -- In this case, we only need to check the entries in ls2 with the hash h1.
    go Int
s t1 :: HashMap k v1
t1@(Collision Bitmap
h1 Array (Leaf k v1)
_) (BitmapIndexed Bitmap
b Array (HashMap k v2)
ls2)
        | Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = Bool
False
        | Bool
otherwise    =
            Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ls2 (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 -> Int
nextShift Int
s) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ls2 (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) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Bitmap
-> Array (HashMap k v1)
-> Bitmap
-> Array (HashMap k v2)
-> Bool
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 -> Int
nextShift Int
s)) 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) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Bitmap
-> Array (HashMap k v1)
-> Bitmap
-> Array (HashMap k v2)
-> Bool
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 -> Int
nextShift Int
s)) Bitmap
b1 Array (HashMap k v1)
ls1 Bitmap
fullBitmap Array (HashMap k v2)
ls2
    go Int
s (Full Array (HashMap k v1)
ls1) (Full Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Bitmap
-> Array (HashMap k v1)
-> Bitmap
-> Array (HashMap k v2)
-> Bool
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 -> Int
nextShift Int
s)) Bitmap
fullBitmap Array (HashMap k v1)
ls1 Bitmap
fullBitmap 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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
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 Bitmap -> Bitmap -> Bool
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitmap
0 = HashMap k v1 -> HashMap k v2 -> Bool
comp (Array (HashMap k v1) -> Int -> HashMap k v1
forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary1 Int
i) (Array (HashMap k v2) -> Int -> HashMap k v2
forall a. Array a -> Int -> a
A.index Array (HashMap k v2)
ary2 Int
j) Bool -> Bool -> Bool
&&
                             Int -> Int -> Bitmap -> Bool
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Bitmap
m Bitmap -> Int -> Bitmap
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitmap
0 = Int -> Int -> Bitmap -> Bool
go Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Bitmap
m Bitmap -> Int -> Bitmap
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 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)

    b1Andb2 :: Bitmap
b1Andb2 = Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
b2
    b1Orb2 :: Bitmap
b1Orb2  = Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    subsetBitmaps :: Bool
subsetBitmaps = Bitmap
b1Orb2 Bitmap -> Bitmap -> Bool
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 => HashMap k v -> HashMap k v -> HashMap k v
union :: forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
union = (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
unionWith v -> v -> v
forall a b. a -> b -> a
const
{-# INLINABLE union #-}

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

-- | \(O(n+m)\) The union of two maps.  If a key occurs in both maps,
-- the provided function (first argument) will be used to compute the
-- result.
unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
          -> HashMap k v
unionWithKey :: forall k v.
Eq 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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = if k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2
                      then Bitmap -> Leaf k v -> HashMap k v
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k1 (k -> v -> v -> v
f k
k1 v
v1 v
v2))
                      else Bitmap -> Leaf k v -> Leaf k v -> HashMap k v
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 = Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 ((k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey (\k
k v
a v
b -> (# k -> v -> v -> v
f k
k v
a v
b #)) k
k1 v
v1 Array (Leaf k v)
ls2)
        | Bool
otherwise = Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 ((k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWithKey (\k
k v
a v
b -> (# k -> v -> v -> v
f k
k v
b v
a #)) k
k2 v
v2 Array (Leaf k v)
ls1)
        | Bool
otherwise = Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2  = Bitmap -> Array (Leaf k v) -> HashMap k v
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 ((k -> v -> v -> (# v #))
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(k -> v -> v -> (# v #))
-> Array (Leaf k v) -> Array (Leaf k v) -> Array (Leaf k v)
updateOrConcatWithKey (\k
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 = Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
b2
            ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Bitmap
-> Bitmap
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
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 -> Int
nextShift Int
s)) Bitmap
b1 Bitmap
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Bitmap -> Array (HashMap k v) -> HashMap k v
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' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Bitmap
-> Bitmap
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
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 -> Int
nextShift Int
s)) Bitmap
b1 Bitmap
fullBitmap Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s (Full Array (HashMap k v)
ary1) (BitmapIndexed Bitmap
b2 Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Bitmap
-> Bitmap
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
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 -> Int
nextShift Int
s)) Bitmap
fullBitmap Bitmap
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s (Full Array (HashMap k v)
ary1) (Full Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Bitmap
-> Bitmap
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
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 -> Int
nextShift Int
s)) Bitmap
fullBitmap Bitmap
fullBitmap
                   Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    -- leaf vs. branch
    go Int
s (BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary1) HashMap k v
t2
        | Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m2 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary1 Int
i HashMap k v
t2
                               b' :: Bitmap
b'   = Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m2
                           in Bitmap -> Array (HashMap k v) -> HashMap k v
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' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary1 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s) HashMap k v
st1 HashMap k v
t2
                           in Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b1 Array (HashMap k v)
ary'
        where
          h2 :: Bitmap
h2 = HashMap k v -> Bitmap
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = let ary' :: Array (HashMap k v)
ary' = Array (HashMap k v) -> Int -> HashMap k v -> Array (HashMap k v)
forall e. Array e -> Int -> e -> Array e
A.insert Array (HashMap k v)
ary2 Int
i (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! HashMap k v
t1
                               b' :: Bitmap
b'   = Bitmap
b2 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m1
                           in Bitmap -> Array (HashMap k v) -> HashMap k v
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' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
A.updateWith' Array (HashMap k v)
ary2 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 ->
                                   Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s) HashMap k v
t1 HashMap k v
st2
                           in Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b2 Array (HashMap k v)
ary'
      where
        h1 :: Bitmap
h1 = HashMap k v -> Bitmap
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   = HashMap k v -> Bitmap
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' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
update32With' Array (HashMap k v)
ary1 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st1 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s) HashMap k v
st1 HashMap k v
t2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'
    go Int
s HashMap k v
t1 (Full Array (HashMap k v)
ary2) =
        let h1 :: Bitmap
h1   = HashMap k v -> Bitmap
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' = Array (HashMap k v)
-> Int -> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall e. Array e -> Int -> (e -> e) -> Array e
update32With' Array (HashMap k v)
ary2 Int
i ((HashMap k v -> HashMap k v) -> Array (HashMap k v))
-> (HashMap k v -> HashMap k v) -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$ \HashMap k v
st2 -> Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s) HashMap k v
t1 HashMap k v
st2
        in Array (HashMap k v) -> HashMap k v
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v)
ary'

    leafHashCode :: HashMap k v -> Bitmap
leafHashCode (Leaf Bitmap
h Leaf k v
_) = Bitmap
h
    leafHashCode (Collision Bitmap
h Array (Leaf k v)
_) = Bitmap
h
    leafHashCode HashMap k v
_ = [Char] -> Bitmap
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
m2  = Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
m1 (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton (HashMap k v -> Array (HashMap k v))
-> HashMap k v -> Array (HashMap k v)
forall a b. (a -> b) -> a -> b
$! Int
-> Bitmap -> Bitmap -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash (Int -> Int
nextShift Int
s) Bitmap
h1 Bitmap
h2 HashMap k v
t1 HashMap k v
t2)
        | Bitmap
m1 Bitmap -> Bitmap -> Bool
forall a. Ord a => a -> a -> Bool
<  Bitmap
m2  = Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
m1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m2) (HashMap k v -> HashMap k v -> Array (HashMap k v)
forall a. a -> a -> Array a
A.pair HashMap k v
t1 HashMap k v
t2)
        | Bool
otherwise = Bitmap -> Array (HashMap k v) -> HashMap k v
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Bitmap
m1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m2) (HashMap k v -> HashMap k v -> Array (HashMap k v)
forall a. a -> a -> Array a
A.pair HashMap k v
t2 HashMap k v
t1)
      where
        m1 :: 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 s. ST s (MArray s a)) -> Array a
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s a)) -> Array a)
-> (forall s. ST s (MArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
    let bCombined :: Bitmap
bCombined = Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    MArray s a
mary <- Int -> ST s (MArray s a)
forall s a. Int -> ST s (MArray s a)
A.new_ (Bitmap -> Int
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bitmap -> Bool
testBit (Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
b2) = do
                a
x1 <- Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                a
x2 <- Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$! a -> a -> a
f a
x1 a
x2
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bitmap
b'
            | Bitmap -> Bool
testBit Bitmap
b1 = do
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> ST s a -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
i2 Bitmap
b'
            | Bool
otherwise = do
                MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
mary Int
i (a -> ST s ()) -> ST s a -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary2 Int
i2
                Int -> Int -> Int -> Bitmap -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
i1 (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bitmap
b'
          where
            m :: Bitmap
m = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Bitmap -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Bitmap
b
            testBit :: Bitmap -> Bool
testBit Bitmap
x = Bitmap
x Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitmap
0
            b' :: Bitmap
b' = Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement Bitmap
m
    Int -> Int -> Int -> Bitmap -> ST s ()
go Int
0 Int
0 Int
0 Bitmap
bCombined
    MArray s a -> ST s (MArray s a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
mary
    -- TODO: For the case where b1 .&. b2 == b1, i.e. when one is a
    -- subset of the other, we could use a slightly simpler algorithm,
    -- where we copy one array, and then update.
{-# INLINE unionArrayBy #-}

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

-- | Construct a set containing all elements from a list of sets.
unions :: Eq k => [HashMap k v] -> HashMap k v
unions :: forall k v. Eq k => [HashMap k v] -> HashMap k v
unions = (HashMap k v -> HashMap k v -> HashMap k v)
-> HashMap k v -> [HashMap k v] -> HashMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' HashMap k v -> HashMap k v -> HashMap k v
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
union HashMap k v
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
  | HashMap b c -> Bool
forall k a. HashMap k a -> Bool
null HashMap b c
bc = HashMap a c
forall k v. HashMap k v
empty
  | Bool
otherwise = (b -> Maybe c) -> HashMap a b -> HashMap a c
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
mapMaybe (HashMap b c
bc HashMap b c -> b -> Maybe c
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 = HashMap k v2
forall k v. HashMap k v
Empty
    go (Leaf Bitmap
h (L k
k v1
v)) = Bitmap -> Leaf k v2 -> HashMap k v2
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Leaf k v2 -> HashMap k v2) -> Leaf k v2 -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (k -> v1 -> v2
f k
k v1
v)
    go (BitmapIndexed Bitmap
b Array (HashMap k v1)
ary) = Bitmap -> Array (HashMap k v2) -> HashMap k v2
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap k v2) -> HashMap k v2)
-> Array (HashMap k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ (HashMap k v1 -> HashMap k v2)
-> Array (HashMap k v1) -> Array (HashMap k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map HashMap k v1 -> HashMap k v2
go Array (HashMap k v1)
ary
    go (Full Array (HashMap k v1)
ary) = Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v2) -> HashMap k v2)
-> Array (HashMap k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ (HashMap k v1 -> HashMap k v2)
-> Array (HashMap k v1) -> Array (HashMap k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map HashMap k v1 -> HashMap k v2
go Array (HashMap k v1)
ary
    -- Why map strictly over collision arrays? Because there's no
    -- point suspending the O(1) work this does for each leaf.
    go (Collision Bitmap
h Array (Leaf k v1)
ary) = Bitmap -> Array (Leaf k v2) -> HashMap k v2
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Array (Leaf k v2) -> HashMap k v2)
-> Array (Leaf k v2) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$
                           (Leaf k v1 -> Leaf k v2) -> Array (Leaf k v1) -> Array (Leaf k v2)
forall a b. (a -> b) -> Array a -> Array b
A.map' (\ (L k
k v1
v) -> k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (k -> v1 -> v2
f k
k v1
v)) Array (Leaf k v1)
ary
{-# INLINE mapWithKey #-}

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

-- | \(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                 = HashMap k v2 -> f (HashMap k v2)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v2
forall k v. HashMap k v
Empty
    go (Leaf Bitmap
h (L k
k v1
v))      = Bitmap -> Leaf k v2 -> HashMap k v2
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h (Leaf k v2 -> HashMap k v2)
-> (v2 -> Leaf k v2) -> v2 -> HashMap k v2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (v2 -> HashMap k v2) -> f v2 -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> f v2
f k
k v1
v
    go (BitmapIndexed Bitmap
b Array (HashMap k v1)
ary) = Bitmap -> Array (HashMap k v2) -> HashMap k v2
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap k v2) -> HashMap k v2)
-> f (Array (HashMap k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap k v1 -> f (HashMap k v2))
-> Array (HashMap k v1) -> f (Array (HashMap k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse HashMap k v1 -> f (HashMap k v2)
go Array (HashMap k v1)
ary
    go (Full Array (HashMap k v1)
ary)            = Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full (Array (HashMap k v2) -> HashMap k v2)
-> f (Array (HashMap k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap k v1 -> f (HashMap k v2))
-> Array (HashMap k v1) -> f (Array (HashMap k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse HashMap k v1 -> f (HashMap k v2)
go Array (HashMap k v1)
ary
    go (Collision Bitmap
h Array (Leaf k v1)
ary)     =
        Bitmap -> Array (Leaf k v2) -> HashMap k v2
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h (Array (Leaf k v2) -> HashMap k v2)
-> f (Array (Leaf k v2)) -> f (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Leaf k v1 -> f (Leaf k v2))
-> Array (Leaf k v1) -> f (Array (Leaf k v2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverse' (\ (L k
k v1
v) -> k -> v2 -> Leaf k v2
forall k v. k -> v -> Leaf k v
L k
k (v2 -> Leaf k v2) -> f v2 -> f (Leaf k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> f v2
f k
k v1
v) Array (Leaf k v1)
ary
{-# INLINE traverseWithKey #-}

-- | \(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 = [(k2, v)] -> HashMap k2 v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(k2, v)] -> HashMap k2 v)
-> (HashMap k1 v -> [(k2, v)]) -> HashMap k1 v -> HashMap k2 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> v -> [(k2, v)] -> [(k2, v)])
-> [(k2, v)] -> HashMap k1 v -> [(k2, v)]
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) (k2, v) -> [(k2, v)] -> [(k2, v)]
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 = (HashMap k v -> k -> v -> HashMap k v)
-> HashMap k v -> HashMap k v -> HashMap k v
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go HashMap k v
forall k v. HashMap k v
empty HashMap k v
a
  where
    go :: HashMap k v -> k -> v -> HashMap k v
go HashMap k v
m k
k v
v = case k -> HashMap k w -> Maybe w
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
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 = (HashMap k v -> k -> v -> HashMap k v)
-> HashMap k v -> HashMap k v -> HashMap k v
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' HashMap k v -> k -> v -> HashMap k v
go HashMap k v
forall k v. HashMap k v
empty HashMap k v
a
  where
    go :: HashMap k v -> k -> v -> HashMap k v
go HashMap k v
m k
k v
v = case k -> HashMap k w -> Maybe w
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup k
k HashMap k w
b of
                 Maybe w
Nothing -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
unsafeInsert k
k v
v HashMap k v
m
                 Just w
w  -> HashMap k v -> (v -> HashMap k v) -> Maybe v -> HashMap k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap k v
m (\v
y -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
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 => HashMap k v -> HashMap k w -> HashMap k v
intersection :: forall k v w. Eq k => HashMap k v -> HashMap k w -> HashMap k v
intersection = ((v -> w -> v) -> HashMap k v -> HashMap k w -> HashMap k v)
-> (v -> w -> v) -> HashMap k v -> HashMap k w -> HashMap k v
forall a. a -> a
Exts.inline (v -> w -> v) -> HashMap k v -> HashMap k w -> HashMap k v
forall k v1 v2 v3.
Eq k =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith v -> w -> v
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 => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith :: forall k v1 v2 v3.
Eq k =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
intersectionWith v1 -> v2 -> v3
f = ((k -> v1 -> v2 -> v3)
 -> HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> (k -> v1 -> v2 -> v3)
-> HashMap k v1
-> HashMap k v2
-> HashMap k v3
forall a. a -> a
Exts.inline (k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
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)
 -> HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> (k -> v1 -> v2 -> v3)
-> HashMap k v1
-> HashMap k v2
-> HashMap k v3
forall a b. (a -> b) -> a -> b
$ (v1 -> v2 -> v3) -> k -> v1 -> v2 -> v3
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 => (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 = (k -> v1 -> v2 -> (# v3 #))
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
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 #))
 -> HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> (k -> v1 -> v2 -> (# v3 #))
-> HashMap k v1
-> HashMap k v2
-> HashMap k v3
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 = HashMap k v3
forall k v. HashMap k v
Empty
    go Int
_ HashMap k v1
Empty HashMap k v2
_ = HashMap k v3
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 =
      ((# #) -> HashMap k v3)
-> (v2 -> Int -> HashMap k v3)
-> Bitmap
-> k
-> Int
-> HashMap k v2
-> HashMap k v3
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Bitmap -> k -> Int -> HashMap k v -> r
lookupCont
        (\(# #)
_ -> HashMap k v3
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' #) -> Bitmap -> Leaf k v3 -> HashMap k v3
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (Leaf k v3 -> HashMap k v3) -> Leaf k v3 -> HashMap k v3
forall a b. (a -> b) -> a -> b
$ k -> v3 -> Leaf k v3
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)) =
      ((# #) -> HashMap k v3)
-> (v1 -> Int -> HashMap k v3)
-> Bitmap
-> k
-> Int
-> HashMap k v1
-> HashMap k v3
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Bitmap -> k -> Int -> HashMap k v -> r
lookupCont
        (\(# #)
_ -> HashMap k v3
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' #) -> Bitmap -> Leaf k v3 -> HashMap k v3
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h2 (Leaf k v3 -> HashMap k v3) -> Leaf k v3 -> HashMap k v3
forall a b. (a -> b) -> a -> b
$ k -> v3 -> Leaf k v3
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) = (k -> v1 -> v2 -> (# v3 #))
-> Bitmap
-> Bitmap
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
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) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
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 -> Int
nextShift Int
s)) 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) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
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 -> Int
nextShift Int
s)) Bitmap
b1 Bitmap
fullBitmap 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) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
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 -> Int
nextShift Int
s)) Bitmap
fullBitmap 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) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Bitmap
-> Bitmap
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
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 -> Int
nextShift Int
s)) Bitmap
fullBitmap Bitmap
fullBitmap 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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m2 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v3
forall k v. HashMap k v
Empty
      | Bool
otherwise = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) (Array (HashMap k v1) -> Int -> HashMap k v1
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m1 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v3
forall k v. HashMap k v
Empty
      | Bool
otherwise = Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
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 -> Int
nextShift Int
s) (Array (HashMap k v1) -> Int -> HashMap k v1
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 -> Int
nextShift Int
s) HashMap k v1
t1 (Array (HashMap k v2) -> Int -> HashMap k v2
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
b2 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = HashMap k v3
forall k v. HashMap k v
Empty
  | Bool
otherwise = (forall s. ST s (HashMap k v3)) -> HashMap k v3
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v3)) -> HashMap k v3)
-> (forall s. ST s (HashMap k v3)) -> HashMap k v3
forall a b. (a -> b) -> a -> b
$ do
    MArray s (HashMap k v3)
mary <- Int -> ST s (MArray s (HashMap k v3))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int -> ST s (MArray s (HashMap k v3)))
-> Int -> ST s (MArray s (HashMap k v3))
forall a b. (a -> b) -> a -> b
$ Bitmap -> Int
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = (Int, Bitmap) -> ST s (Int, Bitmap)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, Bitmap
bFinal)
          | Bitmap -> Bool
testBit (Bitmap -> Bool) -> Bitmap -> Bool
forall a b. (a -> b) -> a -> b
$ Bitmap
b1 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
b2 = do
            HashMap k v1
x1 <- Array (HashMap k v1) -> Int -> ST s (HashMap k v1)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k v1)
ary1 Int
i1
            HashMap k v2
x2 <- Array (HashMap k v2) -> Int -> ST s (HashMap k v2)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bitmap
b' (Bitmap
bFinal Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement Bitmap
m)
              HashMap k v3
_ -> do
                MArray s (HashMap k v3) -> Int -> HashMap k v3 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v3)
mary Int
i (HashMap k v3 -> ST s ()) -> HashMap k v3 -> ST s ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
i2 Int -> Int -> Int
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 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bitmap
b' Bitmap
bFinal
          where
            m :: Bitmap
m = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Bitmap -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Bitmap
b
            testBit :: Bitmap -> Bool
testBit Bitmap
x = Bitmap
x Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitmap
0
            b' :: Bitmap
b' = Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
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 -> HashMap k v3 -> ST s (HashMap k v3)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v3
forall k v. HashMap k v
Empty
      Int
1 -> do
        HashMap k v3
l <- MArray s (HashMap k v3) -> Int -> ST s (HashMap k v3)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v3)
mary Int
0
        if HashMap k v3 -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v3
l
          then HashMap k v3 -> ST s (HashMap k v3)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v3
l
          else Bitmap -> Array (HashMap k v3) -> HashMap k v3
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
bFinal (Array (HashMap k v3) -> HashMap k v3)
-> ST s (Array (HashMap k v3)) -> ST s (HashMap k v3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MArray s (HashMap k v3) -> ST s (Array (HashMap k v3))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (HashMap k v3) -> ST s (Array (HashMap k v3)))
-> ST s (MArray s (HashMap k v3)) -> ST s (Array (HashMap k v3))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v3) -> Int -> ST s (MArray s (HashMap k v3))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v3)
mary Int
1)
      Int
_ -> Bitmap -> Array (HashMap k v3) -> HashMap k v3
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Bitmap
bFinal (Array (HashMap k v3) -> HashMap k v3)
-> ST s (Array (HashMap k v3)) -> ST s (HashMap k v3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MArray s (HashMap k v3) -> ST s (Array (HashMap k v3))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (HashMap k v3) -> ST s (Array (HashMap k v3)))
-> ST s (MArray s (HashMap k v3)) -> ST s (Array (HashMap k v3))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v3) -> Int -> ST s (MArray s (HashMap k v3))
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
b2
    bIntersect :: Bitmap
bIntersect = Bitmap
b1 Bitmap -> Bitmap -> Bitmap
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 Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
h2 = (forall s. ST s (HashMap k v3)) -> HashMap k v3
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v3)) -> HashMap k v3)
-> (forall s. ST s (HashMap k v3)) -> HashMap k v3
forall a b. (a -> b) -> a -> b
$ do
    MArray s (Leaf k v2)
mary2 <- Array (Leaf k v2) -> Int -> Int -> ST s (MArray s (Leaf k v2))
forall e s. Array e -> Int -> Int -> ST s (MArray s e)
A.thaw Array (Leaf k v2)
ary2 Int
0 (Int -> ST s (MArray s (Leaf k v2)))
-> Int -> ST s (MArray s (Leaf k v2))
forall a b. (a -> b) -> a -> b
$ Array (Leaf k v2) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2
    MArray s (Leaf k v3)
mary <- Int -> ST s (MArray s (Leaf k v3))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int -> ST s (MArray s (Leaf k v3)))
-> Int -> ST s (MArray s (Leaf k v3))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1) (Array (Leaf k v2) -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1 Bool -> Bool -> Bool
|| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= MArray s (Leaf k v2) -> Int
forall s a. MArray s a -> Int
A.lengthM MArray s (Leaf k v2)
mary2 = Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
j
          | Bool
otherwise = do
            L k
k1 v1
v1 <- Array (Leaf k v1) -> Int -> ST s (Leaf k v1)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v1)
ary1 Int
i
            k -> Int -> MArray s (Leaf k v2) -> ST s (Maybe (Leaf k v2))
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 ST s (Maybe (Leaf k v2))
-> (Maybe (Leaf k v2) -> ST s Int) -> ST s Int
forall a b. ST s a -> (a -> ST s b) -> ST s b
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
                MArray s (Leaf k v3) -> Int -> Leaf k v3 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v3)
mary Int
j (Leaf k v3 -> ST s ()) -> Leaf k v3 -> ST s ()
forall a b. (a -> b) -> a -> b
$ k -> v3 -> Leaf k v3
forall k v. k -> v -> Leaf k v
L k
k1 v3
v3
                Int -> Int -> ST s Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Maybe (Leaf k v2)
Nothing -> do
                Int -> Int -> ST s Int
go (Int
i Int -> Int -> Int
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 -> HashMap k v3 -> ST s (HashMap k v3)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v3
forall k v. HashMap k v
Empty
      Int
1 -> Bitmap -> Leaf k v3 -> HashMap k v3
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h1 (Leaf k v3 -> HashMap k v3)
-> ST s (Leaf k v3) -> ST s (HashMap k v3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MArray s (Leaf k v3) -> Int -> ST s (Leaf k v3)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v3)
mary Int
0
      Int
_ -> Bitmap -> Array (Leaf k v3) -> HashMap k v3
forall k v. Bitmap -> Array (Leaf k v) -> HashMap k v
Collision Bitmap
h1 (Array (Leaf k v3) -> HashMap k v3)
-> ST s (Array (Leaf k v3)) -> ST s (HashMap k v3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MArray s (Leaf k v3) -> ST s (Array (Leaf k v3))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (Leaf k v3) -> ST s (Array (Leaf k v3)))
-> ST s (MArray s (Leaf k v3)) -> ST s (Array (Leaf k v3))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (Leaf k v3) -> Int -> ST s (MArray s (Leaf k v3))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (Leaf k v3)
mary Int
len)
  | Bool
otherwise = HashMap k v3
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 = Int -> k -> Int -> MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= MArray s (Leaf t v) -> Int
forall s a. MArray s a -> Int
A.lengthM MArray s (Leaf t v)
mary = Maybe (Leaf t v) -> ST s (Maybe (Leaf t v))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Leaf t v)
forall a. Maybe a
Nothing
      | Bool
otherwise = do
        l :: Leaf t v
l@(L t
k' v
_v) <- MArray s (Leaf t v) -> Int -> ST s (Leaf t v)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf t v)
mary Int
i
        if t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
k'
          then do
            MArray s (Leaf t v) -> Int -> Leaf t v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf t v)
mary Int
i (Leaf t v -> ST s ()) -> ST s (Leaf t v) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (Leaf t v) -> Int -> ST s (Leaf t v)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf t v)
mary Int
i0
            Maybe (Leaf t v) -> ST s (Maybe (Leaf t v))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Leaf t v) -> ST s (Maybe (Leaf t v)))
-> Maybe (Leaf t v) -> ST s (Maybe (Leaf t v))
forall a b. (a -> b) -> a -> b
$ Leaf t v -> Maybe (Leaf t v)
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 Int -> Int -> Int
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 = (a -> k -> v -> a) -> a -> HashMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey' (\ a
z k
_ v
v -> a -> v -> a
f a
z v
v)
{-# INLINE foldl' #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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


-- | Common implementation for 'filterWithKey' and 'mapMaybeWithKey',
--   allowing the former to former to reuse terms.
filterMapAux :: forall k v1 v2
              . (HashMap k v1 -> Maybe (HashMap k v2))
             -> (Leaf k v1 -> Maybe (Leaf k v2))
             -> HashMap k v1
             -> HashMap k v2
filterMapAux :: 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 = HashMap k v2
forall k v. HashMap k v
Empty
    go t :: HashMap k v1
t@Leaf{}
        | Just HashMap k v2
t' <- HashMap k v1 -> Maybe (HashMap k v2)
onLeaf HashMap k v1
t = HashMap k v2
t'
        | Bool
otherwise = HashMap k v2
forall k v. HashMap k v
Empty
    go (BitmapIndexed 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
fullBitmap
    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 = Array (HashMap k v1) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v1)
ary0
        in (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v2)) -> HashMap k v2)
-> (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ do
            MArray s (HashMap k v2)
mary <- Int -> ST s (MArray s (HashMap k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Bitmap
-> Int
-> Int
-> Bitmap
-> Int
-> ST s (HashMap k v2)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = case Int
j of
                Int
0 -> HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
forall k v. HashMap k v
Empty
                Int
1 -> do
                    HashMap k v2
ch <- MArray s (HashMap k v2) -> Int -> ST s (HashMap k v2)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v2)
mary Int
0
                    case HashMap k v2
ch of
                      HashMap k v2
t | HashMap k v2 -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v2
t -> HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
t
                      HashMap k v2
_                       -> Bitmap -> Array (HashMap k v2) -> HashMap k v2
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b (Array (HashMap k v2) -> HashMap k v2)
-> ST s (Array (HashMap k v2)) -> ST s (HashMap k v2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MArray s (HashMap k v2) -> ST s (Array (HashMap k v2))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (HashMap k v2) -> ST s (Array (HashMap k v2)))
-> ST s (MArray s (HashMap k v2)) -> ST s (Array (HashMap k v2))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v2) -> Int -> ST s (MArray s (HashMap k v2))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v2)
mary Int
1)
                Int
_ -> do
                    Array (HashMap k v2)
ary2 <- MArray s (HashMap k v2) -> ST s (Array (HashMap k v2))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (HashMap k v2) -> ST s (Array (HashMap k v2)))
-> ST s (MArray s (HashMap k v2)) -> ST s (Array (HashMap k v2))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v2) -> Int -> ST s (MArray s (HashMap k v2))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v2)
mary Int
j
                    HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxChildren
                              then Array (HashMap k v2) -> HashMap k v2
forall k v. Array (HashMap k v) -> HashMap k v
Full Array (HashMap k v2)
ary2
                              else Bitmap -> Array (HashMap k v2) -> HashMap k v2
forall k v. Bitmap -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Bitmap
b Array (HashMap k v2)
ary2
            | Bitmap
bi Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
b Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Bitmap
-> Int
-> Int
-> Bitmap
-> Int
-> ST s (HashMap k v2)
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 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int
n
            | Bool
otherwise = case HashMap k v1 -> HashMap k v2
go (Array (HashMap k v1) -> Int -> HashMap k v1
forall a. Array a -> Int -> a
A.index Array (HashMap k v1)
ary Int
i) of
                HashMap k v2
Empty -> Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Bitmap
-> Int
-> Int
-> Bitmap
-> Int
-> ST s (HashMap k v2)
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 Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap -> Bitmap
forall {a}. Bits a => a -> a
complement Bitmap
bi) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j
                         (Bitmap
bi Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int
n
                HashMap k v2
t     -> do MArray s (HashMap k v2) -> Int -> HashMap k v2 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (HashMap k v2)
mary Int
j HashMap k v2
t
                            Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Bitmap
-> Int
-> Int
-> Bitmap
-> Int
-> ST s (HashMap k v2)
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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Bitmap
bi Bitmap -> Int -> Bitmap
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 = Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary0
        in (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v2)) -> HashMap k v2)
-> (forall s. ST s (HashMap k v2)) -> HashMap k v2
forall a b. (a -> b) -> a -> b
$ do
            MArray s (Leaf k v2)
mary <- Int -> ST s (MArray s (Leaf k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary0 MArray s (Leaf k v2)
mary Int
0 Int
0 Int
n
      where
        step :: A.Array (Leaf k v1) -> A.MArray s (Leaf k v2)
             -> Int -> Int -> Int
             -> ST s (HashMap k v2)
        step :: 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = case Int
j of
                Int
0 -> HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v2
forall k v. HashMap k v
Empty
                Int
1 -> do Leaf k v2
l <- MArray s (Leaf k v2) -> Int -> ST s (Leaf k v2)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v2)
mary Int
0
                        HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Leaf k v2 -> HashMap k v2
forall k v. Bitmap -> Leaf k v -> HashMap k v
Leaf Bitmap
h Leaf k v2
l
                Int
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> do Array (Leaf k v2)
ary2 <- MArray s (Leaf k v2) -> ST s (Array (Leaf k v2))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s (Leaf k v2)
mary
                                 HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (Leaf k v2) -> HashMap k v2
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 <- MArray s (Leaf k v2) -> ST s (Array (Leaf k v2))
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze (MArray s (Leaf k v2) -> ST s (Array (Leaf k v2)))
-> ST s (MArray s (Leaf k v2)) -> ST s (Array (Leaf k v2))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (Leaf k v2) -> Int -> ST s (MArray s (Leaf k v2))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (Leaf k v2)
mary Int
j
                                    HashMap k v2 -> ST s (HashMap k v2)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v2 -> ST s (HashMap k v2))
-> HashMap k v2 -> ST s (HashMap k v2)
forall a b. (a -> b) -> a -> b
$! Bitmap -> Array (Leaf k v2) -> HashMap k v2
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 (Leaf k v1 -> Maybe (Leaf k v2)) -> Leaf k v1 -> Maybe (Leaf k v2)
forall a b. (a -> b) -> a -> b
$! Array (Leaf k v1) -> Int -> Leaf k v1
forall a. Array a -> Int -> a
A.index Array (Leaf k v1)
ary Int
i
                = MArray s (Leaf k v2) -> Int -> Leaf k v2 -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v2)
mary Int
j Leaf k v2
el ST s () -> ST s (HashMap k v2) -> ST s (HashMap k v2)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary MArray s (Leaf k v2)
mary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
            | Bool
otherwise = Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
forall s.
Array (Leaf k v1)
-> MArray s (Leaf k v2) -> Int -> Int -> Int -> ST s (HashMap k v2)
step Array (Leaf k v1)
ary MArray s (Leaf k v2)
mary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j Int
n
{-# INLINE filterMapAux #-}

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

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

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

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

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

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

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

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

-- | \(O(n \log n)\) Construct a map from a list of elements.  Uses
-- the provided function @f@ to merge duplicate entries with
-- @(f newVal oldVal)@.
--
-- === Examples
--
-- Given a list @xs@, create a map with the number of occurrences of each
-- element in @xs@:
--
-- > let xs = ['a', 'b', 'a']
-- > in fromListWith (+) [ (x, 1) | x <- xs ]
-- >
-- > = fromList [('a', 2), ('b', 1)]
--
-- Given a list of key-value pairs @xs :: [(k, v)]@, group all values by their
-- keys and return a @HashMap k [v]@.
--
-- > let xs = [('a', 1), ('b', 2), ('a', 3)]
-- > in fromListWith (++) [ (k, [v]) | (k, v) <- xs ]
-- >
-- > = fromList [('a', [3, 1]), ('b', [2])]
--
-- Note that the lists in the resulting map contain elements in reverse order
-- from their occurrences 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 = (HashMap k v -> (k, v) -> HashMap k v)
-> HashMap k v -> [(k, v)] -> HashMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ HashMap k v
m (k
k, v
v) -> (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
unsafeInsertWith v -> v -> v
f k
k v
v HashMap k v
m) HashMap k v
forall k v. HashMap k v
empty
{-# INLINE fromListWith #-}

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

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

-- | \(O(n)\) Look up the value associated with the given key in an
-- array.
lookupInArrayCont ::
  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 = k -> Array (Leaf k v) -> Int -> Int -> r
Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go k
k0 Array (Leaf k v)
ary0 Int
0 (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary0)
  where
    go :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
    go :: Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go !k
k !Array (Leaf k v)
ary !Int
i !Int
n
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = (# #) -> r
absent (# #)
        | Bool
otherwise = case Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
v)
                | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx   -> v -> Int -> r
present v
v Int
i
                | Bool
otherwise -> k -> Array (Leaf k v) -> Int -> Int -> r
Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
go k
k Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE lookupInArrayCont #-}

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

updateWith# :: Eq k => (v -> (# v #)) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
updateWith# :: 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 (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary0)
  where
    go :: k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go !k
k !Array (Leaf k v)
ary !Int
i !Int
n
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = Array (Leaf k v)
ary
        | Bool
otherwise = case Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i of
            (L k
kx v
y) | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx -> case v -> (# v #)
f v
y of
                          (# v
y' #)
                             | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
y v
y' -> Array (Leaf k v)
ary
                             | Bool
otherwise -> Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
y')
                     | Bool
otherwise -> k -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINABLE updateWith# #-}

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

updateOrSnocWithKey :: Eq k => (k -> v -> v -> (# v #)) -> k -> v -> A.Array (Leaf k v)
                 -> A.Array (Leaf k v)
updateOrSnocWithKey :: 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 (Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary0)
  where
    go :: k -> v -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go !k
k v
v !Array (Leaf k v)
ary !Int
i !Int
n
        -- Not found, append to the end.
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Array (Leaf k v) -> Leaf k v -> Array (Leaf k v)
forall a. Array a -> a -> Array a
A.snoc Array (Leaf k v)
ary (Leaf k v -> Array (Leaf k v)) -> Leaf k v -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v
        | L k
kx v
y <- Array (Leaf k v) -> Int -> Leaf k v
forall a. Array a -> Int -> a
A.index Array (Leaf k v)
ary Int
i
        , k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx
        , (# v
v2 #) <- k -> v -> v -> (# v #)
f k
k v
v v
y
            = Array (Leaf k v) -> Int -> Leaf k v -> Array (Leaf k v)
forall e. Array e -> Int -> e -> Array e
A.update Array (Leaf k v)
ary Int
i (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v2)
        | Bool
otherwise
            = k -> v -> Array (Leaf k v) -> Int -> Int -> Array (Leaf k v)
go k
k v
v Array (Leaf k v)
ary (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINABLE updateOrSnocWithKey #-}

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 s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v))
-> (forall s. ST s (MArray s (Leaf k v))) -> Array (Leaf k v)
forall a b. (a -> b) -> a -> b
$ do
    -- TODO: instead of mapping and then folding, should we traverse?
    -- We'll have to be careful to avoid allocating pairs or similar.

    -- first: look up the position of each element of ary2 in ary1
    let indices :: Array (Maybe Int)
indices = (Leaf k v -> Maybe Int) -> Array (Leaf k v) -> Array (Maybe Int)
forall a b. (a -> b) -> Array a -> Array b
A.map' (\(L k
k v
_) -> k -> Array (Leaf k v) -> Maybe Int
forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k Array (Leaf k v)
ary1) Array (Leaf k v)
ary2
    -- that tells us how large the overlap is:
    -- count number of Nothing constructors
    let nOnly2 :: Int
nOnly2 = (Int -> Maybe Int -> Int) -> Int -> Array (Maybe Int) -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' (\Int
n -> Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int -> Int
forall a b. a -> b -> a
const Int
n)) Int
0 Array (Maybe Int)
indices
    let n1 :: Int
n1 = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary1
    let n2 :: Int
n2 = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary2
    -- copy over all elements from ary1
    MArray s (Leaf k v)
mary <- Int -> ST s (MArray s (Leaf k v))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nOnly2)
    Array (Leaf k v)
-> Int -> MArray s (Leaf k v) -> Int -> Int -> ST s ()
forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
A.copy Array (Leaf k v)
ary1 Int
0 MArray s (Leaf k v)
mary Int
0 Int
n1
    -- append or update all elements from ary2
    let go :: Int -> Int -> ST s ()
go !Int
iEnd !Int
i2
          | Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n2 = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise = case Array (Maybe Int) -> Int -> Maybe Int
forall a. Array a -> Int -> a
A.index Array (Maybe Int)
indices Int
i2 of
               Just Int
i1 -> do -- key occurs in both arrays, store combination in position i1
                             L k
k v
v1 <- Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary1 Int
i1
                             L k
_ v
v2 <- Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             case k -> v -> v -> (# v #)
f k
k v
v1 v
v2 of (# v
v3 #) -> MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
i1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v3)
                             Int -> Int -> ST s ()
go Int
iEnd (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
               Maybe Int
Nothing -> do -- key is only in ary2, append to end
                             MArray s (Leaf k v) -> Int -> Leaf k v -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s (Leaf k v)
mary Int
iEnd (Leaf k v -> ST s ()) -> ST s (Leaf k v) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array (Leaf k v) -> Int -> ST s (Leaf k v)
forall a s. Array a -> Int -> ST s a
A.indexM Array (Leaf k v)
ary2 Int
i2
                             Int -> Int -> ST s ()
go (Int
iEndInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Int -> Int -> ST s ()
go Int
n1 Int
0
    MArray s (Leaf k v) -> ST s (MArray s (Leaf k v))
forall a. a -> ST s a
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 = Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Array (Leaf k v2) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2 Bool -> Bool -> Bool
&& (Leaf k v1 -> Bool) -> Array (Leaf k v1) -> 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) = ((# #) -> Bool)
-> (v2 -> Int -> Bool) -> k -> Array (Leaf k v2) -> Bool
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 s. ST s (Array e)) -> Array e
forall a. (forall s. ST s a) -> a
runST (Array e -> Int -> e -> ST s (Array e)
forall e s. Array e -> Int -> e -> ST s (Array e)
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 <- Array e -> ST s (MArray s e)
forall e s. Array e -> ST s (MArray s e)
clone Array e
ary
    MArray s e -> Int -> e -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s e
mary Int
idx e
b
    MArray s e -> ST s (Array e)
forall s a. MArray s a -> ST s (Array a)
A.unsafeFreeze MArray s e
mary
{-# INLINE 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 #) <- Array e -> Int -> (# e #)
forall a. Array a -> Int -> (# a #)
A.index# Array e
ary Int
idx
  = Array e -> Int -> e -> Array e
forall e. Array e -> Int -> e -> Array e
update32 Array e
ary Int
idx (e -> Array e) -> e -> Array e
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 =
    Array e -> Int -> Int -> ST s (MArray s e)
forall e s. Array e -> Int -> Int -> ST s (MArray s e)
A.thaw Array e
ary Int
0 (Int
2Int -> Int -> Int
forall 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 Int -> Int -> Int
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 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitsPerSubkey Bitmap -> Bitmap -> Bitmap
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 = Bitmap -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitmap -> Int) -> Bitmap -> Int
forall a b. (a -> b) -> a -> b
$ Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitmap
w Int
s Bitmap -> Bitmap -> Bitmap
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 Bitmap -> Int -> Bitmap
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 1-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 = Bitmap -> Int
forall a. Bits a => a -> Int
popCount (Bitmap
b Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. (Bitmap
m Bitmap -> Bitmap -> Bitmap
forall a. Num a => a -> a -> a
- Bitmap
1))
{-# INLINE sparseIndex #-}

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

-- | Increment a 'Shift' for use at the next deeper level.
nextShift :: Shift -> Shift
nextShift :: Int -> Int
nextShift Int
s = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey
{-# INLINE nextShift #-}

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