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