1{-# LANGUAGE BangPatterns, CPP, PatternGuards, MagicHash, UnboxedTuples #-} 2{-# LANGUAGE LambdaCase #-} 3{-# LANGUAGE Trustworthy #-} 4{-# OPTIONS_HADDOCK not-home #-} 5 6------------------------------------------------------------------------ 7-- | 8-- Module : Data.HashMap.Strict 9-- Copyright : 2010-2012 Johan Tibell 10-- License : BSD-style 11-- Maintainer : johan.tibell@gmail.com 12-- Portability : portable 13-- 14-- = WARNING 15-- 16-- This module is considered __internal__. 17-- 18-- The Package Versioning Policy __does not apply__. 19-- 20-- The contents of this module may change __in any way whatsoever__ 21-- and __without any warning__ between minor versions of this package. 22-- 23-- Authors importing this module are expected to track development 24-- closely. 25-- 26-- = Description 27-- 28-- A map from /hashable/ keys to values. A map cannot contain 29-- duplicate keys; each key can map to at most one value. A 'HashMap' 30-- makes no guarantees as to the order of its elements. 31-- 32-- The implementation is based on /hash array mapped tries/. A 33-- 'HashMap' is often faster than other tree-based set types, 34-- especially when key comparison is expensive, as in the case of 35-- strings. 36-- 37-- Many operations have a average-case complexity of /O(log n)/. The 38-- implementation uses a large base (i.e. 16) so in practice these 39-- operations are constant time. 40module Data.HashMap.Internal.Strict 41 ( 42 -- * Strictness properties 43 -- $strictness 44 45 HashMap 46 47 -- * Construction 48 , empty 49 , singleton 50 51 -- * Basic interface 52 , HM.null 53 , size 54 , HM.member 55 , HM.lookup 56 , (HM.!?) 57 , HM.findWithDefault 58 , lookupDefault 59 , (!) 60 , insert 61 , insertWith 62 , delete 63 , adjust 64 , update 65 , alter 66 , alterF 67 , isSubmapOf 68 , isSubmapOfBy 69 70 -- * Combine 71 -- ** Union 72 , union 73 , unionWith 74 , unionWithKey 75 , unions 76 77 -- ** Compose 78 , compose 79 80 -- * Transformations 81 , map 82 , mapWithKey 83 , traverseWithKey 84 85 -- * Difference and intersection 86 , difference 87 , differenceWith 88 , intersection 89 , intersectionWith 90 , intersectionWithKey 91 92 -- * Folds 93 , foldMapWithKey 94 , foldr' 95 , foldl' 96 , foldrWithKey' 97 , foldlWithKey' 98 , HM.foldr 99 , HM.foldl 100 , foldrWithKey 101 , foldlWithKey 102 103 -- * Filter 104 , HM.filter 105 , filterWithKey 106 , mapMaybe 107 , mapMaybeWithKey 108 109 -- * Conversions 110 , keys 111 , elems 112 113 -- ** Lists 114 , toList 115 , fromList 116 , fromListWith 117 , fromListWithKey 118 ) where 119 120import Data.Bits ((.&.), (.|.)) 121 122#if !MIN_VERSION_base(4,8,0) 123import Control.Applicative (Applicative (..), (<$>)) 124#endif 125import qualified Data.List as L 126import Data.Hashable (Hashable) 127import Prelude hiding (map, lookup) 128 129import qualified Data.HashMap.Internal.Array as A 130import qualified Data.HashMap.Internal as HM 131import Data.HashMap.Internal hiding ( 132 alter, alterF, adjust, fromList, fromListWith, fromListWithKey, 133 insert, insertWith, 134 differenceWith, intersectionWith, intersectionWithKey, map, mapWithKey, 135 mapMaybe, mapMaybeWithKey, singleton, update, unionWith, unionWithKey, 136 traverseWithKey) 137import Data.HashMap.Internal.Unsafe (runST) 138#if MIN_VERSION_base(4,8,0) 139import Data.Functor.Identity 140#endif 141import Control.Applicative (Const (..)) 142import Data.Coerce 143 144-- $strictness 145-- 146-- This module satisfies the following strictness properties: 147-- 148-- 1. Key arguments are evaluated to WHNF; 149-- 150-- 2. Keys and values are evaluated to WHNF before they are stored in 151-- the map. 152 153------------------------------------------------------------------------ 154-- * Construction 155 156-- | /O(1)/ Construct a map with a single element. 157singleton :: (Hashable k) => k -> v -> HashMap k v 158singleton k !v = HM.singleton k v 159 160------------------------------------------------------------------------ 161-- * Basic interface 162 163-- | /O(log n)/ Associate the specified value with the specified 164-- key in this map. If this map previously contained a mapping for 165-- the key, the old value is replaced. 166insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v 167insert k !v = HM.insert k v 168{-# INLINABLE insert #-} 169 170-- | /O(log n)/ Associate the value with the key in this map. If 171-- this map previously contained a mapping for the key, the old value 172-- is replaced by the result of applying the given function to the new 173-- and old value. Example: 174-- 175-- > insertWith f k v map 176-- > where f new old = new + old 177insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v 178 -> HashMap k v 179insertWith f k0 v0 m0 = go h0 k0 v0 0 m0 180 where 181 h0 = hash k0 182 go !h !k x !_ Empty = leaf h k x 183 go h k x s t@(Leaf hy l@(L ky y)) 184 | hy == h = if ky == k 185 then leaf h k (f x y) 186 else x `seq` (collision h l (L k x)) 187 | otherwise = x `seq` runST (two s h k x hy t) 188 go h k x s (BitmapIndexed b ary) 189 | b .&. m == 0 = 190 let ary' = A.insert ary i $! leaf h k x 191 in bitmapIndexedOrFull (b .|. m) ary' 192 | otherwise = 193 let st = A.index ary i 194 st' = go h k x (s+bitsPerSubkey) st 195 ary' = A.update ary i $! st' 196 in BitmapIndexed b ary' 197 where m = mask h s 198 i = sparseIndex b m 199 go h k x s (Full ary) = 200 let st = A.index ary i 201 st' = go h k x (s+bitsPerSubkey) st 202 ary' = update16 ary i $! st' 203 in Full ary' 204 where i = index h s 205 go h k x s t@(Collision hy v) 206 | h == hy = Collision h (updateOrSnocWith f k x v) 207 | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) 208{-# INLINABLE insertWith #-} 209 210-- | In-place update version of insertWith 211unsafeInsertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v 212 -> HashMap k v 213unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0 214{-# INLINABLE unsafeInsertWith #-} 215 216unsafeInsertWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v 217 -> HashMap k v 218unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0) 219 where 220 h0 = hash k0 221 go !h !k x !_ Empty = return $! leaf h k x 222 go h k x s t@(Leaf hy l@(L ky y)) 223 | hy == h = if ky == k 224 then return $! leaf h k (f k x y) 225 else do 226 let l' = x `seq` (L k x) 227 return $! collision h l l' 228 | otherwise = x `seq` two s h k x hy t 229 go h k x s t@(BitmapIndexed b ary) 230 | b .&. m == 0 = do 231 ary' <- A.insertM ary i $! leaf h k x 232 return $! bitmapIndexedOrFull (b .|. m) ary' 233 | otherwise = do 234 st <- A.indexM ary i 235 st' <- go h k x (s+bitsPerSubkey) st 236 A.unsafeUpdateM ary i st' 237 return t 238 where m = mask h s 239 i = sparseIndex b m 240 go h k x s t@(Full ary) = do 241 st <- A.indexM ary i 242 st' <- go h k x (s+bitsPerSubkey) st 243 A.unsafeUpdateM ary i st' 244 return t 245 where i = index h s 246 go h k x s t@(Collision hy v) 247 | h == hy = return $! Collision h (updateOrSnocWithKey f k x v) 248 | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) 249{-# INLINABLE unsafeInsertWithKey #-} 250 251-- | /O(log n)/ Adjust the value tied to a given key in this map only 252-- if it is present. Otherwise, leave the map alone. 253adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v 254adjust f k0 m0 = go h0 k0 0 m0 255 where 256 h0 = hash k0 257 go !_ !_ !_ Empty = Empty 258 go h k _ t@(Leaf hy (L ky y)) 259 | hy == h && ky == k = leaf h k (f y) 260 | otherwise = t 261 go h k s t@(BitmapIndexed b ary) 262 | b .&. m == 0 = t 263 | otherwise = let st = A.index ary i 264 st' = go h k (s+bitsPerSubkey) st 265 ary' = A.update ary i $! st' 266 in BitmapIndexed b ary' 267 where m = mask h s 268 i = sparseIndex b m 269 go h k s (Full ary) = 270 let i = index h s 271 st = A.index ary i 272 st' = go h k (s+bitsPerSubkey) st 273 ary' = update16 ary i $! st' 274 in Full ary' 275 go h k _ t@(Collision hy v) 276 | h == hy = Collision h (updateWith f k v) 277 | otherwise = t 278{-# INLINABLE adjust #-} 279 280-- | /O(log n)/ The expression @('update' f k map)@ updates the value @x@ at @k@ 281-- (if it is in the map). If @(f x)@ is 'Nothing', the element is deleted. 282-- If it is @('Just' y)@, the key @k@ is bound to the new value @y@. 283update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a 284update f = alter (>>= f) 285{-# INLINABLE update #-} 286 287-- | /O(log n)/ The expression @('alter' f k map)@ alters the value @x@ at @k@, or 288-- absence thereof. 289-- 290-- 'alter' can be used to insert, delete, or update a value in a map. In short: 291-- 292-- @ 293-- 'lookup' k ('alter' f k m) = f ('lookup' k m) 294-- @ 295alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v 296alter f k m = 297 case f (HM.lookup k m) of 298 Nothing -> delete k m 299 Just v -> insert k v m 300{-# INLINABLE alter #-} 301 302-- | /O(log n)/ The expression (@'alterF' f k map@) alters the value @x@ at 303-- @k@, or absence thereof. 304-- 305-- 'alterF' can be used to insert, delete, or update a value in a map. 306-- 307-- Note: 'alterF' is a flipped version of the 'at' combinator from 308-- <https://hackage.haskell.org/package/lens/docs/Control-Lens-At.html#v:at Control.Lens.At>. 309-- 310-- @since 0.2.10 311alterF :: (Functor f, Eq k, Hashable k) 312 => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v) 313-- Special care is taken to only calculate the hash once. When we rewrite 314-- with RULES, we also ensure that we only compare the key for equality 315-- once. We force the value of the map for consistency with the rewritten 316-- version; otherwise someone could tell the difference using a lazy 317-- @f@ and a functor that is similar to Const but not actually Const. 318alterF f = \ !k !m -> 319 let !h = hash k 320 mv = lookup' h k m 321 in (<$> f mv) $ \fres -> 322 case fres of 323 Nothing -> maybe m (const (delete' h k m)) mv 324 Just !v' -> insert' h k v' m 325 326-- We rewrite this function unconditionally in RULES, but we expose 327-- an unfolding just in case it's used in a context where the rules 328-- don't fire. 329{-# INLINABLE [0] alterF #-} 330 331#if MIN_VERSION_base(4,8,0) 332-- See notes in Data.HashMap.Internal 333test_bottom :: a 334test_bottom = error "Data.HashMap.alterF internal error: hit test_bottom" 335 336bogus# :: (# #) -> (# a #) 337bogus# _ = error "Data.HashMap.alterF internal error: hit bogus#" 338 339impossibleAdjust :: a 340impossibleAdjust = error "Data.HashMap.alterF internal error: impossible adjust" 341 342{-# RULES 343 344-- See detailed notes on alterF rules in Data.HashMap.Internal. 345 346"alterFWeird" forall f. alterF f = 347 alterFWeird (f Nothing) (f (Just test_bottom)) f 348 349"alterFconstant" forall (f :: Maybe a -> Identity (Maybe a)) x. 350 alterFWeird x x f = \ !k !m -> 351 Identity (case runIdentity x of {Nothing -> delete k m; Just a -> insert k a m}) 352 353"alterFinsertWith" [1] forall (f :: Maybe a -> Identity (Maybe a)) x y. 354 alterFWeird (coerce (Just x)) (coerce (Just y)) f = 355 coerce (insertModifying x (\mold -> case runIdentity (f (Just mold)) of 356 Nothing -> bogus# (# #) 357 Just !new -> (# new #))) 358 359-- This rule is written a bit differently than the one for lazy 360-- maps because the adjust here is strict. We could write it the 361-- same general way anyway, but this seems simpler. 362"alterFadjust" forall (f :: Maybe a -> Identity (Maybe a)) x. 363 alterFWeird (coerce Nothing) (coerce (Just x)) f = 364 coerce (adjust (\a -> case runIdentity (f (Just a)) of 365 Just a' -> a' 366 Nothing -> impossibleAdjust)) 367 368"alterFlookup" forall _ign1 _ign2 (f :: Maybe a -> Const r (Maybe a)) . 369 alterFWeird _ign1 _ign2 f = \ !k !m -> Const (getConst (f (lookup k m))) 370 #-} 371 372-- This is a very unsafe version of alterF used for RULES. When calling 373-- alterFWeird x y f, the following *must* hold: 374-- 375-- x = f Nothing 376-- y = f (Just _|_) 377-- 378-- Failure to abide by these laws will make demons come out of your nose. 379alterFWeird 380 :: (Functor f, Eq k, Hashable k) 381 => f (Maybe v) 382 -> f (Maybe v) 383 -> (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v) 384alterFWeird _ _ f = alterFEager f 385{-# INLINE [0] alterFWeird #-} 386 387-- | This is the default version of alterF that we use in most non-trivial 388-- cases. It's called "eager" because it looks up the given key in the map 389-- eagerly, whether or not the given function requires that information. 390alterFEager :: (Functor f, Eq k, Hashable k) 391 => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v) 392alterFEager f !k !m = (<$> f mv) $ \fres -> 393 case fres of 394 395 ------------------------------ 396 -- Delete the key from the map. 397 Nothing -> case lookupRes of 398 399 -- Key did not exist in the map to begin with, no-op 400 Absent -> m 401 402 -- Key did exist, no collision 403 Present _ collPos -> deleteKeyExists collPos h k m 404 405 ------------------------------ 406 -- Update value 407 Just v' -> case lookupRes of 408 409 -- Key did not exist before, insert v' under a new key 410 Absent -> insertNewKey h k v' m 411 412 -- Key existed before, no hash collision 413 Present v collPos -> v' `seq` 414 if v `ptrEq` v' 415 -- If the value is identical, no-op 416 then m 417 -- If the value changed, update the value. 418 else insertKeyExists collPos h k v' m 419 420 where !h = hash k 421 !lookupRes = lookupRecordCollision h k m 422 !mv = case lookupRes of 423 Absent -> Nothing 424 Present v _ -> Just v 425{-# INLINABLE alterFEager #-} 426#endif 427 428------------------------------------------------------------------------ 429-- * Combine 430 431-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, 432-- the provided function (first argument) will be used to compute the result. 433unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v 434 -> HashMap k v 435unionWith f = unionWithKey (const f) 436{-# INLINE unionWith #-} 437 438-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, 439-- the provided function (first argument) will be used to compute the result. 440unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v 441 -> HashMap k v 442unionWithKey f = go 0 443 where 444 -- empty vs. anything 445 go !_ t1 Empty = t1 446 go _ Empty t2 = t2 447 -- leaf vs. leaf 448 go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2)) 449 | h1 == h2 = if k1 == k2 450 then leaf h1 k1 (f k1 v1 v2) 451 else collision h1 l1 l2 452 | otherwise = goDifferentHash s h1 h2 t1 t2 453 go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2) 454 | h1 == h2 = Collision h1 (updateOrSnocWithKey f k1 v1 ls2) 455 | otherwise = goDifferentHash s h1 h2 t1 t2 456 go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2)) 457 | h1 == h2 = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1) 458 | otherwise = goDifferentHash s h1 h2 t1 t2 459 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2) 460 | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2) 461 | otherwise = goDifferentHash s h1 h2 t1 t2 462 -- branch vs. branch 463 go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) = 464 let b' = b1 .|. b2 465 ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2 466 in bitmapIndexedOrFull b' ary' 467 go s (BitmapIndexed b1 ary1) (Full ary2) = 468 let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2 469 in Full ary' 470 go s (Full ary1) (BitmapIndexed b2 ary2) = 471 let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2 472 in Full ary' 473 go s (Full ary1) (Full ary2) = 474 let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask 475 ary1 ary2 476 in Full ary' 477 -- leaf vs. branch 478 go s (BitmapIndexed b1 ary1) t2 479 | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2 480 b' = b1 .|. m2 481 in bitmapIndexedOrFull b' ary' 482 | otherwise = let ary' = A.updateWith' ary1 i $ \st1 -> 483 go (s+bitsPerSubkey) st1 t2 484 in BitmapIndexed b1 ary' 485 where 486 h2 = leafHashCode t2 487 m2 = mask h2 s 488 i = sparseIndex b1 m2 489 go s t1 (BitmapIndexed b2 ary2) 490 | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1 491 b' = b2 .|. m1 492 in bitmapIndexedOrFull b' ary' 493 | otherwise = let ary' = A.updateWith' ary2 i $ \st2 -> 494 go (s+bitsPerSubkey) t1 st2 495 in BitmapIndexed b2 ary' 496 where 497 h1 = leafHashCode t1 498 m1 = mask h1 s 499 i = sparseIndex b2 m1 500 go s (Full ary1) t2 = 501 let h2 = leafHashCode t2 502 i = index h2 s 503 ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 504 in Full ary' 505 go s t1 (Full ary2) = 506 let h1 = leafHashCode t1 507 i = index h1 s 508 ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 509 in Full ary' 510 511 leafHashCode (Leaf h _) = h 512 leafHashCode (Collision h _) = h 513 leafHashCode _ = error "leafHashCode" 514 515 goDifferentHash s h1 h2 t1 t2 516 | m1 == m2 = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2) 517 | m1 < m2 = BitmapIndexed (m1 .|. m2) (A.pair t1 t2) 518 | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1) 519 where 520 m1 = mask h1 s 521 m2 = mask h2 s 522{-# INLINE unionWithKey #-} 523 524------------------------------------------------------------------------ 525-- * Transformations 526 527-- | /O(n)/ Transform this map by applying a function to every value. 528mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2 529mapWithKey f = go 530 where 531 go Empty = Empty 532 go (Leaf h (L k v)) = leaf h k (f k v) 533 go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary 534 go (Full ary) = Full $ A.map' go ary 535 go (Collision h ary) = 536 Collision h $ A.map' (\ (L k v) -> let !v' = f k v in L k v') ary 537{-# INLINE mapWithKey #-} 538 539-- | /O(n)/ Transform this map by applying a function to every value. 540map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 541map f = mapWithKey (const f) 542{-# INLINE map #-} 543 544 545------------------------------------------------------------------------ 546-- * Filter 547 548-- | /O(n)/ Transform this map by applying a function to every value 549-- and retaining only some of them. 550mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 551mapMaybeWithKey f = filterMapAux onLeaf onColl 552 where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (leaf h k v') 553 onLeaf _ = Nothing 554 555 onColl (L k v) | Just v' <- f k v = Just (L k v') 556 | otherwise = Nothing 557{-# INLINE mapMaybeWithKey #-} 558 559-- | /O(n)/ Transform this map by applying a function to every value 560-- and retaining only some of them. 561mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 562mapMaybe f = mapMaybeWithKey (const f) 563{-# INLINE mapMaybe #-} 564 565-- | /O(n)/ Perform an 'Applicative' action for each key-value pair 566-- in a 'HashMap' and produce a 'HashMap' of all the results. Each 'HashMap' 567-- will be strict in all its values. 568-- 569-- @ 570-- traverseWithKey f = fmap ('map' id) . "Data.HashMap.Lazy".'Data.HashMap.Lazy.traverseWithKey' f 571-- @ 572-- 573-- Note: the order in which the actions occur is unspecified. In particular, 574-- when the map contains hash collisions, the order in which the actions 575-- associated with the keys involved will depend in an unspecified way on 576-- their insertion order. 577traverseWithKey 578 :: Applicative f 579 => (k -> v1 -> f v2) 580 -> HashMap k v1 -> f (HashMap k v2) 581traverseWithKey f = go 582 where 583 go Empty = pure Empty 584 go (Leaf h (L k v)) = leaf h k <$> f k v 585 go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse' go ary 586 go (Full ary) = Full <$> A.traverse' go ary 587 go (Collision h ary) = 588 Collision h <$> A.traverse' (\ (L k v) -> (L k $!) <$> f k v) ary 589{-# INLINE traverseWithKey #-} 590 591------------------------------------------------------------------------ 592-- * Difference and intersection 593 594-- | /O(n*log m)/ Difference with a combining function. When two equal keys are 595-- encountered, the combining function is applied to the values of these keys. 596-- If it returns 'Nothing', the element is discarded (proper set difference). If 597-- it returns (@'Just' y@), the element is updated with a new value @y@. 598differenceWith :: (Eq k, Hashable k) => (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v 599differenceWith f a b = foldlWithKey' go empty a 600 where 601 go m k v = case HM.lookup k b of 602 Nothing -> insert k v m 603 Just w -> maybe m (\y -> insert k y m) (f v w) 604{-# INLINABLE differenceWith #-} 605 606-- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps 607-- the provided function is used to combine the values from the two 608-- maps. 609intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 610 -> HashMap k v2 -> HashMap k v3 611intersectionWith f a b = foldlWithKey' go empty a 612 where 613 go m k v = case HM.lookup k b of 614 Just w -> insert k (f v w) m 615 _ -> m 616{-# INLINABLE intersectionWith #-} 617 618-- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps 619-- the provided function is used to combine the values from the two 620-- maps. 621intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) 622 -> HashMap k v1 -> HashMap k v2 -> HashMap k v3 623intersectionWithKey f a b = foldlWithKey' go empty a 624 where 625 go m k v = case HM.lookup k b of 626 Just w -> insert k (f k v w) m 627 _ -> m 628{-# INLINABLE intersectionWithKey #-} 629 630------------------------------------------------------------------------ 631-- ** Lists 632 633-- | /O(n*log n)/ Construct a map with the supplied mappings. If the 634-- list contains duplicate mappings, the later mappings take 635-- precedence. 636fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v 637fromList = L.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty 638{-# INLINABLE fromList #-} 639 640-- | /O(n*log n)/ Construct a map from a list of elements. Uses 641-- the provided function @f@ to merge duplicate entries with 642-- @(f newVal oldVal)@. 643-- 644-- === Examples 645-- 646-- Given a list @xs@, create a map with the number of occurrences of each 647-- element in @xs@: 648-- 649-- > let xs = ['a', 'b', 'a'] 650-- > in fromListWith (+) [ (x, 1) | x <- xs ] 651-- > 652-- > = fromList [('a', 2), ('b', 1)] 653-- 654-- Given a list of key-value pairs @xs :: [(k, v)]@, group all values by their 655-- keys and return a @HashMap k [v]@. 656-- 657-- > let xs = ('a', 1), ('b', 2), ('a', 3)] 658-- > in fromListWith (++) [ (k, [v]) | (k, v) <- xs ] 659-- > 660-- > = fromList [('a', [3, 1]), ('b', [2])] 661-- 662-- Note that the lists in the resulting map contain elements in reverse order 663-- from their occurences in the original list. 664-- 665-- More generally, duplicate entries are accumulated as follows; 666-- this matters when @f@ is not commutative or not associative. 667-- 668-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] 669-- > = fromList [(k, f d (f c (f b a)))] 670fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v 671fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty 672{-# INLINE fromListWith #-} 673 674-- | /O(n*log n)/ Construct a map from a list of elements. Uses 675-- the provided function to merge duplicate entries. 676-- 677-- === Examples 678-- 679-- Given a list of key-value pairs where the keys are of different flavours, e.g: 680-- 681-- > data Key = Div | Sub 682-- 683-- and the values need to be combined differently when there are duplicates, 684-- depending on the key: 685-- 686-- > combine Div = div 687-- > combine Sub = (-) 688-- 689-- then @fromListWithKey@ can be used as follows: 690-- 691-- > fromListWithKey combine [(Div, 2), (Div, 6), (Sub, 2), (Sub, 3)] 692-- > = fromList [(Div, 3), (Sub, 1)] 693-- 694-- More generally, duplicate entries are accumulated as follows; 695-- 696-- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] 697-- > = fromList [(k, f k d (f k c (f k b a)))] 698-- 699-- @since 0.2.11 700fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v 701fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty 702{-# INLINE fromListWithKey #-} 703 704------------------------------------------------------------------------ 705-- Array operations 706 707updateWith :: Eq k => (v -> v) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v) 708updateWith f k0 ary0 = go k0 ary0 0 (A.length ary0) 709 where 710 go !k !ary !i !n 711 | i >= n = ary 712 | otherwise = case A.index ary i of 713 (L kx y) | k == kx -> let !v' = f y in A.update ary i (L k v') 714 | otherwise -> go k ary (i+1) n 715{-# INLINABLE updateWith #-} 716 717-- | Append the given key and value to the array. If the key is 718-- already present, instead update the value of the key by applying 719-- the given function to the new and old value (in that order). The 720-- value is always evaluated to WHNF before being inserted into the 721-- array. 722updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v) 723 -> A.Array (Leaf k v) 724updateOrSnocWith f = updateOrSnocWithKey (const f) 725{-# INLINABLE updateOrSnocWith #-} 726 727-- | Append the given key and value to the array. If the key is 728-- already present, instead update the value of the key by applying 729-- the given function to the new and old value (in that order). The 730-- value is always evaluated to WHNF before being inserted into the 731-- array. 732updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v) 733 -> A.Array (Leaf k v) 734updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) 735 where 736 go !k v !ary !i !n 737 | i >= n = A.run $ do 738 -- Not found, append to the end. 739 mary <- A.new_ (n + 1) 740 A.copy ary 0 mary 0 n 741 let !l = v `seq` (L k v) 742 A.write mary n l 743 return mary 744 | otherwise = case A.index ary i of 745 (L kx y) | k == kx -> let !v' = f k v y in A.update ary i (L k v') 746 | otherwise -> go k v ary (i+1) n 747{-# INLINABLE updateOrSnocWithKey #-} 748 749------------------------------------------------------------------------ 750-- Smart constructors 751-- 752-- These constructors make sure the value is in WHNF before it's 753-- inserted into the constructor. 754 755leaf :: Hash -> k -> v -> HashMap k v 756leaf h k = \ !v -> Leaf h (L k v) 757{-# INLINE leaf #-} 758