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

#include "MachDeps.h"

-- | = 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
    , (!)
    , lookupKey
    , 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
    , differenceWithKey
    , intersection
    , intersectionWith
    , intersectionWithKey
    , intersectionWithKey#
    , disjoint

      -- * 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
    , updateFullArray
    , updateFullArrayM
    , updateFullArrayWith'
    , updateOrConcatWithKey
    , filterMapAux
    , equalKeys
    , equalKeys1
    , lookupRecordCollision
    , LookupRes(..)
    , lookupResToMaybe
    , insert'
    , delete'
    , lookup'
    , insertNewKey
    , insertKeyExists
    , deleteKeyExists
    , insertModifying
    , ptrEq
    , adjust#
    ) where

import Data.Traversable           -- MicroHs needs this since its Prelude does not have Foldable&Traversable.
                                  -- It's harmless for GHC, and putting it first avoid a warning.

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.Maybe                 (isNothing)
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 -> Word
hash = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (a -> Int) -> a -> Word
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

#if defined(__GLASGOW_HASKELL__)
-- | @since 0.2.17.0
instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
  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 String
k (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! String
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 Word
_ Array (HashMap k v)
ary) = Array (HashMap k v) -> ()
forall a. NFData a => a -> ()
rnf Array (HashMap k v)
ary
    rnf (Leaf Word
_ 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 Word
_ 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 Word
_ 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 Word
_ 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 Word
_ 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 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 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, 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. 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. Hashable k => [(k, v)] -> HashMap k v
fromList)
        Int
_ -> String -> c (HashMap k v)
forall a. HasCallStack => String -> a
error String
"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 -> String -> [String] -> Fixity -> Constr
Data.mkConstr DataType
hashMapDataType String
"fromList" [] Fixity
Data.Prefix

hashMapDataType :: DataType
hashMapDataType :: DataType
hashMapDataType = String -> [Constr] -> DataType
Data.mkDataType String
"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

-- | A 'Shift' value is the offset of the subkey in the hash and corresponds
-- 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) -> String -> Int -> [(a, b)] -> ShowS
forall a. (Int -> a -> ShowS) -> String -> 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) String
"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 (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 = (String -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a)
forall a. (String -> ReadS a) -> Int -> ReadS a
FC.readsData ((String -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a))
-> (String -> ReadS (HashMap k a)) -> Int -> ReadS (HashMap k a)
forall a b. (a -> b) -> a -> b
$
        (Int -> ReadS [(k, a)])
-> String
-> ([(k, a)] -> HashMap k a)
-> String
-> ReadS (HashMap k a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> 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') String
"fromList" [(k, a)] -> HashMap k a
forall k v. 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 (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 "fromList" <- ReadPrec Lexeme
lexP
      fromList <$> 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
$
      String -> ShowS
showString String
"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 Word
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Word
bm2 Array (HashMap k v')
ary2)
      = Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Leaf k v
l1) (Leaf Word
h2 Leaf k v'
l2) = Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Array (Leaf k v)
ary1) (Collision Word
h2 Array (Leaf k v')
ary2)
      = Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Word
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Word
k1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Word
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Word
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
k1 Word
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 Word
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Word
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
h1 Word
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 Word
_ Leaf k v
_ : [HashMap k v]
_) (Collision Word
_ Array (Leaf k' v')
_ : [HashMap k' v']
_) = Ordering
LT
    go (Collision Word
_ Array (Leaf k v)
_ : [HashMap k v]
_) (Leaf Word
_ 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']
_ = String -> Ordering
forall a. HasCallStack => String -> a
error String
"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 Word
k1 Leaf k v
l1 : [HashMap k v]
tl1) (Leaf Word
k2 Leaf k' v'
l2 : [HashMap k' v']
tl2)
      | Word
k1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Array (Leaf k v)
ary1 : [HashMap k v]
tl1) (Collision Word
h2 Array (Leaf k' v')
ary2 : [HashMap k' v']
tl2)
      | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
bm1 Array (HashMap k v)
ary1) (BitmapIndexed Word
bm2 Array (HashMap k v')
ary2)
      = Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Leaf k v
l1) (Leaf Word
h2 Leaf k v'
l2) = Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Array (Leaf k v)
ary1) (Collision Word
h2 Array (Leaf k v')
ary2)
      = Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
_ 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 Word
h Array (Leaf a b)
a : [HashMap a b]
tl)
          = (Int
s Int -> Word -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Word
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 Word
_ 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 Word
h (L k
_ v
v))
          = Int
s Int -> Word -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Word
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 Word
h Array (Leaf k v)
a)
          = (Int
s Int -> Word -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Word
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 Word
_ 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 Word
_ 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 Word
_ 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 Word
_ Leaf k v
_)      = Bool
True
isLeafOrCollision (Collision Word
_ 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 = Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf (k -> Word
forall a. Hashable a => a -> Word
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 Word
_ Leaf k v
_)            Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    go (BitmapIndexed Word
_ 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 Word
_ 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 :: Hashable k => k -> HashMap k a -> Bool
member :: forall k a. Hashable k => k -> HashMap k a -> Bool
member k
k HashMap k a
m = case k -> HashMap k a -> Maybe a
forall k v. 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 :: 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. Hashable k => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m = case k -> HashMap k v -> (# (# #) | v #)
forall k v. 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# :: Hashable k => k -> HashMap k v -> (# (# #) | v #)
lookup# :: forall k v. Hashable k => k -> HashMap k v -> (# (# #) | v #)
lookup# k
k HashMap k v
m = ((# #) -> (# (# #) | v #))
-> (v -> Int -> (# (# #) | v #))
-> Word
-> k
-> Int
-> HashMap k v
-> (# (# #) | v #)
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> (# (# #) | #)) (\v
v Int
_i -> (# | v
v #)) (k -> Word
forall a. Hashable a => a -> Word
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 => Word -> k -> HashMap k v -> Maybe v
lookup' Word
h k
k HashMap k v
m = case Word -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Word -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Word
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 => Word -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Word
h k
k HashMap k v
m = case Word -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
forall k v.
Eq k =>
Word -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Word
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 =>
Word -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
lookupRecordCollision# Word
h k
k HashMap k v
m =
    ((# #) -> (# (# #) | (# v, Int# #) #))
-> (v -> Int -> (# (# #) | (# v, Int# #) #))
-> Word
-> k
-> Int
-> HashMap k v
-> (# (# #) | (# v, Int# #) #)
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> (# (# #) | #)) (\v
v (I# Int#
i) -> (# | (# v
v, Int#
i #) #)) Word
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.
lookupCont ::
#if defined(__GLASGOW_HASKELL__)
  forall rep (r :: TYPE rep) k v.
#else
  forall r k v.
#endif
     Eq k
  => ((# #) -> r)    -- Absent continuation
  -> (v -> Int -> r) -- Present continuation
  -> Hash -- The hash of the key
  -> k
  -> Shift
  -> HashMap k v -> r
lookupCont :: forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (# #) -> r
absent v -> Int -> r
present !Word
h0 !k
k0 !Int
s0 HashMap k v
m0 = Eq k => Word -> k -> Int -> HashMap k v -> r
Word -> k -> Int -> HashMap k v -> r
lookupCont_ Word
h0 k
k0 Int
s0 HashMap k v
m0
  where
    lookupCont_ :: Eq k => Hash -> k -> Shift -> HashMap k v -> r
    lookupCont_ :: Eq k => Word -> k -> Int -> HashMap k v -> r
lookupCont_ !Word
_ !k
_ !Int
_ HashMap k v
Empty = (# #) -> r
absent (# #)
    lookupCont_ Word
h k
k Int
_ (Leaf Word
hx (L k
kx v
x))
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 (# #)
    lookupCont_ Word
h k
k Int
s (BitmapIndexed Word
b Array (HashMap k v)
v)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = (# #) -> r
absent (# #)
        | Bool
otherwise =
            case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
v (Word -> Word -> Int
sparseIndex Word
b Word
m) of
              (# HashMap k v
st #) -> Eq k => Word -> k -> Int -> HashMap k v -> r
Word -> k -> Int -> HashMap k v -> r
lookupCont_ Word
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
      where m :: Word
m = Word -> Int -> Word
mask Word
h Int
s
    lookupCont_ Word
h k
k Int
s (Full Array (HashMap k v)
v) =
      case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
v (Word -> Int -> Int
index Word
h Int
s) of
        (# HashMap k v
st #) -> Eq k => Word -> k -> Int -> HashMap k v -> r
Word -> k -> Int -> HashMap k v -> r
lookupCont_ Word
h k
k (Int -> Int
nextShift Int
s) HashMap k v
st
    lookupCont_ Word
h k
k Int
_ (Collision Word
hx Array (Leaf k v)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
(!?) :: Hashable k => HashMap k v -> k -> Maybe v
!? :: forall k v. Hashable k => HashMap k v -> k -> Maybe v
(!?) HashMap k v
m k
k = k -> HashMap k v -> Maybe v
forall k v. 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 :: Hashable k
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
findWithDefault :: forall k v. 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. 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 :: Hashable k
              => v          -- ^ Default value to return.
              -> k -> HashMap k v -> v
lookupDefault :: forall k v. Hashable k => v -> k -> HashMap k v -> v
lookupDefault = v -> k -> HashMap k v -> v
forall k v. 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.
(!) :: (Hashable k, HasCallStack) => HashMap k v -> k -> v
! :: forall k v. (Hashable k, HasCallStack) => HashMap k v -> k -> v
(!) HashMap k v
m k
k = case k -> HashMap k v -> Maybe v
forall k v. Hashable k => k -> HashMap k v -> Maybe v
lookup k
k HashMap k v
m of
    Just v
v  -> v
v
    Maybe v
Nothing -> String -> v
forall a. HasCallStack => String -> a
error String
"Data.HashMap.Internal.(!): key not found"
{-# INLINABLE (!) #-}

infixl 9 !

-- | \(O(\log n)\) For a given key, return the equal key stored in the map,
-- if present, otherwise return 'Nothing'.
--
-- This function can be used for /interning/, i.e. to reduce memory usage.
--
-- @since 0.2.21
lookupKey :: Hashable k => k -> HashMap k v -> Maybe k
lookupKey :: forall k v. Hashable k => k -> HashMap k v -> Maybe k
lookupKey k
k = \HashMap k v
m -> (# (# #) | k #) -> Maybe k
forall {a}. (# (# #) | a #) -> Maybe a
fromMaybe# (Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
forall k v.
Eq k =>
Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
lookupKeyInSubtree# Int
0 (k -> Word
forall a. Hashable a => a -> Word
hash k
k) k
k HashMap k v
m)
  where
    fromMaybe# :: (# (# #) | a #) -> Maybe a
fromMaybe# (# (##) | #) = Maybe a
forall a. Maybe a
Nothing
    fromMaybe# (# | a
a #) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
{-# INLINE lookupKey #-}

lookupKeyInSubtree# :: Eq k => Shift -> Hash -> k -> HashMap k v -> (# (##) | k #)
lookupKeyInSubtree# :: forall k v.
Eq k =>
Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
lookupKeyInSubtree# !Int
s !Word
hx k
kx = \case
  HashMap k v
Empty -> (# (##) | #)
  Leaf Word
hy (L k
ky v
_)
    | Word
hx Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hy Bool -> Bool -> Bool
&& k
kx k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
ky -> (# | k
ky #)
    | Bool
otherwise -> (# (##) | #)
  BitmapIndexed Word
b Array (HashMap k v)
ary
    | Word
m Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 -> (# (##) | #)
    | Bool
otherwise -> case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
        (# HashMap k v
st #) -> Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
forall k v.
Eq k =>
Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
lookupKeyInSubtree# (Int -> Int
nextShift Int
s) Word
hx k
kx HashMap k v
st
    where
      m :: Word
m = Word -> Int -> Word
mask Word
hx Int
s
      i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
  Full Array (HashMap k v)
ary -> case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary (Word -> Int -> Int
index Word
hx Int
s) of
    (# HashMap k v
st #) -> Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
forall k v.
Eq k =>
Int -> Word -> k -> HashMap k v -> (# (# #) | k #)
lookupKeyInSubtree# (Int -> Int
nextShift Int
s) Word
hx k
kx HashMap k v
st
  Collision Word
hy Array (Leaf k v)
ary
    | Word
hx Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hy
    , Just Int
i <- k -> Array (Leaf k v) -> Maybe Int
forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
kx Array (Leaf k v)
ary
    , (# L k
ky v
_ #) <- Array (Leaf k v) -> Int -> (# Leaf k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v)
ary Int
i
    -> (# | k
ky #)
    | Bool
otherwise -> (# (##) | #)
{-# INLINABLE lookupKeyInSubtree# #-}

-- | Create a 'Collision' value with two 'Leaf' values.
collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
collision :: forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 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
                       A.write mary 1 e2
                       return mary
    in Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
b !Array (HashMap k v)
ary
    | Word
b Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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         = Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Hashable k => k -> v -> HashMap k v -> HashMap k v
insert :: forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
insert k
k v
v HashMap k v
m = Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Word -> k -> v -> HashMap k v -> HashMap k v
insert' (k -> Word
forall a. Hashable a => a -> Word
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 => Word -> k -> v -> HashMap k v -> HashMap k v
insert' Word
h0 k
k0 v
v0 HashMap k v
m0 = Word -> k -> v -> Int -> HashMap k v -> HashMap k v
forall {t} {t}.
Eq t =>
Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
h0 k
k0 v
v0 Int
0 HashMap k v
m0
  where
    go :: Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go !Word
h !t
k t
x !Int
_ HashMap t t
Empty = Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(Leaf Word
hy l :: Leaf t t
l@(L t
ky t
y))
        | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
                    else Word -> Leaf t t -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 -> Word -> t -> t -> Word -> HashMap t t -> ST s (HashMap t t)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two Int
s Word
h t
k t
x Word
hy HashMap t t
t)
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(BitmapIndexed Word
b Array (HashMap t t)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
            in Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
              (# !HashMap t t
st #) ->
                let !st' :: HashMap t t
st' = Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
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 Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(Full Array (HashMap t t)
ary) =
        case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
          (# !HashMap t t
st #) ->
            let !st' :: HashMap t t
st' = Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
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
updateFullArray Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Word -> Int -> Int
index Word
h Int
s
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(Collision Word
hy Array (Leaf t t)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hy   = Word -> Array (Leaf t t) -> HashMap t t
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 = Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
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
$ Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word -> Int -> Word
mask Word
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. Word -> k -> v -> HashMap k v -> HashMap k v
insertNewKey !Word
h0 !k
k0 v
x0 HashMap k v
m0 = Word -> k -> v -> Int -> HashMap k v -> HashMap k v
forall {t} {t}. Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
h0 k
k0 v
x0 Int
0 HashMap k v
m0
  where
    go :: Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go !Word
h !t
k t
x !Int
_ HashMap t t
Empty = Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(Leaf Word
hy Leaf t t
l)
      | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h = Word -> Leaf t t -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 -> Word -> t -> t -> Word -> HashMap t t -> ST s (HashMap t t)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two Int
s Word
h t
k t
x Word
hy HashMap t t
t)
    go Word
h t
k t
x Int
s (BitmapIndexed Word
b Array (HashMap t t)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
            in Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Array (HashMap t t)
ary'
        | Bool
otherwise =
            case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
              (# HashMap t t
st #) ->
                let !st' :: HashMap t t
st' = Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
h t
k t
x (Int -> Int
nextShift Int
s) HashMap t t
st
                in Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h t
k t
x Int
s (Full Array (HashMap t t)
ary) =
        case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
          (# HashMap t t
st #) ->
            let !st' :: HashMap t t
st' = Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
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
updateFullArray Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Word -> Int -> Int
index Word
h Int
s
    go Word
h t
k t
x Int
s t :: HashMap t t
t@(Collision Word
hy Array (Leaf t t)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hy   = Word -> Array (Leaf t t) -> HashMap t t
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 =
            Word -> t -> t -> Int -> HashMap t t -> HashMap t t
go Word
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
$ Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word -> Int -> Word
mask Word
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 -> Word -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists !Int
collPos0 !Word
h0 !k
k0 v
x0 HashMap k v
m0 = Int -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> v -> HashMap k v -> HashMap k v
go Int
collPos0 Word
h0 k
k0 v
x0 HashMap k v
m0
  where
    go :: Int -> Word -> t -> t -> HashMap t t -> HashMap t t
go !Int
_collPos !Word
_shiftedHash !t
k t
x (Leaf Word
h Leaf t t
_kx)
        = Word -> Leaf t t -> HashMap t t
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (t -> t -> Leaf t t
forall k v. k -> v -> Leaf k v
L t
k t
x)
    go Int
collPos Word
shiftedHash t
k t
x (BitmapIndexed Word
b Array (HashMap t t)
ary)
        = case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
            (# HashMap t t
st #) ->
              let !st' :: HashMap t t
st' = Int -> Word -> t -> t -> HashMap t t -> HashMap t t
go Int
collPos (Word -> Word
nextSH Word
shiftedHash) t
k t
x HashMap t t
st
              in Word -> Array (HashMap t t) -> HashMap t t
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Word
m = Word -> Word
maskSH Word
shiftedHash
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Int
collPos Word
shiftedHash t
k t
x (Full Array (HashMap t t)
ary)
        = case Array (HashMap t t) -> Int -> (# HashMap t t #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap t t)
ary Int
i of
            (# HashMap t t
st #) ->
              let !st' :: HashMap t t
st' = Int -> Word -> t -> t -> HashMap t t -> HashMap t t
go Int
collPos (Word -> Word
nextSH Word
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
updateFullArray Array (HashMap t t)
ary Int
i HashMap t t
st')
      where i :: Int
i = Word -> Int
indexSH Word
shiftedHash
    go Int
collPos Word
_shiftedHash t
k t
x (Collision Word
h Array (Leaf t t)
v)
        | Int
collPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Word -> Array (Leaf t t) -> HashMap t t
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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
_ Word
_ t
_ t
_ HashMap t t
Empty = HashMap t t
forall k v. HashMap k v
Empty -- error "Internal error: go Empty"
{-# NOINLINE insertKeyExists #-}

-- | Replace the ith Leaf with Leaf k v.
--
-- This does not check that @i@ is within bounds of the array.
setAtPosition :: Int -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v)
setAtPosition :: forall k v. Int -> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
setAtPosition Int
i k
k v
x Array (Leaf k v)
ary = 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 :: forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
unsafeInsert :: forall k v. 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 (Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Word
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Word
h0 = k -> Word
forall a. Hashable a => a -> Word
hash k
k0
    go :: forall s. Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
    go :: forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !Word
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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Word
hy l :: Leaf k v
l@(L k
ky v
y))
        | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h = if k
ky k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k
                    then if v
x v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
y
                         then HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap k v
t
                         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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
                    else HashMap k v -> ST s (HashMap k v)
forall 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
$! Word -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two Int
s Word
h k
k v
x Word
hy HashMap k v
t
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Word
b Array (HashMap k v)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = do
            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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            return $! bitmapIndexedOrFull (b .|. m) ary'
        | Bool
otherwise = do
            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
            st' <- go h k x (nextShift s) st
            A.unsafeUpdateM ary i st'
            return t
      where m :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) = do
        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
        st' <- go h k x (nextShift s) st
        A.unsafeUpdateM ary i st'
        return t
      where i :: Int
i = Word -> Int -> Int
index Word
h Int
s
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Collision Word
hy Array (Leaf k v)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h ((v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
forall k v.
Eq k =>
(v -> v -> (# v #))
-> k -> v -> Array (Leaf k v) -> Array (Leaf k v)
updateOrSnocWith (\v
a v
_ -> (# v
a #)) k
k v
x Array (Leaf k v)
v)
        | Bool
otherwise = Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Word
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
$ Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word -> Int -> Word
mask Word
hy Int
s) (HashMap k v -> Array (HashMap k v)
forall a. a -> Array a
A.singleton HashMap k v
t)
{-# INLINABLE unsafeInsert #-}

-- | Create a map from two key-value pairs which hashes don't collide. To
-- enhance sharing, the second key-value pair is represented by the hash of its
-- key and a singleton HashMap pairing its key with its value.
--
-- Note: to avoid silly thunks, this function must be strict in the
-- key. See issue #232. We don't need to force the HashMap argument
-- because it's already in WHNF (having just been matched) and we
-- just put it directly in an array.
two :: Shift -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v)
two :: forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two = Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
go
  where
    go :: Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
go Int
s Word
h1 k
k1 v
v1 Word
h2 HashMap k v
t2
        | Word
bp1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bp2 = do
            st <- Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
go (Int -> Int
nextShift Int
s) Word
h1 k
k1 v
v1 Word
h2 HashMap k v
t2
            ary <- A.singletonM st
            return $ BitmapIndexed bp1 ary
        | Bool
otherwise  = do
            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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h1 (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k1 v
v1)
            A.write mary idx2 t2
            ary <- A.unsafeFreeze mary
            return $ BitmapIndexed (bp1 .|. bp2) ary
      where
        bp1 :: Word
bp1  = Word -> Int -> Word
mask Word
h1 Int
s
        bp2 :: Word
bp2  = Word -> Int -> Word
mask Word
h2 Int
s
        !(I# Int#
i1) = Word -> Int -> Int
index Word
h1 Int
s
        !(I# Int#
i2) = Word -> Int -> Int
index Word
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 :: 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.
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.
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 :: Hashable k => v -> (v -> (# v #)) -> k -> HashMap k v
            -> HashMap k v
insertModifying :: forall k v.
Hashable k =>
v -> (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
insertModifying v
x v -> (# v #)
f k
k0 HashMap k v
m0 = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
h0 k
k0 Int
0 HashMap k v
m0
  where
    !h0 :: Word
h0 = k -> Word
forall a. Hashable a => a -> Word
hash k
k0
    go :: Word -> k -> Int -> HashMap k v -> HashMap k v
go !Word
h !k
k !Int
_ HashMap k v
Empty = Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Word
h k
k Int
s t :: HashMap k v
t@(Leaf Word
hy l :: Leaf k v
l@(L k
ky v
y))
        | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
v')
                    else Word -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two Int
s Word
h k
k v
x Word
hy HashMap k v
t)
    go Word
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Word
b Array (HashMap k v)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Array (HashMap k v)
ary'
        | Bool
otherwise =
            case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
              (# !HashMap k v
st #) ->
                let !st' :: HashMap k v
st' = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
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
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 Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
b Array (HashMap k v)
ary'
      where m :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
          (# !HashMap k v
st #) ->
            let !st' :: HashMap k v
st' = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
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
updateFullArray Array (HashMap k v)
ary Int
i 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 = Word -> Int -> Int
index Word
h Int
s
    go Word
h k
k Int
s t :: HashMap k v
t@(Collision Word
hy Array (Leaf k v)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h Array (Leaf k v)
v'
        | Bool
otherwise = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
h k
k Int
s (HashMap k v -> HashMap k v) -> HashMap k v -> HashMap k v
forall a b. (a -> b) -> a -> b
$ Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word -> Int -> Word
mask Word
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. Hashable k
                 => (v -> v -> v) -> k -> v -> HashMap k v
                 -> HashMap k v
unsafeInsertWith :: forall k v.
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.
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. Hashable k
                 => (k -> v -> v -> (# v #)) -> k -> v -> HashMap k v
                 -> HashMap k v
unsafeInsertWithKey :: forall k v.
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 (Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Word
h0 k
k0 v
v0 Int
0 HashMap k v
m0)
  where
    h0 :: Word
h0 = k -> Word
forall a. Hashable a => a -> Word
hash k
k0
    go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
    go :: forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !Word
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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Leaf Word
hy l :: Leaf k v
l@(L k
ky v
y))
        | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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
$! Word -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
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 -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
forall k v s.
Int -> Word -> k -> v -> Word -> HashMap k v -> ST s (HashMap k v)
two Int
s Word
h k
k v
x Word
hy HashMap k v
t
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(BitmapIndexed Word
b Array (HashMap k v)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = do
            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
$! Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
k v
x)
            return $! bitmapIndexedOrFull (b .|. m) ary'
        | Bool
otherwise = do
            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
            st' <- go h k x (nextShift s) st
            A.unsafeUpdateM ary i st'
            return t
      where m :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) = do
        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
        st' <- go h k x (nextShift s) st
        A.unsafeUpdateM ary i st'
        return t
      where i :: Int
i = Word -> Int -> Int
index Word
h Int
s
    go Word
h k
k v
x Int
s t :: HashMap k v
t@(Collision Word
hy Array (Leaf k v)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
$! Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 = Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
forall s.
Word -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go Word
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
$ Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word -> Int -> Word
mask Word
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 :: Hashable k => k -> HashMap k v -> HashMap k v
delete :: forall k v. Hashable k => k -> HashMap k v -> HashMap k v
delete k
k = Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Word -> k -> HashMap k v -> HashMap k v
delete' (k -> Word
forall a. Hashable a => a -> Word
hash k
k) k
k
{-# INLINE delete #-}

delete' :: Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' :: forall k v. Eq k => Word -> k -> HashMap k v -> HashMap k v
delete' = Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Int -> Word -> k -> HashMap k v -> HashMap k v
deleteFromSubtree Int
0
{-# INLINE delete' #-}

-- | This version of 'delete' can be used on a subtree when the
-- corresponding 'Shift' argument is supplied.
deleteFromSubtree :: Eq k => Shift -> Hash -> k -> HashMap k v -> HashMap k v
deleteFromSubtree :: forall k v. Eq k => Int -> Word -> k -> HashMap k v -> HashMap k v
deleteFromSubtree !Int
s !Word
h !k
k = \case
  HashMap k v
Empty -> HashMap k v
forall k v. HashMap k v
Empty
  t :: HashMap k v
t@(Leaf Word
hy (L k
ky v
_))
    | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
  t :: HashMap k v
t@(BitmapIndexed Word
b Array (HashMap k v)
ary)
    | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 -> HashMap k v
t
    | Bool
otherwise -> case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
        (# !HashMap k v
st #) ->
          case Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Int -> Word -> k -> HashMap k v -> HashMap k v
deleteFromSubtree (Int -> Int
nextShift Int
s) Word
h k
k 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
2
                  , (# HashMap k v
l #) <- Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary (Int -> Int
otherOfOneOrZero Int
i)
                  , HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l
                    -> HashMap k v
l
                  | Bool
otherwise
                    -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
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
st' | HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st -> HashMap k v
t
                | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
st' 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
st'
                | Bool
otherwise -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Word
m = Word -> Int -> Word
mask Word
h Int
s
          i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
  t :: HashMap k v
t@(Full Array (HashMap k v)
ary) ->
    case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
      (# !HashMap k v
st #) ->
        case Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Int -> Word -> k -> HashMap k v -> HashMap k v
deleteFromSubtree (Int -> Int
nextShift Int
s) Word
h k
k 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 :: Word
bm   = Word
fullBitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
              in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bm Array (HashMap k v)
ary'
          HashMap k v
st' | HashMap k v
st' HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st -> HashMap k v
t
              | Bool
otherwise -> 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
updateFullArray Array (HashMap k v)
ary Int
i HashMap k v
st')
    where i :: Int
i = Word -> Int -> Int
index Word
h Int
s
  t :: HashMap k v
t@(Collision Word
hy Array (Leaf k v)
ary)
    | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hy
    , Just Int
i <- 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)
ary
      -> if Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
         then case Array (Leaf k v) -> Int -> (# Leaf k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v)
ary (Int -> Int
otherOfOneOrZero Int
i) of
           (# Leaf k v
l #) -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h Leaf k v
l
         else Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
ary Int
i)
    | Bool
otherwise -> HashMap k v
t
{-# INLINABLE deleteFromSubtree #-}

-- | 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 -> Word -> k -> HashMap k v -> HashMap k v
deleteKeyExists !Int
collPos0 !Word
h0 !k
k0 HashMap k v
m0 = Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
go Int
collPos0 Word
h0 k
k0 HashMap k v
m0
  where
    go :: Int -> ShiftedHash -> k -> HashMap k v -> HashMap k v
    go :: forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
go !Int
_collPos !Word
_shiftedHash !k
_k (Leaf Word
_ Leaf k v
_) = HashMap k v
forall k v. HashMap k v
Empty
    go Int
collPos Word
shiftedHash k
k (BitmapIndexed Word
b Array (HashMap k v)
ary) =
      case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
        (# HashMap k v
st #) -> case Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
go Int
collPos (Word -> Word
nextSH Word
shiftedHash) k
k 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
2
                , (# HashMap k v
l #) <- Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary (Int -> Int
otherOfOneOrZero Int
i)
                , HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l
                -> HashMap k v
l
                | Bool
otherwise
                -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
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
st' | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
st' 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
st'
              | Bool
otherwise -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 :: Word
m = Word -> Word
maskSH Word
shiftedHash
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Int
collPos Word
shiftedHash k
k (Full Array (HashMap k v)
ary) =
        case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
          (# HashMap k v
st #) -> case Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
go Int
collPos (Word -> Word
nextSH Word
shiftedHash) k
k 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 :: Word
bm   = Word
fullBitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bm Array (HashMap k v)
ary'
            HashMap k v
st' -> 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
updateFullArray Array (HashMap k v)
ary Int
i HashMap k v
st')
      where i :: Int
i = Word -> Int
indexSH Word
shiftedHash
    go Int
collPos Word
_shiftedHash k
_k (Collision Word
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
      = case Array (Leaf k v) -> Int -> (# Leaf k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v)
v (Int -> Int
otherOfOneOrZero Int
collPos) of
          (# Leaf k v
l #) -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h Leaf k v
l
      | Bool
otherwise = Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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
_ !Word
_ !k
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty -- error "Internal error: deleteKeyExists empty"
{-# NOINLINE deleteKeyExists #-}

-- | \(O(\log n)\) Adjust the value tied to a given key in this map only
-- if it is present. Otherwise, leave the map alone.
adjust :: 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.
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.
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# :: Hashable k => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# :: forall k v.
Hashable k =>
(v -> (# v #)) -> k -> HashMap k v -> HashMap k v
adjust# v -> (# v #)
f k
k0 HashMap k v
m0 = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
h0 k
k0 Int
0 HashMap k v
m0
  where
    h0 :: Word
h0 = k -> Word
forall a. Hashable a => a -> Word
hash k
k0
    go :: Word -> k -> Int -> HashMap k v -> HashMap k v
go !Word
_ !k
_ !Int
_ HashMap k v
Empty = HashMap k v
forall k v. HashMap k v
Empty
    go Word
h k
k Int
_ t :: HashMap k v
t@(Leaf Word
hy (L k
ky v
y))
        | Word
hy Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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 Word
h k
k Int
s t :: HashMap k v
t@(BitmapIndexed Word
b Array (HashMap k v)
ary)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
t
        | Bool
otherwise =
          case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
            (# !HashMap k v
st #) ->
              let !st' :: HashMap k v
st' = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
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
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 Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
b Array (HashMap k v)
ary'
      where m :: Word
m = Word -> Int -> Word
mask Word
h Int
s
            i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
    go Word
h k
k Int
s t :: HashMap k v
t@(Full Array (HashMap k v)
ary) =
        case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary Int
i of
          (# !HashMap k v
st #) ->
            let !st' :: HashMap k v
st' = Word -> k -> Int -> HashMap k v -> HashMap k v
go Word
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
updateFullArray Array (HashMap k v)
ary Int
i 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 = Word -> Int -> Int
index Word
h Int
s
    go Word
h k
k Int
_ t :: HashMap k v
t@(Collision Word
hy Array (Leaf k v)
v)
        | Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 :: Hashable k => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
update :: forall k a.
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.
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 :: Hashable k => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
alter :: forall k v.
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 :: Word
h = k -> Word
forall a. Hashable a => a -> Word
hash k
k
        !lookupRes :: LookupRes v
lookupRes = Word -> k -> HashMap k v -> LookupRes v
forall k v. Eq k => Word -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Word
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 -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
deleteKeyExists Int
collPos Word
h k
k HashMap k v
m
        Just v
v' -> case LookupRes v
lookupRes of
            LookupRes v
Absent            -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Word -> k -> v -> HashMap k v -> HashMap k v
insertNewKey Word
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 -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists Int
collPos Word
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, 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, 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 :: Word
h = k -> Word
forall a. Hashable a => a -> Word
hash k
k
    mv :: Maybe v
mv = Word -> k -> HashMap k v -> Maybe v
forall k v. Eq k => Word -> k -> HashMap k v -> Maybe v
lookup' Word
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 (Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Word -> k -> HashMap k v -> HashMap k v
delete' Word
h k
k HashMap k v
m)) Maybe v
mv
    Just v
v' -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Eq k => Word -> k -> v -> HashMap k v -> HashMap k v
insert' Word
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 = String -> a
forall a. HasCallStack => String -> a
error String
"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# (# #)
_ = String -> (# a #)
forall a. HasCallStack => String -> a
error String
"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, 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, 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, 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, Hashable k)
       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterFEager :: forall (f :: * -> *) k v.
(Functor f, 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 -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> HashMap k v -> HashMap k v
deleteKeyExists Int
collPos Word
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 -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Word -> k -> v -> HashMap k v -> HashMap k v
insertNewKey Word
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 -> Word -> k -> v -> HashMap k v -> HashMap k v
forall k v. Int -> Word -> k -> v -> HashMap k v -> HashMap k v
insertKeyExists Int
collPos Word
h k
k v
v' HashMap k v
m

  where !h :: Word
h = k -> Word
forall a. Hashable a => a -> Word
hash k
k
        !lookupRes :: LookupRes v
lookupRes = Word -> k -> HashMap k v -> LookupRes v
forall k v. Eq k => Word -> k -> HashMap k v -> LookupRes v
lookupRecordCollision Word
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 :: (Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool
isSubmapOf :: forall k v.
(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.
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 :: 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.
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 Word
h1 (L k
k1 v1
v1)) HashMap k v2
t2 = ((# #) -> Bool)
-> (v2 -> Int -> Bool) -> Word -> k -> Int -> HashMap k v2 -> Bool
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> Bool
False) (\v2
v2 Int
_ -> v1 -> v2 -> Bool
comp v1
v1 v2
v2) Word
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 Word
h1 Array (Leaf k v1)
ls1) (Collision Word
h2 Array (Leaf k v2)
ls2) =
      Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 Array (Leaf k v1)
_) (BitmapIndexed Word
b Array (HashMap k v2)
ls2)
        | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Bool
False
        | Bool
otherwise    =
            case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ls2 (Word -> Word -> Int
sparseIndex Word
b Word
m) of
              (# HashMap k v2
st2 #) -> Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 HashMap k v2
st2
      where m :: Word
m = Word -> Int -> Word
mask Word
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 Word
h1 Array (Leaf k v1)
_) (Full Array (HashMap k v2)
ls2) =
      case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ls2 (Word -> Int -> Int
index Word
h1 Int
s) of
        (# HashMap k v2
st2 #) -> Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 HashMap k v2
st2

    -- In cases where the first and second map are BitmapIndexed or Full,
    -- traverse down the tree at the appropriate indices.
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v1)
ls1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s)) Word
b1 Array (HashMap k v1)
ls1 Word
b2 Array (HashMap k v2)
ls2
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v1)
ls1) (Full Array (HashMap k v2)
ls2) =
      (HashMap k v1 -> HashMap k v2 -> Bool)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s)) Word
b1 Array (HashMap k v1)
ls1 Word
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)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
forall k v1 v2.
(HashMap k v1 -> HashMap k v2 -> Bool)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed (Int -> HashMap k v1 -> HashMap k v2 -> Bool
go (Int -> Int
nextShift Int
s)) Word
fullBitmap Array (HashMap k v1)
ls1 Word
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)
-> Word
-> Array (HashMap k v1)
-> Word
-> Array (HashMap k v2)
-> Bool
submapBitmapIndexed HashMap k v1 -> HashMap k v2 -> Bool
comp !Word
b1 !Array (HashMap k v1)
ary1 !Word
b2 !Array (HashMap k v2)
ary2 = Bool
subsetBitmaps Bool -> Bool -> Bool
&& Int -> Int -> Word -> Bool
go Int
0 Int
0 (Word
b1Orb2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
b1Orb2)
  where
    go :: Int -> Int -> Bitmap -> Bool
    go :: Int -> Int -> Word -> Bool
go !Int
i !Int
j !Word
m

      -- Note: m can overflow to 0 when maxChildren == WORD_SIZE_IN_BITS. See
      -- #491. In that case there needs to be a check '| m == 0 = True'
      | Word
m Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
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.
      | Word
b1Andb2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
      , (# HashMap k v1
st1 #) <- 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
st2 #) <- Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ary2 Int
j
        = HashMap k v1 -> HashMap k v2 -> Bool
comp HashMap k v1
st1 HashMap k v2
st2 Bool -> Bool -> Bool
&& Int -> Int -> Word -> 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) (Word
m Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)

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

    b1Andb2 :: Word
b1Andb2 = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b2
    b1Orb2 :: Word
b1Orb2  = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b2
    subsetBitmaps :: Bool
subsetBitmaps = Word
b1Orb2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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 Word
h1 l1 :: Leaf k v
l1@(L k
k1 v
v1)) t2 :: HashMap k v
t2@(Leaf Word
h2 l2 :: Leaf k v
l2@(L k
k2 v
v2))
        | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h2  = if k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2
                      then Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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 Word -> Leaf k v -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> Leaf k v -> HashMap k v
collision Word
h1 Leaf k v
l1 Leaf k v
l2
        | Bool
otherwise = Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
forall {k} {v}.
Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Leaf Word
h1 (L k
k1 v
v1)) t2 :: HashMap k v
t2@(Collision Word
h2 Array (Leaf k v)
ls2)
        | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h2  = Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
forall {k} {v}.
Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Word
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Leaf Word
h2 (L k
k2 v
v2))
        | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h2  = Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
forall {k} {v}.
Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2
    go Int
s t1 :: HashMap k v
t1@(Collision Word
h1 Array (Leaf k v)
ls1) t2 :: HashMap k v
t2@(Collision Word
h2 Array (Leaf k v)
ls2)
        | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h2  = Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
forall {k} {v}.
Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2
    -- branch vs. branch
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v)
ary1) (BitmapIndexed Word
b2 Array (HashMap k v)
ary2) =
        let b' :: Word
b'   = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b2
            ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Word
-> Word
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Word -> Word -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s)) Word
b1 Word
b2 Array (HashMap k v)
ary1 Array (HashMap k v)
ary2
        in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
b' Array (HashMap k v)
ary'
    go Int
s (BitmapIndexed Word
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)
-> Word
-> Word
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Word -> Word -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s)) Word
b1 Word
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 Word
b2 Array (HashMap k v)
ary2) =
        let ary' :: Array (HashMap k v)
ary' = (HashMap k v -> HashMap k v -> HashMap k v)
-> Word
-> Word
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Word -> Word -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s)) Word
fullBitmap Word
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)
-> Word
-> Word
-> Array (HashMap k v)
-> Array (HashMap k v)
-> Array (HashMap k v)
forall a.
(a -> a -> a) -> Word -> Word -> Array a -> Array a -> Array a
unionArrayBy (Int -> HashMap k v -> HashMap k v -> HashMap k v
go (Int -> Int
nextShift Int
s)) Word
fullBitmap Word
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 Word
b1 Array (HashMap k v)
ary1) HashMap k v
t2
        | Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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' :: Word
b'   = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m2
                           in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
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 Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
b1 Array (HashMap k v)
ary'
        where
          h2 :: Word
h2 = HashMap k v -> Word
forall {k} {v}. HashMap k v -> Word
leafHashCode HashMap k v
t2
          m2 :: Word
m2 = Word -> Int -> Word
mask Word
h2 Int
s
          i :: Int
i = Word -> Word -> Int
sparseIndex Word
b1 Word
m2
    go Int
s HashMap k v
t1 (BitmapIndexed Word
b2 Array (HashMap k v)
ary2)
        | Word
b2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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' :: Word
b'   = Word
b2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m1
                           in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
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 Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
b2 Array (HashMap k v)
ary'
      where
        h1 :: Word
h1 = HashMap k v -> Word
forall {k} {v}. HashMap k v -> Word
leafHashCode HashMap k v
t1
        m1 :: Word
m1 = Word -> Int -> Word
mask Word
h1 Int
s
        i :: Int
i = Word -> Word -> Int
sparseIndex Word
b2 Word
m1
    go Int
s (Full Array (HashMap k v)
ary1) HashMap k v
t2 =
        let h2 :: Word
h2   = HashMap k v -> Word
forall {k} {v}. HashMap k v -> Word
leafHashCode HashMap k v
t2
            i :: Int
i    = Word -> Int -> Int
index Word
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
updateFullArrayWith' 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 :: Word
h1   = HashMap k v -> Word
forall {k} {v}. HashMap k v -> Word
leafHashCode HashMap k v
t1
            i :: Int
i    = Word -> Int -> Int
index Word
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
updateFullArrayWith' 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 -> Word
leafHashCode (Leaf Word
h Leaf k v
_) = Word
h
    leafHashCode (Collision Word
h Array (Leaf k v)
_) = Word
h
    leafHashCode HashMap k v
_ = String -> Word
forall a. HasCallStack => String -> a
error String
"leafHashCode"

    goDifferentHash :: Int -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash Int
s Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2
        | Word
m1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
m2  = Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 -> Word -> Word -> HashMap k v -> HashMap k v -> HashMap k v
goDifferentHash (Int -> Int
nextShift Int
s) Word
h1 Word
h2 HashMap k v
t1 HashMap k v
t2)
        | Word
m1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<  Word
m2  = Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
m1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
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 = Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
m1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
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 :: Word
m1 = Word -> Int -> Word
mask Word
h1 Int
s
        m2 :: Word
m2 = Word -> Int -> Word
mask Word
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) -> Word -> Word -> Array a -> Array a -> Array a
unionArrayBy a -> a -> a
f !Word
b1 !Word
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 :: Word
bCombined = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b2
    mary <- Int -> ST s (MArray s a)
forall s a. Int -> ST s (MArray s a)
A.new_ (Word -> Int
forall a. Bits a => a -> Int
popCount Word
bCombined)
    -- iterate over nonzero bits of b1 .|. b2
    let go !Int
i !Int
i1 !Int
i2 !Word
b
            | Word
b Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Word -> Bool
testBit (Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b2) = do
                x1 <- Array a -> Int -> ST s a
forall a s. Array a -> Int -> ST s a
A.indexM Array a
ary1 Int
i1
                x2 <- A.indexM ary2 i2
                A.write mary i $! f x1 x2
                go (i+1) (i1+1) (i2+1) b'
            | Word -> Bool
testBit Word
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 -> Word -> 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 Word
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 -> Word -> 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) Word
b'
          where
            m :: Word
m = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
b
            testBit :: Word -> Bool
testBit Word
x = Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
            b' :: Word
b' = Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m
    go 0 0 0 bCombined
    return 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

-- | Given maps @bc@ and @ab@, relate the keys of @ab@ to the values of @bc@,
-- by using the values of @ab@ as keys for lookups in @bc@.
--
-- 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 :: Hashable b => HashMap b c -> HashMap a b -> HashMap a c
compose :: forall b c a.
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. 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 Word
h (L k
k v1
v)) = Word -> Leaf k v2 -> HashMap k v2
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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 Word
b Array (HashMap k v1)
ary) = Word -> Array (HashMap k v2) -> HashMap k v2
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 Word
h Array (Leaf k v1)
ary) = Word -> Array (Leaf k v2) -> HashMap k v2
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 Word
h (L k
k v1
v))      = Word -> Leaf k v2 -> HashMap k v2
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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 Word
b Array (HashMap k v1)
ary) = Word -> Array (HashMap k v2) -> HashMap k v2
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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 Word
h Array (Leaf k v1)
ary)     =
        Word -> Array (Leaf k v2) -> HashMap k v2
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 :: Hashable k2 => (k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys :: forall k2 k1 v.
Hashable k2 =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys k1 -> k2
f = [(k2, v)] -> HashMap k2 v
forall k v. 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 :: Hashable k => HashMap k v -> HashMap k w -> HashMap k v
difference :: forall k v w.
Hashable k =>
HashMap k v -> HashMap k w -> HashMap k v
difference = Int -> HashMap k v -> HashMap k w -> HashMap k v
forall {k} {v} {v2}.
Eq k =>
Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference Int
0
  where
    go_difference :: Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference !Int
_s HashMap k v
Empty HashMap k v2
_ = HashMap k v
forall k v. HashMap k v
Empty
    go_difference Int
s t1 :: HashMap k v
t1@(Leaf Word
h1 (L k
k1 v
_)) HashMap k v2
t2
      = ((# #) -> HashMap k v)
-> (v2 -> Int -> HashMap k v)
-> Word
-> k
-> Int
-> HashMap k v2
-> HashMap k v
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> HashMap k v
t1) (\v2
_ Int
_ -> HashMap k v
forall k v. HashMap k v
Empty) Word
h1 k
k1 Int
s HashMap k v2
t2
    go_difference Int
_ HashMap k v
t1 HashMap k v2
Empty = HashMap k v
t1
    go_difference Int
s HashMap k v
t1 (Leaf Word
h2 (L k
k2 v2
_)) = Int -> Word -> k -> HashMap k v -> HashMap k v
forall k v. Eq k => Int -> Word -> k -> HashMap k v -> HashMap k v
deleteFromSubtree Int
s Word
h2 k
k2 HashMap k v
t1

    go_difference Int
s t1 :: HashMap k v
t1@(BitmapIndexed Word
b1 Array (HashMap k v)
ary1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k v2)
-> HashMap k v
differenceArrays Int
s Word
b1 Array (HashMap k v)
ary1 HashMap k v
t1 Word
b2 Array (HashMap k v2)
ary2
    go_difference Int
s t1 :: HashMap k v
t1@(Full Array (HashMap k v)
ary1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k v2)
-> HashMap k v
differenceArrays Int
s Word
fullBitmap Array (HashMap k v)
ary1 HashMap k v
t1 Word
b2 Array (HashMap k v2)
ary2
    go_difference Int
s t1 :: HashMap k v
t1@(BitmapIndexed Word
b1 Array (HashMap k v)
ary1) (Full Array (HashMap k v2)
ary2)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k v2)
-> HashMap k v
differenceArrays Int
s Word
b1 Array (HashMap k v)
ary1 HashMap k v
t1 Word
fullBitmap Array (HashMap k v2)
ary2
    go_difference Int
s t1 :: HashMap k v
t1@(Full Array (HashMap k v)
ary1) (Full Array (HashMap k v2)
ary2)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k v2)
-> HashMap k v
differenceArrays Int
s Word
fullBitmap Array (HashMap k v)
ary1 HashMap k v
t1 Word
fullBitmap Array (HashMap k v2)
ary2

    go_difference Int
s t1 :: HashMap k v
t1@(Collision Word
h1 Array (Leaf k v)
_) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2)
        | Word
b2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
t1
        | Bool
otherwise =
          case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ary2 (Word -> Word -> Int
sparseIndex Word
b2 Word
m) of
            (# HashMap k v2
st2 #) -> Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference (Int -> Int
nextShift Int
s) HashMap k v
t1 HashMap k v2
st2
      where m :: Word
m = Word -> Int -> Word
mask Word
h1 Int
s
    go_difference Int
s t1 :: HashMap k v
t1@(Collision Word
h1 Array (Leaf k v)
_) (Full Array (HashMap k v2)
ary2)
      = case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ary2 (Word -> Int -> Int
index Word
h1 Int
s) of
          (# HashMap k v2
st2 #) -> Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference (Int -> Int
nextShift Int
s) HashMap k v
t1 HashMap k v2
st2

    go_difference Int
s t1 :: HashMap k v
t1@(BitmapIndexed Word
b1 Array (HashMap k v)
ary1) t2 :: HashMap k v2
t2@(Collision Word
h2 Array (Leaf k v2)
_)
        | Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
t1
        | Bool
otherwise =
          case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary1 Int
i1 of
            (# !HashMap k v
st #) ->
              case Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference (Int -> Int
nextShift Int
s) HashMap k v
st HashMap k v2
t2 of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                      , (# HashMap k v
l #) <- Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary1 (Int -> Int
otherOfOneOrZero Int
i1)
                      , HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l
                      -> HashMap k v
l
                      | Bool
otherwise
                      -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary1 Int
i1)
                HashMap k v
st' | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
st' Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
st'
                    | HashMap k v
st HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st' -> HashMap k v
t1
                    | Bool
otherwise -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
b1 (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)
ary1 Int
i1 HashMap k v
st')
      where
        m :: Word
m = Word -> Int -> Word
mask Word
h2 Int
s
        i1 :: Int
i1 = Word -> Word -> Int
sparseIndex Word
b1 Word
m
    go_difference Int
s t1 :: HashMap k v
t1@(Full Array (HashMap k v)
ary1) t2 :: HashMap k v2
t2@(Collision Word
h2 Array (Leaf k v2)
_)
      = case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
ary1 Int
i of
          (# !HashMap k v
st #) -> case Int -> HashMap k v -> HashMap k v2 -> HashMap k v
go_difference (Int -> Int
nextShift Int
s) HashMap k v
st HashMap k v2
t2 of
            HashMap k v
Empty ->
                let ary1' :: Array (HashMap k v)
ary1' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
ary1 Int
i
                    bm :: Word
bm   = Word
fullBitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bm Array (HashMap k v)
ary1'
            HashMap k v
st' | HashMap k v
st HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st' -> HashMap k v
t1
                | Bool
otherwise -> 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
updateFullArray Array (HashMap k v)
ary1 Int
i HashMap k v
st')
      where i :: Int
i = Word -> Int -> Int
index Word
h2 Int
s

    go_difference Int
_ t1 :: HashMap k v
t1@(Collision Word
h1 Array (Leaf k v)
ary1) (Collision Word
h2 Array (Leaf k v2)
ary2)
      = Word
-> Array (Leaf k v)
-> HashMap k v
-> Word
-> Array (Leaf k v2)
-> HashMap k v
forall k v1 v2.
Eq k =>
Word
-> Array (Leaf k v1)
-> HashMap k v1
-> Word
-> Array (Leaf k v2)
-> HashMap k v1
differenceCollisions Word
h1 Array (Leaf k v)
ary1 HashMap k v
t1 Word
h2 Array (Leaf k v2)
ary2

    -- TODO: If we keep 'Full' (#399), differenceArrays could be optimized for
    -- each combination of 'Full' and 'BitmapIndexed`.
    differenceArrays :: Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k v2)
-> HashMap k v
differenceArrays !Int
s !Word
b1 !Array (HashMap k v)
ary1 HashMap k v
t1 !Word
b2 !Array (HashMap k v2)
ary2
      | Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
t1
      | Array (HashMap k v) -> Array (HashMap k v2) -> Bool
forall a b. Array a -> Array b -> Bool
A.unsafeSameArray Array (HashMap k v)
ary1 Array (HashMap k v2)
ary2 = HashMap k v
forall k v. HashMap k v
Empty
      | Bool
otherwise = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v)) -> HashMap k v)
-> (forall s. ST s (HashMap k v)) -> HashMap k v
forall a b. (a -> b) -> a -> b
$ do
        mary <- Int -> ST s (MArray s (HashMap k v))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int -> ST s (MArray s (HashMap k v)))
-> Int -> ST s (MArray s (HashMap k v))
forall a b. (a -> b) -> a -> b
$ Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary1
    
        -- TODO: i == popCount bResult. Not sure if that would be faster.
        -- Also i1 is in some relation with b1'
        let goDA !Int
i !Int
i1 !Word
b1' !Word
bResult !Int
nChanges
              | Word
b1' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = (Word, Int) -> ST s (Word, Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word
bResult, Int
nChanges)
              | Bool
otherwise = do
                !st1 <- 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)
ary1 Int
i1
                case m .&. b2 of
                  Word
0 -> do
                    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
i HashMap k v
st1
                    Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
goDA (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) Word
nextB1' (Word
bResult Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Int
nChanges
                  Word
_ -> do
                    !st2 <- 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 (Word -> Word -> Int
sparseIndex Word
b2 Word
m)
                    case go_difference (nextShift s) st1 st2 of
                      HashMap k v
Empty -> Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
goDA Int
i (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
nextB1' Word
bResult (Int
nChanges Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                      HashMap k v
st -> do
                        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
i HashMap k v
st
                        let same :: Int
same = Int# -> Int
I# (HashMap k v -> HashMap k v -> Int#
forall a b. a -> b -> Int#
Exts.reallyUnsafePtrEquality# HashMap k v
st HashMap k v
st1)
                        let nChanges' :: Int
nChanges' = Int
nChanges Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
same)
                        Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
goDA (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) Word
nextB1' (Word
bResult Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Int
nChanges'
              where
                m :: Word
m = Word
b1' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
b1'
                nextB1' :: Word
nextB1' = Word
b1' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m
    
        (bResult, nChanges) <- goDA 0 0 b1 0 0
        if nChanges == 0
          then pure t1
          else case popCount bResult of
            Int
0 -> HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v
forall k v. HashMap k v
Empty
            Int
1 -> do
              l <- MArray s (HashMap k v) -> Int -> ST s (HashMap k v)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v)
mary Int
0
              if isLeafOrCollision l
                then pure l
                else BitmapIndexed bResult <$> (A.unsafeFreeze =<< A.shrink mary 1)
            Int
n -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
bResult (Array (HashMap k v) -> HashMap k v)
-> ST s (Array (HashMap k v)) -> ST s (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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) -> ST s (Array (HashMap k v)))
-> ST s (MArray s (HashMap k v)) -> ST s (Array (HashMap k v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v) -> Int -> ST s (MArray s (HashMap k v))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v)
mary Int
n)
{-# INLINABLE difference #-}

-- TODO: This could be faster if we would keep track of which elements of ary2
-- we've already matched. Those could be skipped when we check the following
-- elements of ary1.
differenceCollisions :: Eq k => Hash -> A.Array (Leaf k v1) -> HashMap k v1 -> Hash -> A.Array (Leaf k v2) -> HashMap k v1
differenceCollisions :: forall k v1 v2.
Eq k =>
Word
-> Array (Leaf k v1)
-> HashMap k v1
-> Word
-> Array (Leaf k v2)
-> HashMap k v1
differenceCollisions !Word
h1 !Array (Leaf k v1)
ary1 HashMap k v1
t1 !Word
h2 !Array (Leaf k v2)
ary2
  | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h2 =
    if Array (Leaf k v1) -> Array (Leaf k v2) -> Bool
forall a b. Array a -> Array b -> Bool
A.unsafeSameArray Array (Leaf k v1)
ary1 Array (Leaf k v2)
ary2
      then HashMap k v1
forall k v. HashMap k v
Empty
      else let ary :: Array (Leaf k v1)
ary = (Leaf k v1 -> Bool) -> Array (Leaf k v1) -> Array (Leaf k v1)
forall a. (a -> Bool) -> Array a -> Array a
A.filter (\(L k
k1 v1
_) -> Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (k -> Array (Leaf k v2) -> Maybe Int
forall k v. Eq k => k -> Array (Leaf k v) -> Maybe Int
indexOf k
k1 Array (Leaf k v2)
ary2)) Array (Leaf k v1)
ary1
           in case Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary of
             Int
0 -> HashMap k v1
forall k v. HashMap k v
Empty
             Int
1 -> case Array (Leaf k v1) -> Int -> (# Leaf k v1 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v1)
ary Int
0 of
                    (# Leaf k v1
l #) -> Word -> Leaf k v1 -> HashMap k v1
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h1 Leaf k v1
l
             Int
n | Array (Leaf k v1) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v1)
ary1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> HashMap k v1
t1
               | Bool
otherwise -> Word -> Array (Leaf k v1) -> HashMap k v1
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h1 Array (Leaf k v1)
ary
  | Bool
otherwise = HashMap k v1
t1
{-# INLINABLE differenceCollisions #-}

-- | \(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 :: Hashable k => (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
differenceWith :: forall k v w.
Hashable k =>
(v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
differenceWith v -> w -> Maybe v
f = (k -> v -> w -> Maybe v)
-> HashMap k v -> HashMap k w -> HashMap k v
forall k v w.
Eq k =>
(k -> v -> w -> Maybe v)
-> HashMap k v -> HashMap k w -> HashMap k v
differenceWithKey ((v -> w -> Maybe v) -> k -> v -> w -> Maybe v
forall a b. a -> b -> a
const v -> w -> Maybe v
f)
{-# INLINE differenceWith #-}

-- | \(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@.
--
-- @since 0.2.21
differenceWithKey :: Eq k => (k -> v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
differenceWithKey :: forall k v w.
Eq k =>
(k -> v -> w -> Maybe v)
-> HashMap k v -> HashMap k w -> HashMap k v
differenceWithKey k -> v -> w -> Maybe v
f = Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey Int
0
  where
    go_differenceWithKey :: Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey !Int
_s HashMap k v
Empty HashMap k w
_tB = HashMap k v
forall k v. HashMap k v
Empty
    go_differenceWithKey Int
_s HashMap k v
a HashMap k w
Empty = HashMap k v
a
    go_differenceWithKey Int
s a :: HashMap k v
a@(Leaf Word
hA (L k
kA v
vA)) HashMap k w
b
      = ((# #) -> HashMap k v)
-> (w -> Int -> HashMap k v)
-> Word
-> k
-> Int
-> HashMap k w
-> HashMap k v
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont
          (\(# #)
_ -> HashMap k v
a)
          (\w
vB Int
_ -> case k -> v -> w -> Maybe v
f k
kA v
vA w
vB of
              Maybe v
Nothing -> HashMap k v
forall k v. HashMap k v
Empty
              Just v
v | v
v v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
vA -> HashMap k v
a
                     | Bool
otherwise -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
hA (k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
kA v
v))
          Word
hA k
kA Int
s HashMap k w
b
    go_differenceWithKey Int
_s a :: HashMap k v
a@(Collision Word
hA Array (Leaf k v)
aryA) (Leaf Word
hB (L k
kB w
vB))
      | Word
hA Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hB = (v -> Maybe v)
-> Word -> k -> Array (Leaf k v) -> HashMap k v -> HashMap k v
forall k v.
Eq k =>
(v -> Maybe v)
-> Word -> k -> Array (Leaf k v) -> HashMap k v -> HashMap k v
updateCollision (\v
vA -> k -> v -> w -> Maybe v
f k
kB v
vA w
vB) Word
hA k
kB Array (Leaf k v)
aryA HashMap k v
a
      | Bool
otherwise = HashMap k v
a
    go_differenceWithKey Int
s a :: HashMap k v
a@(BitmapIndexed Word
bA Array (HashMap k v)
aryA) b :: HashMap k w
b@(Leaf Word
hB Leaf k w
_)
      | Word
bA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
a
      | Bool
otherwise = case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA Int
i of
          (# !HashMap k v
stA #) -> case Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
stA HashMap k w
b of
            HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
aryA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                  , (# HashMap k v
l #) <- Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA (Int -> Int
otherOfOneOrZero Int
i)
                  , HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l
                  -> HashMap k v
l
                  | Bool
otherwise
                  -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
bA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
aryA Int
i)
            HashMap k v
stA' | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
stA' Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
aryA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
stA'
                 | HashMap k v
stA HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
stA' -> HashMap k v
a
                 | Bool
otherwise -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bA (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)
aryA Int
i HashMap k v
stA')
      where
        m :: Word
m = Word -> Int -> Word
mask Word
hB Int
s
        i :: Int
i = Word -> Word -> Int
sparseIndex Word
bA Word
m
    go_differenceWithKey Int
s a :: HashMap k v
a@(BitmapIndexed Word
bA Array (HashMap k v)
aryA) b :: HashMap k w
b@(Collision Word
hB Array (Leaf k w)
_)
        | Word
bA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
a
        | Bool
otherwise =
            case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA Int
i of
              (# !HashMap k v
st #) -> case Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
st HashMap k w
b of
                HashMap k v
Empty | Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
aryA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                      , (# HashMap k v
l #) <- Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA (Int -> Int
otherOfOneOrZero Int
i)
                      , HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
l
                      -> HashMap k v
l
                      | Bool
otherwise
                      -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed (Word
bA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m) (Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
aryA Int
i)
                HashMap k v
st' | HashMap k v -> Bool
forall k a. HashMap k a -> Bool
isLeafOrCollision HashMap k v
st' Bool -> Bool -> Bool
&& Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
aryA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> HashMap k v
st'
                    | HashMap k v
st HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
st' -> HashMap k v
a
                    | Bool
otherwise -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bA (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)
aryA Int
i HashMap k v
st')
      where
        m :: Word
m = Word -> Int -> Word
mask Word
hB Int
s
        i :: Int
i = Word -> Word -> Int
sparseIndex Word
bA Word
m
    go_differenceWithKey Int
s a :: HashMap k v
a@(Full Array (HashMap k v)
aryA) b :: HashMap k w
b@(Leaf Word
hB Leaf k w
_)
      = case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA Int
i of
          (# !HashMap k v
stA #) -> case Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
stA HashMap k w
b of
            HashMap k v
Empty ->
                let aryA' :: Array (HashMap k v)
aryA' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
aryA Int
i
                    bm :: Word
bm    = Word
fullBitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bm Array (HashMap k v)
aryA'
            HashMap k v
stA' | HashMap k v
stA HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
stA' -> HashMap k v
a
                 | Bool
otherwise -> 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
updateFullArray Array (HashMap k v)
aryA Int
i HashMap k v
stA')
      where i :: Int
i = Word -> Int -> Int
index Word
hB Int
s
    go_differenceWithKey Int
s a :: HashMap k v
a@(Full Array (HashMap k v)
aryA) b :: HashMap k w
b@(Collision Word
hB Array (Leaf k w)
_)
      = case Array (HashMap k v) -> Int -> (# HashMap k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v)
aryA Int
i of
          (# !HashMap k v
stA #) -> case Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
stA HashMap k w
b of
            HashMap k v
Empty ->
                let aryA' :: Array (HashMap k v)
aryA' = Array (HashMap k v) -> Int -> Array (HashMap k v)
forall e. Array e -> Int -> Array e
A.delete Array (HashMap k v)
aryA Int
i
                    bm :: Word
bm    = Word
fullBitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i)
                in Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
bm Array (HashMap k v)
aryA'
            HashMap k v
stA' | HashMap k v
stA HashMap k v -> HashMap k v -> Bool
forall a. a -> a -> Bool
`ptrEq` HashMap k v
stA' -> HashMap k v
a
                 | Bool
otherwise -> 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
updateFullArray Array (HashMap k v)
aryA Int
i HashMap k v
stA')
      where i :: Int
i = Word -> Int -> Int
index Word
hB Int
s
    go_differenceWithKey Int
s a :: HashMap k v
a@(Collision Word
hA Array (Leaf k v)
_) (BitmapIndexed Word
bB Array (HashMap k w)
aryB)
        | Word
bB Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
a
        | Bool
otherwise =
          case Array (HashMap k w) -> Int -> (# HashMap k w #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k w)
aryB (Word -> Word -> Int
sparseIndex Word
bB Word
m) of
            (# HashMap k w
stB #) -> Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
a HashMap k w
stB
      where m :: Word
m = Word -> Int -> Word
mask Word
hA Int
s
    go_differenceWithKey Int
s a :: HashMap k v
a@(Collision Word
hA Array (Leaf k v)
_) (Full Array (HashMap k w)
aryB)
      = case Array (HashMap k w) -> Int -> (# HashMap k w #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k w)
aryB (Word -> Int -> Int
index Word
hA Int
s) of
          (# HashMap k w
stB #) -> Int -> HashMap k v -> HashMap k w -> HashMap k v
go_differenceWithKey (Int -> Int
nextShift Int
s) HashMap k v
a HashMap k w
stB
    go_differenceWithKey Int
s a :: HashMap k v
a@(BitmapIndexed Word
bA Array (HashMap k v)
aryA) (BitmapIndexed Word
bB Array (HashMap k w)
aryB)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k w)
-> HashMap k v
differenceWithKey_Arrays Int
s Word
bA Array (HashMap k v)
aryA HashMap k v
a Word
bB Array (HashMap k w)
aryB
    go_differenceWithKey Int
s a :: HashMap k v
a@(Full Array (HashMap k v)
aryA) (BitmapIndexed Word
bB Array (HashMap k w)
aryB)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k w)
-> HashMap k v
differenceWithKey_Arrays Int
s Word
fullBitmap Array (HashMap k v)
aryA HashMap k v
a Word
bB Array (HashMap k w)
aryB
    go_differenceWithKey Int
s a :: HashMap k v
a@(BitmapIndexed Word
bA Array (HashMap k v)
aryA) (Full Array (HashMap k w)
aryB)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k w)
-> HashMap k v
differenceWithKey_Arrays Int
s Word
bA Array (HashMap k v)
aryA HashMap k v
a Word
fullBitmap Array (HashMap k w)
aryB
    go_differenceWithKey Int
s a :: HashMap k v
a@(Full Array (HashMap k v)
aryA) (Full Array (HashMap k w)
aryB)
      = Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k w)
-> HashMap k v
differenceWithKey_Arrays Int
s Word
fullBitmap Array (HashMap k v)
aryA HashMap k v
a Word
fullBitmap Array (HashMap k w)
aryB
    go_differenceWithKey Int
_s a :: HashMap k v
a@(Collision Word
hA Array (Leaf k v)
aryA) (Collision Word
hB Array (Leaf k w)
aryB)
      = (k -> v -> w -> Maybe v)
-> Word
-> Array (Leaf k v)
-> HashMap k v
-> Word
-> Array (Leaf k w)
-> HashMap k v
forall k v w.
Eq k =>
(k -> v -> w -> Maybe v)
-> Word
-> Array (Leaf k v)
-> HashMap k v
-> Word
-> Array (Leaf k w)
-> HashMap k v
differenceWithKey_Collisions k -> v -> w -> Maybe v
f Word
hA Array (Leaf k v)
aryA HashMap k v
a Word
hB Array (Leaf k w)
aryB

    differenceWithKey_Arrays :: Int
-> Word
-> Array (HashMap k v)
-> HashMap k v
-> Word
-> Array (HashMap k w)
-> HashMap k v
differenceWithKey_Arrays !Int
s !Word
bA !Array (HashMap k v)
aryA HashMap k v
tA !Word
bB !Array (HashMap k w)
aryB
      | Word
bA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bB Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v
tA
      | Bool
otherwise = (forall s. ST s (HashMap k v)) -> HashMap k v
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap k v)) -> HashMap k v)
-> (forall s. ST s (HashMap k v)) -> HashMap k v
forall a b. (a -> b) -> a -> b
$ do
        mary <- Int -> ST s (MArray s (HashMap k v))
forall s a. Int -> ST s (MArray s a)
A.new_ (Int -> ST s (MArray s (HashMap k v)))
-> Int -> ST s (MArray s (HashMap k v))
forall a b. (a -> b) -> a -> b
$ Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
aryA

        -- TODO: i == popCount bResult. Not sure if that would be faster.
        -- Also iA is in some relation with bA'
        let go_dWKA !Int
i !Int
iA !Word
bA' !Word
bResult !Int
nChanges
              | Word
bA' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = (Word, Int) -> ST s (Word, Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word
bResult, Int
nChanges)
              | Bool
otherwise = do
                !stA <- 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)
aryA Int
iA
                case m .&. bB of
                  Word
0 -> do
                    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
i HashMap k v
stA
                    Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
go_dWKA (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
iA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
nextBA' (Word
bResult Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Int
nChanges
                  Word
_ -> do
                    !stB <- Array (HashMap k w) -> Int -> ST s (HashMap k w)
forall a s. Array a -> Int -> ST s a
A.indexM Array (HashMap k w)
aryB (Word -> Word -> Int
sparseIndex Word
bB Word
m)
                    case go_differenceWithKey (nextShift s) stA stB of
                      HashMap k v
Empty -> Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
go_dWKA Int
i (Int
iA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
nextBA' Word
bResult (Int
nChanges Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                      HashMap k v
st -> do
                        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
i HashMap k v
st
                        let same :: Int
same = Int# -> Int
I# (HashMap k v -> HashMap k v -> Int#
forall a b. a -> b -> Int#
Exts.reallyUnsafePtrEquality# HashMap k v
st HashMap k v
stA)
                        let nChanges' :: Int
nChanges' = Int
nChanges Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
same)
                        Int -> Int -> Word -> Word -> Int -> ST s (Word, Int)
go_dWKA (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
iA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
nextBA' (Word
bResult Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
m) Int
nChanges'
              where
                m :: Word
m = Word
bA' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
bA'
                nextBA' :: Word
nextBA' = Word
bA' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m

        (bResult, nChanges) <- go_dWKA 0 0 bA 0 0
        if nChanges == 0
          then pure tA
          else case popCount bResult of
            Int
0 -> HashMap k v -> ST s (HashMap k v)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v
forall k v. HashMap k v
Empty
            Int
1 -> do
              l <- MArray s (HashMap k v) -> Int -> ST s (HashMap k v)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (HashMap k v)
mary Int
0
              if isLeafOrCollision l
                then pure l
                else BitmapIndexed bResult <$> (A.unsafeFreeze =<< A.shrink mary 1)
            Int
n -> Word -> Array (HashMap k v) -> HashMap k v
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
bResult (Array (HashMap k v) -> HashMap k v)
-> ST s (Array (HashMap k v)) -> ST s (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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) -> ST s (Array (HashMap k v)))
-> ST s (MArray s (HashMap k v)) -> ST s (Array (HashMap k v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MArray s (HashMap k v) -> Int -> ST s (MArray s (HashMap k v))
forall s a. MArray s a -> Int -> ST s (MArray s a)
A.shrink MArray s (HashMap k v)
mary Int
n)
{-# INLINE differenceWithKey #-}

-- | 'update', specialized to 'Collision' nodes.
updateCollision
  :: Eq k
  => (v -> Maybe v)
  -> Hash
  -> k
  -> A.Array (Leaf k v)
  -> HashMap k v
  -- ^ The original Collision node which will be re-used if the array is unchanged.
  -> HashMap k v
updateCollision :: forall k v.
Eq k =>
(v -> Maybe v)
-> Word -> k -> Array (Leaf k v) -> HashMap k v -> HashMap k v
updateCollision v -> Maybe v
f !Word
h k
k !Array (Leaf k v)
ary HashMap k v
orig =
  ((# #) -> HashMap k v)
-> (v -> Int -> HashMap k v)
-> k
-> Array (Leaf k v)
-> HashMap k v
forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont
    (\(# #)
_ -> HashMap k v
orig)
    (\v
v Int
i -> case v -> Maybe v
f v
v of
        Maybe v
Nothing | Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                , (# Leaf k v
l #) <- Array (Leaf k v) -> Int -> (# Leaf k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v)
ary (Int -> Int
otherOfOneOrZero Int
i)
                -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
h Leaf k v
l
                | Bool
otherwise -> Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h (Array (Leaf k v) -> Int -> Array (Leaf k v)
forall e. Array e -> Int -> Array e
A.delete Array (Leaf k v)
ary Int
i)
        Just v
v' | v
v' v -> v -> Bool
forall a. a -> a -> Bool
`ptrEq` v
v -> HashMap k v
orig
                | Bool
otherwise -> Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
h (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
v')))
    k
k Array (Leaf k v)
ary
{-# INLINABLE updateCollision #-}

-- TODO: This could be faster if we would keep track of which elements of ary2
-- we've already matched. Those could be skipped when we check the following
-- elements of ary1.
-- TODO: Return tA when the array is unchanged.
differenceWithKey_Collisions :: Eq k => (k -> v -> w -> Maybe v) -> Word -> A.Array (Leaf k v) -> HashMap k v -> Word -> A.Array (Leaf k w) -> HashMap k v
differenceWithKey_Collisions :: forall k v w.
Eq k =>
(k -> v -> w -> Maybe v)
-> Word
-> Array (Leaf k v)
-> HashMap k v
-> Word
-> Array (Leaf k w)
-> HashMap k v
differenceWithKey_Collisions k -> v -> w -> Maybe v
f !Word
hA !Array (Leaf k v)
aryA !HashMap k v
tA !Word
hB !Array (Leaf k w)
aryB
  | Word
hA Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hB =
      let f' :: Leaf k v -> Maybe (Leaf k v)
f' l :: Leaf k v
l@(L k
kA v
vA) =
           ((# #) -> Maybe (Leaf k v))
-> (w -> Int -> Maybe (Leaf k v))
-> k
-> Array (Leaf k w)
-> Maybe (Leaf k v)
forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont
             (\(# #)
_ -> Leaf k v -> Maybe (Leaf k v)
forall a. a -> Maybe a
Just Leaf k v
l)
             (\w
vB Int
_ -> k -> v -> Leaf k v
forall k v. k -> v -> Leaf k v
L k
kA (v -> Leaf k v) -> Maybe v -> Maybe (Leaf k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v -> w -> Maybe v
f k
kA v
vA w
vB)
             k
kA Array (Leaf k w)
aryB
          ary :: Array (Leaf k v)
ary = (Leaf k v -> Maybe (Leaf k v))
-> Array (Leaf k v) -> Array (Leaf k v)
forall a b. (a -> Maybe b) -> Array a -> Array b
A.mapMaybe Leaf k v -> Maybe (Leaf k v)
f' Array (Leaf k v)
aryA
      in case Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary of
        Int
0 -> HashMap k v
forall k v. HashMap k v
Empty
        Int
1 -> case Array (Leaf k v) -> Int -> (# Leaf k v #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v)
ary Int
0 of
               (# Leaf k v
l #) -> Word -> Leaf k v -> HashMap k v
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
hA Leaf k v
l
        Int
_ -> Word -> Array (Leaf k v) -> HashMap k v
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
hA Array (Leaf k v)
ary
  | Bool
otherwise = HashMap k v
tA
{-# INLINABLE differenceWithKey_Collisions #-}

-- | \(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 Word
h1 (L k
k1 v1
v1)) HashMap k v2
t2 =
      ((# #) -> HashMap k v3)
-> (v2 -> Int -> HashMap k v3)
-> Word
-> k
-> Int
-> HashMap k v2
-> HashMap k v3
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> 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' #) -> Word -> Leaf k v3 -> HashMap k v3
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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')
        Word
h1 k
k1 Int
s HashMap k v2
t2
    go Int
s HashMap k v1
t1 (Leaf Word
h2 (L k
k2 v2
v2)) =
      ((# #) -> HashMap k v3)
-> (v1 -> Int -> HashMap k v3)
-> Word
-> k
-> Int
-> HashMap k v1
-> HashMap k v3
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> 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' #) -> Word -> Leaf k v3 -> HashMap k v3
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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')
        Word
h2 k
k2 Int
s HashMap k v1
t1
    -- collision vs. collision
    go Int
_ (Collision Word
h1 Array (Leaf k v1)
ls1) (Collision Word
h2 Array (Leaf k v2)
ls2) = (k -> v1 -> v2 -> (# v3 #))
-> Word
-> Word
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
forall k v1 v2 v3.
Eq k =>
(k -> v1 -> v2 -> (# v3 #))
-> Word
-> Word
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
intersectionCollisions k -> v1 -> v2 -> (# v3 #)
f Word
h1 Word
h2 Array (Leaf k v1)
ls1 Array (Leaf k v2)
ls2
    -- branch vs. branch
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v1)
ary1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Word
-> Word
-> 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)
-> Word
-> Word
-> 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)) Word
b1 Word
b2 Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v1)
ary1) (Full Array (HashMap k v2)
ary2) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Word
-> Word
-> 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)
-> Word
-> Word
-> 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)) Word
b1 Word
fullBitmap Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    go Int
s (Full Array (HashMap k v1)
ary1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2) =
      (HashMap k v1 -> HashMap k v2 -> HashMap k v3)
-> Word
-> Word
-> 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)
-> Word
-> Word
-> 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)) Word
fullBitmap Word
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)
-> Word
-> Word
-> 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)
-> Word
-> Word
-> 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)) Word
fullBitmap Word
fullBitmap Array (HashMap k v1)
ary1 Array (HashMap k v2)
ary2
    -- collision vs. branch
    go Int
s (BitmapIndexed Word
b1 Array (HashMap k v1)
ary1) t2 :: HashMap k v2
t2@(Collision Word
h2 Array (Leaf k v2)
_ls2)
      | Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v3
forall k v. HashMap k v
Empty
      | Bool
otherwise =
          case Array (HashMap k v1) -> Int -> (# HashMap k v1 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v1)
ary1 Int
i of
            (# HashMap k v1
st1 #) -> Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) HashMap k v1
st1 HashMap k v2
t2
      where
        m2 :: Word
m2 = Word -> Int -> Word
mask Word
h2 Int
s
        i :: Int
i = Word -> Word -> Int
sparseIndex Word
b1 Word
m2
    go Int
s t1 :: HashMap k v1
t1@(Collision Word
h1 Array (Leaf k v1)
_ls1) (BitmapIndexed Word
b2 Array (HashMap k v2)
ary2)
      | Word
b2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = HashMap k v3
forall k v. HashMap k v
Empty
      | Bool
otherwise =
          case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ary2 Int
i of
            (# HashMap k v2
st2 #) -> Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 HashMap k v2
st2
      where
        m1 :: Word
m1 = Word -> Int -> Word
mask Word
h1 Int
s
        i :: Int
i = Word -> Word -> Int
sparseIndex Word
b2 Word
m1
    go Int
s (Full Array (HashMap k v1)
ary1) t2 :: HashMap k v2
t2@(Collision Word
h2 Array (Leaf k v2)
_ls2) =
      case Array (HashMap k v1) -> Int -> (# HashMap k v1 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v1)
ary1 Int
i of
        (# HashMap k v1
st1 #)-> Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) HashMap k v1
st1 HashMap k v2
t2
      where
        i :: Int
i = Word -> Int -> Int
index Word
h2 Int
s
    go Int
s t1 :: HashMap k v1
t1@(Collision Word
h1 Array (Leaf k v1)
_ls1) (Full Array (HashMap k v2)
ary2) =
      case Array (HashMap k v2) -> Int -> (# HashMap k v2 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k v2)
ary2 Int
i of
        (# HashMap k v2
st2 #) -> Int -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
go (Int -> Int
nextShift Int
s) HashMap k v1
t1 HashMap k v2
st2
      where
        i :: Int
i = Word -> Int -> Int
index Word
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)
-> Word
-> Word
-> Array (HashMap k v1)
-> Array (HashMap k v2)
-> HashMap k v3
intersectionArrayBy HashMap k v1 -> HashMap k v2 -> HashMap k v3
f !Word
b1 !Word
b2 !Array (HashMap k v1)
ary1 !Array (HashMap k v2)
ary2
  | Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
    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
$ Word -> Int
forall a. Bits a => a -> Int
popCount Word
bIntersect
    -- iterate over nonzero bits of b1 .|. b2
    let go !Int
i !Int
i1 !Int
i2 !Word
b !Word
bFinal
          | Word
b Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = (Int, Word) -> ST s (Int, Word)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, Word
bFinal)
          | Word -> Bool
testBit (Word -> Bool) -> Word -> Bool
forall a b. (a -> b) -> a -> b
$ Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b2 = do
            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
            x2 <- A.indexM ary2 i2
            case f x1 x2 of
              HashMap k v3
Empty -> Int -> Int -> Int -> Word -> Word -> ST s (Int, Word)
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) Word
b' (Word
bFinal Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
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 -> Word -> Word -> ST s (Int, Word)
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) Word
b' Word
bFinal
          | Word -> Bool
testBit Word
b1 = Int -> Int -> Int -> Word -> Word -> ST s (Int, Word)
go Int
i (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
i2 Word
b' Word
bFinal
          | Bool
otherwise = Int -> Int -> Int -> Word -> Word -> ST s (Int, Word)
go Int
i Int
i1 (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
b' Word
bFinal
          where
            m :: Word
m = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
b
            testBit :: Word -> Bool
testBit Word
x = Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
            b' :: Word
b' = Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m
    (len, bFinal) <- go 0 0 0 bCombined bIntersect
    case 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
        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 isLeafOrCollision l
          then pure l
          else BitmapIndexed bFinal <$> (A.unsafeFreeze =<< A.shrink mary 1)
      Int
_ -> Word -> Array (HashMap k v3) -> HashMap k v3
forall k v. Word -> Array (HashMap k v) -> HashMap k v
bitmapIndexedOrFull Word
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 :: Word
bCombined = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b2
    bIntersect :: Word
bIntersect = Word
b1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
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 #))
-> Word
-> Word
-> Array (Leaf k v1)
-> Array (Leaf k v2)
-> HashMap k v3
intersectionCollisions k -> v1 -> v2 -> (# v3 #)
f Word
h1 Word
h2 Array (Leaf k v1)
ary1 Array (Leaf k v2)
ary2
  | Word
h1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
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
    let !n2 :: Int
n2 = Array (Leaf k v2) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v2)
ary2
    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
n2
    mary <- A.new_ $ min (A.length ary1) n2
    let 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
>= Int
n2 = 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 k1 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
            searchSwap mary2 n2 k1 j >>= \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
    len <- go 0 0
    case 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 -> Word -> Leaf k v3 -> HashMap k v3
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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
_ -> Word -> Array (Leaf k v3) -> HashMap k v3
forall k v. Word -> Array (Leaf k v) -> HashMap k v
Collision Word
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 => A.MArray s (Leaf k v) -> Int -> k -> Int -> ST s (Maybe (Leaf k v))
searchSwap :: forall k s v.
Eq k =>
MArray s (Leaf k v) -> Int -> k -> Int -> ST s (Maybe (Leaf k v))
searchSwap MArray s (Leaf k v)
mary Int
n k
toFind Int
start = Int -> k -> Int -> ST s (Maybe (Leaf k v))
go Int
start k
toFind Int
start
  where
    go :: Int -> k -> Int -> ST s (Maybe (Leaf k v))
go Int
i0 k
k Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Maybe (Leaf k v) -> ST s (Maybe (Leaf k v))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Leaf k v)
forall a. Maybe a
Nothing
      | Bool
otherwise = do
        l@(L k' _v) <- MArray s (Leaf k v) -> Int -> ST s (Leaf k v)
forall s a. MArray s a -> Int -> ST s a
A.read MArray s (Leaf k v)
mary Int
i
        if k == k'
          then do
            A.write mary i =<< A.read mary i0
            pure $ Just l
          else go i0 k (i + 1)
{-# INLINE searchSwap #-}

-- | \(O(n \log m)\) Check whether the key sets of two maps are disjoint
-- (i.e., their 'intersection' is empty).
--
-- @
-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
-- @
--
-- @since 0.2.21
disjoint :: Eq k => HashMap k a -> HashMap k b -> Bool
disjoint :: forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
disjoint = Int -> HashMap k a -> HashMap k b -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees Int
0
{-# INLINE disjoint #-}

-- Note that as of GHC 9.12, SpecConstr creates a specialized worker for
-- handling the Collision vs. {BitmapIndexed,Full} and vice-versa cases,
-- but this worker fails to be properly specialized for different key
-- types. See https://gitlab.haskell.org/ghc/ghc/-/issues/26615.
disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees :: forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees !Int
_s HashMap k a
Empty HashMap k b
_b = Bool
True
disjointSubtrees Int
s (Leaf Word
hA (L k
kA a
_)) HashMap k b
b =
  ((# #) -> Bool)
-> (b -> Int -> Bool) -> Word -> k -> Int -> HashMap k b -> Bool
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> Bool
True) (\b
_ Int
_ -> Bool
False) Word
hA k
kA Int
s HashMap k b
b
disjointSubtrees Int
s (BitmapIndexed Word
bmA Array (HashMap k a)
aryA) (BitmapIndexed Word
bmB Array (HashMap k b)
aryB) =
  -- We could do a pointer equality check here but it's probably not worth it
  -- since it would save only O(1) extra work:
  --
  -- not (aryA `A.unsafeSameArray` aryB) &&
  Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
forall k a b.
Eq k =>
Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
disjointArrays Int
s Word
bmA Array (HashMap k a)
aryA Word
bmB Array (HashMap k b)
aryB
disjointSubtrees Int
s (BitmapIndexed Word
bmA Array (HashMap k a)
aryA) (Full Array (HashMap k b)
aryB) =
  Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
forall k a b.
Eq k =>
Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
disjointArrays Int
s Word
bmA Array (HashMap k a)
aryA Word
fullBitmap Array (HashMap k b)
aryB
disjointSubtrees Int
s (Full Array (HashMap k a)
aryA) (BitmapIndexed Word
bmB Array (HashMap k b)
aryB) =
  Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
forall k a b.
Eq k =>
Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
disjointArrays Int
s Word
fullBitmap Array (HashMap k a)
aryA Word
bmB Array (HashMap k b)
aryB
disjointSubtrees Int
s (Full Array (HashMap k a)
aryA) (Full Array (HashMap k b)
aryB) =
    -- We could do a pointer equality check here but it's probably not worth it
    -- since it would save only O(1) extra work:
    --
    -- not (aryA `A.unsafeSameArray` aryB) &&
    Int -> Bool
go (Int
maxChildren Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> Bool
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
True
      | Bool
otherwise = case Array (HashMap k a) -> Int -> (# HashMap k a #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k a)
aryA Int
i of
          (# HashMap k a
stA #) -> case Array (HashMap k b) -> Int -> (# HashMap k b #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k b)
aryB Int
i of
            (# HashMap k b
stB #) ->
              Int -> HashMap k a -> HashMap k b -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees (Int -> Int
nextShift Int
s) HashMap k a
stA HashMap k b
stB Bool -> Bool -> Bool
&&
              Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
disjointSubtrees Int
s a :: HashMap k a
a@(Collision Word
hA Array (Leaf k a)
_) (BitmapIndexed Word
bmB Array (HashMap k b)
aryB)
  | Word
m Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bmB Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Bool
True
  | Bool
otherwise = case Array (HashMap k b) -> Int -> (# HashMap k b #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k b)
aryB Int
i of
      (# HashMap k b
stB #) -> Int -> HashMap k a -> HashMap k b -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees (Int -> Int
nextShift Int
s) HashMap k a
a HashMap k b
stB
  where
    m :: Word
m = Word -> Int -> Word
mask Word
hA Int
s
    i :: Int
i = Word -> Word -> Int
sparseIndex Word
bmB Word
m
disjointSubtrees Int
s a :: HashMap k a
a@(Collision Word
hA Array (Leaf k a)
_) (Full Array (HashMap k b)
aryB) =
  case Array (HashMap k b) -> Int -> (# HashMap k b #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k b)
aryB (Word -> Int -> Int
index Word
hA Int
s) of
    (# HashMap k b
stB #) -> Int -> HashMap k a -> HashMap k b -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees (Int -> Int
nextShift Int
s) HashMap k a
a HashMap k b
stB
disjointSubtrees Int
_ (Collision Word
hA Array (Leaf k a)
aryA) (Collision Word
hB Array (Leaf k b)
aryB) =
  Word -> Array (Leaf k a) -> Word -> Array (Leaf k b) -> Bool
forall k a b.
Eq k =>
Word -> Array (Leaf k a) -> Word -> Array (Leaf k b) -> Bool
disjointCollisions Word
hA Array (Leaf k a)
aryA Word
hB Array (Leaf k b)
aryB
disjointSubtrees Int
_s HashMap k a
_a HashMap k b
Empty = Bool
True
disjointSubtrees Int
s HashMap k a
a (Leaf Word
hB (L k
kB b
_)) =
  ((# #) -> Bool)
-> (a -> Int -> Bool) -> Word -> k -> Int -> HashMap k a -> Bool
forall r k v.
Eq k =>
((# #) -> r)
-> (v -> Int -> r) -> Word -> k -> Int -> HashMap k v -> r
lookupCont (\(# #)
_ -> Bool
True) (\a
_ Int
_ -> Bool
False) Word
hB k
kB Int
s HashMap k a
a
disjointSubtrees Int
s HashMap k a
a b :: HashMap k b
b@Collision{} = Int -> HashMap k b -> HashMap k a -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees Int
s HashMap k b
b HashMap k a
a
{-# INLINABLE disjointSubtrees #-}

disjointArrays :: Eq k => Shift -> Bitmap -> A.Array (HashMap k a) -> Bitmap -> A.Array (HashMap k b) -> Bool
disjointArrays :: forall k a b.
Eq k =>
Int
-> Word
-> Array (HashMap k a)
-> Word
-> Array (HashMap k b)
-> Bool
disjointArrays !Int
s !Word
bmA !Array (HashMap k a)
aryA !Word
bmB !Array (HashMap k b)
aryB = Word -> Bool
go (Word
bmA Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bmB)
  where
    go :: Word -> Bool
go Word
0 = Bool
True
    go Word
bm = case Array (HashMap k a) -> Int -> (# HashMap k a #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k a)
aryA Int
iA of
        (# HashMap k a
stA #) -> case Array (HashMap k b) -> Int -> (# HashMap k b #)
forall a. Array a -> Int -> (# a #)
A.index# Array (HashMap k b)
aryB Int
iB of
          (# HashMap k b
stB #) ->
            Int -> HashMap k a -> HashMap k b -> Bool
forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool
disjointSubtrees (Int -> Int
nextShift Int
s) HashMap k a
stA HashMap k b
stB Bool -> Bool -> Bool
&&
            Word -> Bool
go (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m)
      where
        m :: Word
m = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
bm
        iA :: Int
iA = Word -> Word -> Int
sparseIndex Word
bmA Word
m
        iB :: Int
iB = Word -> Word -> Int
sparseIndex Word
bmB Word
m
{-# INLINE disjointArrays #-}

-- TODO: GHC 9.12.2 inlines disjointCollisions into `disjoint @Int`.
-- How do you prevent this while preserving specialization?
-- https://stackoverflow.com/questions/79838305/ensuring-specialization-while-preventing-inlining
disjointCollisions :: Eq k => Hash -> A.Array (Leaf k a) -> Hash -> A.Array (Leaf k b) -> Bool
disjointCollisions :: forall k a b.
Eq k =>
Word -> Array (Leaf k a) -> Word -> Array (Leaf k b) -> Bool
disjointCollisions !Word
hA !Array (Leaf k a)
aryA !Word
hB !Array (Leaf k b)
aryB
  | Word
hA Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hB = (Leaf k a -> Bool) -> Array (Leaf k a) -> Bool
forall a. (a -> Bool) -> Array a -> Bool
A.all Leaf k a -> Bool
predicate Array (Leaf k a)
aryA
  | Bool
otherwise = Bool
True
  where
    predicate :: Leaf k a -> Bool
predicate (L k
kA a
_) = ((# #) -> Bool)
-> (b -> Int -> Bool) -> k -> Array (Leaf k b) -> Bool
forall r k v.
Eq k =>
((# #) -> r) -> (v -> Int -> r) -> k -> Array (Leaf k v) -> r
lookupInArrayCont (\(# #)
_ -> Bool
True) (\b
_ Int
_ -> Bool
False) k
kA Array (Leaf k b)
aryB
{-# INLINABLE disjointCollisions #-}

------------------------------------------------------------------------
-- * 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 Word
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Word
_ 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 Word
_ 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 Word
_ (L k
k v
v)) !a
z     = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Word
_ 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 Word
_ 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 Word
_ (L k
k v
v)) a
z      = k -> v -> a -> a
f k
k v
v a
z
    go (BitmapIndexed Word
_ 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 Word
_ 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 Word
_ (L k
k v
v))      = a -> k -> v -> a
f a
z k
k v
v
    go a
z (BitmapIndexed Word
_ 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 Word
_ 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 Word
_ (L k
k v
v)) = k -> v -> m
f k
k v
v
    go (BitmapIndexed Word
_ 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 Word
_ 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 Word
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 (Word -> Leaf k v2 -> HashMap k v2
forall k v. Word -> Leaf k v -> HashMap k v
Leaf Word
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 Word
_ (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 Word
b Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Word -> HashMap k v2
filterA Array (HashMap k v1)
ary Word
b
    go (Full Array (HashMap k v1)
ary) = Array (HashMap k v1) -> Word -> HashMap k v2
filterA Array (HashMap k v1)
ary Word
fullBitmap
    go (Collision Word
h Array (Leaf k v1)
ary) = Array (Leaf k v1) -> Word -> HashMap k v2
filterC Array (Leaf k v1)
ary Word
h

    filterA :: Array (HashMap k v1) -> Word -> HashMap k v2
filterA Array (HashMap k v1)
ary0 Word
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
            mary <- Int -> ST s (MArray s (HashMap k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            step ary0 mary b0 0 0 1 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)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
step !Array (HashMap k v1)
ary !MArray s (HashMap k v2)
mary !Word
b Int
i !Int
j !Word
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
                    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 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
_ -> Word -> Array (HashMap k v2) -> HashMap k v2
forall k v. Word -> Array (HashMap k v) -> HashMap k v
BitmapIndexed Word
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
                    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
                    return $! if j == maxChildren
                              then Full ary2
                              else BitmapIndexed b ary2
            | Word
bi Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
b Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary Word
b Int
i Int
j (Word
bi Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int
n
            | Bool
otherwise = do
                st <- 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)
ary Int
i
                case go st of
                  HashMap k v2
Empty ->
                    Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bi) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j (Word
bi Word -> Int -> Word
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)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
forall s.
Array (HashMap k v1)
-> MArray s (HashMap k v2)
-> Word
-> Int
-> Int
-> Word
-> Int
-> ST s (HashMap k v2)
step Array (HashMap k v1)
ary MArray s (HashMap k v2)
mary Word
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) (Word
bi Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int
n

    filterC :: Array (Leaf k v1) -> Word -> HashMap k v2
filterC Array (Leaf k v1)
ary0 Word
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
            mary <- Int -> ST s (MArray s (Leaf k v2))
forall s a. Int -> ST s (MArray s a)
A.new_ Int
n
            step ary0 mary 0 0 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 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
                        return $! Leaf h l
                Int
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> do 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
                                 return $! Collision h ary2
                  | Bool
otherwise -> do 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
                                    return $! Collision h ary2
            | (# Leaf k v1
l #) <- Array (Leaf k v1) -> Int -> (# Leaf k v1 #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Leaf k v1)
ary Int
i
            , Just Leaf k v2
el <- Leaf k v1 -> Maybe (Leaf k v2)
onColl Leaf k v1
l
                = 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, and it may
-- change from version to version of either this package or of @hashable@.
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 \log n)\) Construct a map with the supplied mappings.  If the list
-- contains duplicate mappings, the later mappings take precedence.
fromList :: Hashable k => [(k, v)] -> HashMap k v
fromList :: forall k v. 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. 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 :: Hashable k => (v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWith :: forall k v. 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.
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 :: Hashable k => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWithKey :: forall k v.
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.
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 ::
#if defined(__GLASGOW_HASKELL__)
  forall rep (r :: TYPE rep) k v.
#else
  forall r k v.
#endif
  Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
lookupInArrayCont :: 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
lookupInArrayCont_ 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
    lookupInArrayCont_ :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
    lookupInArrayCont_ :: Eq k => k -> Array (Leaf k v) -> Int -> Int -> r
lookupInArrayCont_ !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
lookupInArrayCont_ 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
        | 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 k -> v -> v -> (# v #)
f k
k v
v v
y of
                                            (# v
v2 #) -> 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
    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)
    A.copy ary1 0 mary 0 n1
    -- append or update all elements from ary2
    let 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 ()
          | (# Just Int
i1 #) <- Array (Maybe Int) -> Int -> (# Maybe Int #)
forall a. Array a -> Int -> (# a #)
A.index# Array (Maybe Int)
indices Int
i2 = do
              -- key occurs in both arrays, store combination in position i1
              L k 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 _ v2 <- A.indexM ary2 i2
              case f k v1 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)
              go iEnd (i2+1)
          | Bool
otherwise = 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)
    go n1 0
    return 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.
updateFullArray :: A.Array e -> Int -> e -> A.Array e
updateFullArray :: forall e. Array e -> Int -> e -> Array e
updateFullArray 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)
updateFullArrayM Array e
ary Int
idx e
b)
{-# INLINE updateFullArray #-}

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

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

-- | 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.
--
-- Note that this constant is platform-dependent. On 32-bit platforms we use
-- '4', because bitmaps using '2^5' bits turned out to be prone to integer
-- overflow bugs. See #491 for instance.
bitsPerSubkey :: Int
#if WORD_SIZE_IN_BITS < 64
bitsPerSubkey = 4
#else
bitsPerSubkey :: Int
bitsPerSubkey = Int
5
#endif

-- | 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 :: Word
subkeyMask = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitsPerSubkey Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
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 :: Word -> Int -> Int
index Word
w Int
s = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR Word
w Int
s Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
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 :: Word -> Int -> Word
mask Word
w Int
s = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word -> Int -> Int
index Word
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 :: Word -> Word -> Int
sparseIndex Word
b Word
m = Word -> Int
forall a. Bits a => a -> Int
popCount (Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
m Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
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 :: Word
fullBitmap = Word -> Word
forall a. Bits a => a -> a
complement (Word -> Word
forall a. Bits a => a -> a
complement Word
0 Word -> Int -> Word
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 #-}

------------------------------------------------------------------------
-- ShiftedHash

-- | Sometimes it's more efficient to right-shift the hashes directly instead
-- of keeping track of an additional 'Shift' value.
type ShiftedHash = Hash

{-
-- | Construct a 'ShiftedHash' from a 'Shift' and a 'Hash'.
shiftHash :: Shift -> Hash -> ShiftedHash
shiftHash s h = h `unsafeShiftR` s
{-# INLINE shiftHash #-}
-}

-- | Update a 'ShiftedHash' for the next level of the tree.
nextSH :: ShiftedHash -> ShiftedHash
nextSH :: Word -> Word
nextSH Word
sh = Word
sh Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitsPerSubkey
{-# INLINE nextSH #-}

-- | Version of 'index' for use with @'ShiftedHash'es@.
indexSH :: ShiftedHash -> Int
indexSH :: Word -> Int
indexSH Word
sh = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
sh Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
subkeyMask
{-# INLINE indexSH #-}

-- | Version of 'mask' for use with @'ShiftedHash'es@.
maskSH :: ShiftedHash -> Bitmap
maskSH :: Word -> Word
maskSH Word
sh = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word -> Int
indexSH Word
sh
{-# INLINE maskSH #-}

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

------------------------------------------------------------------------
-- Array index arithmetic

-- |
-- >>> otherOfOneOrZero 0
-- 1
-- >>> otherOfOneOrZero 1
-- 0
otherOfOneOrZero :: Int -> Int
otherOfOneOrZero :: Int -> Int
otherOfOneOrZero Int
i = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
{-# INLINE otherOfOneOrZero #-}

#if defined(__GLASGOW_HASKELL__)
------------------------------------------------------------------------
-- IsList instance
instance 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. 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
#endif