Update the documentation of strictness properties.
[packages/containers.git] / Data / Map / Strict.hs
1 {-# LANGUAGE CPP #-}
2 #if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
3 {-# LANGUAGE Safe #-}
4 #endif
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : Data.Map.Strict
8 -- Copyright : (c) Daan Leijen 2002
9 -- (c) Andriy Palamarchuk 2008
10 -- License : BSD-style
11 -- Maintainer : libraries@haskell.org
12 -- Stability : provisional
13 -- Portability : portable
14 --
15 -- An efficient implementation of ordered maps from keys to values
16 -- (dictionaries).
17 --
18 -- API of this module is strict in both the keys and the values.
19 -- If you need value-lazy maps, use 'Data.Map.Lazy' instead.
20 -- The 'Map' type is shared between the lazy and strict modules,
21 -- meaning that the same 'Map' value can be passed to functions in
22 -- both modules (although that is rarely needed).
23 --
24 -- These modules are intended to be imported qualified, to avoid name
25 -- clashes with Prelude functions, e.g.
26 --
27 -- > import qualified Data.Map.Strict as Map
28 --
29 -- The implementation of 'Map' is based on /size balanced/ binary trees (or
30 -- trees of /bounded balance/) as described by:
31 --
32 -- * Stephen Adams, \"/Efficient sets: a balancing act/\",
33 -- Journal of Functional Programming 3(4):553-562, October 1993,
34 -- <http://www.swiss.ai.mit.edu/~adams/BB/>.
35 --
36 -- * J. Nievergelt and E.M. Reingold,
37 -- \"/Binary search trees of bounded balance/\",
38 -- SIAM journal of computing 2(1), March 1973.
39 --
40 -- Note that the implementation is /left-biased/ -- the elements of a
41 -- first argument are always preferred to the second, for example in
42 -- 'union' or 'insert'.
43 --
44 -- Operation comments contain the operation time complexity in
45 -- the Big-O notation (<http://en.wikipedia.org/wiki/Big_O_notation>).
46 --
47 -- Be aware that the 'Functor', 'Traversable' and 'Data' instances
48 -- are the same as for the 'Data.Map.Lazy' module, so if they are used
49 -- on strict maps, the resulting maps will be lazy.
50 -----------------------------------------------------------------------------
51
52 -- It is crucial to the performance that the functions specialize on the Ord
53 -- type when possible. GHC 7.0 and higher does this by itself when it sees th
54 -- unfolding of a function -- that is why all public functions are marked
55 -- INLINABLE (that exposes the unfolding).
56 --
57 -- For other compilers and GHC pre 7.0, we mark some of the functions INLINE.
58 -- We mark the functions that just navigate down the tree (lookup, insert,
59 -- delete and similar). That navigation code gets inlined and thus specialized
60 -- when possible. There is a price to pay -- code growth. The code INLINED is
61 -- therefore only the tree navigation, all the real work (rebalancing) is not
62 -- INLINED by using a NOINLINE.
63 --
64 -- All methods that can be INLINE are not recursive -- a 'go' function doing
65 -- the real work is provided.
66
67 module Data.Map.Strict
68 (
69 -- * Strictness properties
70 -- $strictness
71
72 -- * Map type
73 #if !defined(TESTING)
74 Map -- instance Eq,Show,Read
75 #else
76 Map(..) -- instance Eq,Show,Read
77 #endif
78
79 -- * Operators
80 , (!), (\\)
81
82 -- * Query
83 , null
84 , size
85 , member
86 , notMember
87 , lookup
88 , findWithDefault
89
90 -- * Construction
91 , empty
92 , singleton
93
94 -- ** Insertion
95 , insert
96 , insertWith
97 , insertWithKey
98 , insertLookupWithKey
99
100 -- ** Delete\/Update
101 , delete
102 , adjust
103 , adjustWithKey
104 , update
105 , updateWithKey
106 , updateLookupWithKey
107 , alter
108
109 -- * Combine
110
111 -- ** Union
112 , union
113 , unionWith
114 , unionWithKey
115 , unions
116 , unionsWith
117
118 -- ** Difference
119 , difference
120 , differenceWith
121 , differenceWithKey
122
123 -- ** Intersection
124 , intersection
125 , intersectionWith
126 , intersectionWithKey
127
128 -- * Traversal
129 -- ** Map
130 , map
131 , mapWithKey
132 , mapAccum
133 , mapAccumWithKey
134 , mapAccumRWithKey
135 , mapKeys
136 , mapKeysWith
137 , mapKeysMonotonic
138
139 -- * Folds
140 , foldr
141 , foldl
142 , foldrWithKey
143 , foldlWithKey
144 -- ** Strict folds
145 , foldr'
146 , foldl'
147 , foldrWithKey'
148 , foldlWithKey'
149
150 -- * Conversion
151 , elems
152 , keys
153 , keysSet
154 , assocs
155
156 -- ** Lists
157 , toList
158 , fromList
159 , fromListWith
160 , fromListWithKey
161
162 -- ** Ordered lists
163 , toAscList
164 , toDescList
165 , fromAscList
166 , fromAscListWith
167 , fromAscListWithKey
168 , fromDistinctAscList
169
170 -- * Filter
171 , filter
172 , filterWithKey
173 , partition
174 , partitionWithKey
175
176 , mapMaybe
177 , mapMaybeWithKey
178 , mapEither
179 , mapEitherWithKey
180
181 , split
182 , splitLookup
183
184 -- * Submap
185 , isSubmapOf, isSubmapOfBy
186 , isProperSubmapOf, isProperSubmapOfBy
187
188 -- * Indexed
189 , lookupIndex
190 , findIndex
191 , elemAt
192 , updateAt
193 , deleteAt
194
195 -- * Min\/Max
196 , findMin
197 , findMax
198 , deleteMin
199 , deleteMax
200 , deleteFindMin
201 , deleteFindMax
202 , updateMin
203 , updateMax
204 , updateMinWithKey
205 , updateMaxWithKey
206 , minView
207 , maxView
208 , minViewWithKey
209 , maxViewWithKey
210
211 -- * Debugging
212 , showTree
213 , showTreeWith
214 , valid
215
216 #if defined(TESTING)
217 -- * Internals
218 , bin
219 , balanced
220 , join
221 , merge
222 #endif
223 ) where
224
225 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
226 import qualified Data.List as List
227
228 import Data.Map.Base hiding
229 ( findWithDefault
230 , singleton
231 , insert
232 , insertWith
233 , insertWithKey
234 , insertLookupWithKey
235 , adjust
236 , adjustWithKey
237 , update
238 , updateWithKey
239 , updateLookupWithKey
240 , alter
241 , unionWith
242 , unionWithKey
243 , unionsWith
244 , differenceWith
245 , differenceWithKey
246 , intersectionWith
247 , intersectionWithKey
248 , map
249 , mapWithKey
250 , mapAccum
251 , mapAccumWithKey
252 , mapAccumRWithKey
253 , mapKeys
254 , mapKeysWith
255 , mapKeysMonotonic
256 , fromList
257 , fromListWith
258 , fromListWithKey
259 , fromAscList
260 , fromAscListWith
261 , fromAscListWithKey
262 , fromDistinctAscList
263 , mapMaybe
264 , mapMaybeWithKey
265 , mapEither
266 , mapEitherWithKey
267 , updateAt
268 , updateMin
269 , updateMax
270 , updateMinWithKey
271 , updateMaxWithKey
272 )
273 import Data.StrictPair
274
275 -- Use macros to define strictness of functions. STRICT_x_OF_y
276 -- denotes an y-ary function strict in the x-th parameter. Similarly
277 -- STRICT_x_y_OF_z denotes an z-ary function strict in the x-th and
278 -- y-th parameter. We do not use BangPatterns, because they are not
279 -- in any standard and we want the compilers to be compiled by as many
280 -- compilers as possible.
281 #define STRICT_2_OF_3(fn) fn _ arg _ | arg `seq` False = undefined
282 #define STRICT_1_2_OF_3(fn) fn arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined
283 #define STRICT_2_3_OF_4(fn) fn _ arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined
284
285 -- $strictness
286 --
287 -- This module satisfies the following strictness properties:
288 --
289 -- 1. Key and value arguments are evaluated to WHNF;
290 --
291 -- 2. Keys and values are evaluated to WHNF before they are stored in
292 -- the map.
293 --
294 -- Here are some examples that illustrate the first property:
295 --
296 -- > insertWith (\ new old -> old) k undefined m == undefined
297 -- > delete undefined m == undefined
298 --
299 -- Here are some examples that illustrate the second property:
300 --
301 -- > map (\ v -> undefined) m == undefined -- m is not empty
302 -- > mapKeys (\ k -> undefined) m == undefined -- m is not empty
303
304 {--------------------------------------------------------------------
305 Query
306 --------------------------------------------------------------------}
307
308 -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
309 -- the value at key @k@ or returns default value @def@
310 -- when the key is not in the map.
311 --
312 -- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
313 -- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
314
315 findWithDefault :: Ord k => a -> k -> Map k a -> a
316 findWithDefault def k m = def `seq` case lookup k m of
317 Nothing -> def
318 Just x -> x
319 #if __GLASGOW_HASKELL__ >= 700
320 {-# INLINABLE findWithDefault #-}
321 #else
322 {-# INLINE findWithDefault #-}
323 #endif
324
325 {--------------------------------------------------------------------
326 Construction
327 --------------------------------------------------------------------}
328
329 -- | /O(1)/. A map with a single element.
330 --
331 -- > singleton 1 'a' == fromList [(1, 'a')]
332 -- > size (singleton 1 'a') == 1
333
334 singleton :: k -> a -> Map k a
335 singleton k x = x `seq` Bin 1 k x Tip Tip
336
337 {--------------------------------------------------------------------
338 Insertion
339 --------------------------------------------------------------------}
340 -- | /O(log n)/. Insert a new key and value in the map.
341 -- If the key is already present in the map, the associated value is
342 -- replaced with the supplied value. 'insert' is equivalent to
343 -- @'insertWith' 'const'@.
344 --
345 -- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
346 -- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
347 -- > insert 5 'x' empty == singleton 5 'x'
348
349 insert :: Ord k => k -> a -> Map k a -> Map k a
350 insert = go
351 where
352 STRICT_1_2_OF_3(go)
353 go kx x Tip = singleton kx x
354 go kx x (Bin sz ky y l r) =
355 case compare kx ky of
356 LT -> balanceL ky y (go kx x l) r
357 GT -> balanceR ky y l (go kx x r)
358 EQ -> Bin sz kx x l r
359 #if __GLASGOW_HASKELL__ >= 700
360 {-# INLINEABLE insert #-}
361 #else
362 {-# INLINE insert #-}
363 #endif
364
365 -- | /O(log n)/. Insert with a function, combining new value and old value.
366 -- @'insertWith' f key value mp@
367 -- will insert the pair (key, value) into @mp@ if key does
368 -- not exist in the map. If the key does exist, the function will
369 -- insert the pair @(key, f new_value old_value)@.
370 --
371 -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
372 -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
373 -- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
374
375 insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
376 insertWith f = insertWithKey (\_ x' y' -> f x' y')
377 {-# INLINE insertWith #-}
378
379 -- | /O(log n)/. Insert with a function, combining key, new value and old value.
380 -- @'insertWithKey' f key value mp@
381 -- will insert the pair (key, value) into @mp@ if key does
382 -- not exist in the map. If the key does exist, the function will
383 -- insert the pair @(key,f key new_value old_value)@.
384 -- Note that the key passed to f is the same key passed to 'insertWithKey'.
385 --
386 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
387 -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
388 -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
389 -- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
390
391 insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
392 insertWithKey = go
393 where
394 STRICT_2_3_OF_4(go)
395 go _ kx x Tip = singleton kx x
396 go f kx x (Bin sy ky y l r) =
397 case compare kx ky of
398 LT -> balanceL ky y (go f kx x l) r
399 GT -> balanceR ky y l (go f kx x r)
400 EQ -> let x' = f kx x y
401 in x' `seq` Bin sy kx x' l r
402 #if __GLASGOW_HASKELL__ >= 700
403 {-# INLINEABLE insertWithKey #-}
404 #else
405 {-# INLINE insertWithKey #-}
406 #endif
407
408 -- | /O(log n)/. Combines insert operation with old value retrieval.
409 -- The expression (@'insertLookupWithKey' f k x map@)
410 -- is a pair where the first element is equal to (@'lookup' k map@)
411 -- and the second element equal to (@'insertWithKey' f k x map@).
412 --
413 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
414 -- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
415 -- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
416 -- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
417 --
418 -- This is how to define @insertLookup@ using @insertLookupWithKey@:
419 --
420 -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
421 -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
422 -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
423
424 insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
425 -> (Maybe a, Map k a)
426 insertLookupWithKey = go
427 where
428 STRICT_2_3_OF_4(go)
429 go _ kx x Tip = Nothing `strictPair` singleton kx x
430 go f kx x (Bin sy ky y l r) =
431 case compare kx ky of
432 LT -> let (found, l') = go f kx x l
433 in found `strictPair` balanceL ky y l' r
434 GT -> let (found, r') = go f kx x r
435 in found `strictPair` balanceR ky y l r'
436 EQ -> let x' = f kx x y
437 in x' `seq` (Just y `strictPair` Bin sy kx x' l r)
438 #if __GLASGOW_HASKELL__ >= 700
439 {-# INLINEABLE insertLookupWithKey #-}
440 #else
441 {-# INLINE insertLookupWithKey #-}
442 #endif
443
444 {--------------------------------------------------------------------
445 Deletion
446 [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
447 --------------------------------------------------------------------}
448
449 -- | /O(log n)/. Update a value at a specific key with the result of the provided function.
450 -- When the key is not
451 -- a member of the map, the original map is returned.
452 --
453 -- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
454 -- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
455 -- > adjust ("new " ++) 7 empty == empty
456
457 adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
458 adjust f = adjustWithKey (\_ x -> f x)
459 {-# INLINE adjust #-}
460
461 -- | /O(log n)/. Adjust a value at a specific key. When the key is not
462 -- a member of the map, the original map is returned.
463 --
464 -- > let f key x = (show key) ++ ":new " ++ x
465 -- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
466 -- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
467 -- > adjustWithKey f 7 empty == empty
468
469 adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
470 adjustWithKey f = updateWithKey (\k' x' -> Just (f k' x'))
471 {-# INLINE adjustWithKey #-}
472
473 -- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@
474 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
475 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
476 --
477 -- > let f x = if x == "a" then Just "new a" else Nothing
478 -- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
479 -- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
480 -- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
481
482 update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
483 update f = updateWithKey (\_ x -> f x)
484 {-# INLINE update #-}
485
486 -- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the
487 -- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
488 -- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
489 -- to the new value @y@.
490 --
491 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
492 -- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
493 -- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
494 -- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
495
496 updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
497 updateWithKey = go
498 where
499 STRICT_2_OF_3(go)
500 go _ _ Tip = Tip
501 go f k(Bin sx kx x l r) =
502 case compare k kx of
503 LT -> balanceR kx x (go f k l) r
504 GT -> balanceL kx x l (go f k r)
505 EQ -> case f kx x of
506 Just x' -> x' `seq` Bin sx kx x' l r
507 Nothing -> glue l r
508 #if __GLASGOW_HASKELL__ >= 700
509 {-# INLINEABLE updateWithKey #-}
510 #else
511 {-# INLINE updateWithKey #-}
512 #endif
513
514 -- | /O(log n)/. Lookup and update. See also 'updateWithKey'.
515 -- The function returns changed value, if it is updated.
516 -- Returns the original key value if the map entry is deleted.
517 --
518 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
519 -- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
520 -- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
521 -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
522
523 updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a)
524 updateLookupWithKey = go
525 where
526 STRICT_2_OF_3(go)
527 go _ _ Tip = (Nothing,Tip)
528 go f k (Bin sx kx x l r) =
529 case compare k kx of
530 LT -> let (found,l') = go f k l
531 in found `strictPair` balanceR kx x l' r
532 GT -> let (found,r') = go f k r
533 in found `strictPair` balanceL kx x l r'
534 EQ -> case f kx x of
535 Just x' -> x' `seq` (Just x' `strictPair` Bin sx kx x' l r)
536 Nothing -> (Just x,glue l r)
537 #if __GLASGOW_HASKELL__ >= 700
538 {-# INLINEABLE updateLookupWithKey #-}
539 #else
540 {-# INLINE updateLookupWithKey #-}
541 #endif
542
543 -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
544 -- 'alter' can be used to insert, delete, or update a value in a 'Map'.
545 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
546 --
547 -- > let f _ = Nothing
548 -- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
549 -- > alter f 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
550 -- >
551 -- > let f _ = Just "c"
552 -- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")]
553 -- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]
554
555 alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
556 alter = go
557 where
558 STRICT_2_OF_3(go)
559 go f k Tip = case f Nothing of
560 Nothing -> Tip
561 Just x -> singleton k x
562
563 go f k (Bin sx kx x l r) = case compare k kx of
564 LT -> balance kx x (go f k l) r
565 GT -> balance kx x l (go f k r)
566 EQ -> case f (Just x) of
567 Just x' -> x' `seq` Bin sx kx x' l r
568 Nothing -> glue l r
569 #if __GLASGOW_HASKELL__ >= 700
570 {-# INLINEABLE alter #-}
571 #else
572 {-# INLINE alter #-}
573 #endif
574
575 {--------------------------------------------------------------------
576 Indexing
577 --------------------------------------------------------------------}
578
579 -- | /O(log n)/. Update the element at /index/. Calls 'error' when an
580 -- invalid index is used.
581 --
582 -- > updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "x"), (5, "a")]
583 -- > updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "x")]
584 -- > updateAt (\ _ _ -> Just "x") 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range
585 -- > updateAt (\ _ _ -> Just "x") (-1) (fromList [(5,"a"), (3,"b")]) Error: index out of range
586 -- > updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
587 -- > updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
588 -- > updateAt (\_ _ -> Nothing) 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range
589 -- > updateAt (\_ _ -> Nothing) (-1) (fromList [(5,"a"), (3,"b")]) Error: index out of range
590
591 updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
592 updateAt f i t = i `seq`
593 case t of
594 Tip -> error "Map.updateAt: index out of range"
595 Bin sx kx x l r -> case compare i sizeL of
596 LT -> balanceR kx x (updateAt f i l) r
597 GT -> balanceL kx x l (updateAt f (i-sizeL-1) r)
598 EQ -> case f kx x of
599 Just x' -> x' `seq` Bin sx kx x' l r
600 Nothing -> glue l r
601 where
602 sizeL = size l
603 #if __GLASGOW_HASKELL__ >= 700
604 {-# INLINABLE updateAt #-}
605 #endif
606
607 {--------------------------------------------------------------------
608 Minimal, Maximal
609 --------------------------------------------------------------------}
610
611 -- | /O(log n)/. Update the value at the minimal key.
612 --
613 -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
614 -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
615
616 updateMin :: (a -> Maybe a) -> Map k a -> Map k a
617 updateMin f m
618 = updateMinWithKey (\_ x -> f x) m
619 #if __GLASGOW_HASKELL__ >= 700
620 {-# INLINABLE updateMin #-}
621 #endif
622
623 -- | /O(log n)/. Update the value at the maximal key.
624 --
625 -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
626 -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
627
628 updateMax :: (a -> Maybe a) -> Map k a -> Map k a
629 updateMax f m
630 = updateMaxWithKey (\_ x -> f x) m
631 #if __GLASGOW_HASKELL__ >= 700
632 {-# INLINABLE updateMax #-}
633 #endif
634
635
636 -- | /O(log n)/. Update the value at the minimal key.
637 --
638 -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
639 -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
640
641 updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
642 updateMinWithKey _ Tip = Tip
643 updateMinWithKey f (Bin sx kx x Tip r) = case f kx x of
644 Nothing -> r
645 Just x' -> x' `seq` Bin sx kx x' Tip r
646 updateMinWithKey f (Bin _ kx x l r) = balanceR kx x (updateMinWithKey f l) r
647 #if __GLASGOW_HASKELL__ >= 700
648 {-# INLINABLE updateMinWithKey #-}
649 #endif
650
651 -- | /O(log n)/. Update the value at the maximal key.
652 --
653 -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
654 -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
655
656 updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
657 updateMaxWithKey _ Tip = Tip
658 updateMaxWithKey f (Bin sx kx x l Tip) = case f kx x of
659 Nothing -> l
660 Just x' -> x' `seq` Bin sx kx x' l Tip
661 updateMaxWithKey f (Bin _ kx x l r) = balanceL kx x l (updateMaxWithKey f r)
662 #if __GLASGOW_HASKELL__ >= 700
663 {-# INLINABLE updateMaxWithKey #-}
664 #endif
665
666 {--------------------------------------------------------------------
667 Union.
668 --------------------------------------------------------------------}
669
670 -- | The union of a list of maps, with a combining operation:
671 -- (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
672 --
673 -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
674 -- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
675
676 unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
677 unionsWith f ts
678 = foldlStrict (unionWith f) empty ts
679 #if __GLASGOW_HASKELL__ >= 700
680 {-# INLINABLE unionsWith #-}
681 #endif
682
683 {--------------------------------------------------------------------
684 Union with a combining function
685 --------------------------------------------------------------------}
686 -- | /O(n+m)/. Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.
687 --
688 -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
689
690 unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
691 unionWith f m1 m2
692 = unionWithKey (\_ x y -> f x y) m1 m2
693 {-# INLINE unionWith #-}
694
695 -- | /O(n+m)/.
696 -- Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.
697 -- Hedge-union is more efficient on (bigset \``union`\` smallset).
698 --
699 -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
700 -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
701
702 unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
703 unionWithKey _ Tip t2 = t2
704 unionWithKey _ t1 Tip = t1
705 unionWithKey f t1 t2 = hedgeUnionWithKey f NothingS NothingS t1 t2
706 #if __GLASGOW_HASKELL__ >= 700
707 {-# INLINABLE unionWithKey #-}
708 #endif
709
710 hedgeUnionWithKey :: Ord a
711 => (a -> b -> b -> b)
712 -> MaybeS a -> MaybeS a
713 -> Map a b -> Map a b
714 -> Map a b
715 hedgeUnionWithKey _ _ _ t1 Tip
716 = t1
717 hedgeUnionWithKey _ blo bhi Tip (Bin _ kx x l r)
718 = join kx x (filterGt blo l) (filterLt bhi r)
719 hedgeUnionWithKey f blo bhi (Bin _ kx x l r) t2
720 = newx `seq` join kx newx (hedgeUnionWithKey f blo bmi l lt)
721 (hedgeUnionWithKey f bmi bhi r gt)
722 where
723 bmi = JustS kx
724 lt = trim blo bmi t2
725 (found,gt) = trimLookupLo kx bhi t2
726 newx = case found of
727 Nothing -> x
728 Just (_,y) -> f kx x y
729 #if __GLASGOW_HASKELL__ >= 700
730 {-# INLINABLE hedgeUnionWithKey #-}
731 #endif
732
733 {--------------------------------------------------------------------
734 Difference
735 --------------------------------------------------------------------}
736
737 -- | /O(n+m)/. Difference with a combining function.
738 -- When two equal keys are
739 -- encountered, the combining function is applied to the values of these keys.
740 -- If it returns 'Nothing', the element is discarded (proper set difference). If
741 -- it returns (@'Just' y@), the element is updated with a new value @y@.
742 -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
743 --
744 -- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
745 -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
746 -- > == singleton 3 "b:B"
747
748 differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
749 differenceWith f m1 m2
750 = differenceWithKey (\_ x y -> f x y) m1 m2
751 {-# INLINE differenceWith #-}
752
753 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
754 -- encountered, the combining function is applied to the key and both values.
755 -- If it returns 'Nothing', the element is discarded (proper set difference). If
756 -- it returns (@'Just' y@), the element is updated with a new value @y@.
757 -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
758 --
759 -- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
760 -- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
761 -- > == singleton 3 "3:b|B"
762
763 differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
764 differenceWithKey _ Tip _ = Tip
765 differenceWithKey _ t1 Tip = t1
766 differenceWithKey f t1 t2 = hedgeDiffWithKey f NothingS NothingS t1 t2
767 #if __GLASGOW_HASKELL__ >= 700
768 {-# INLINABLE differenceWithKey #-}
769 #endif
770
771 hedgeDiffWithKey :: Ord a
772 => (a -> b -> c -> Maybe b)
773 -> MaybeS a -> MaybeS a
774 -> Map a b -> Map a c
775 -> Map a b
776 hedgeDiffWithKey _ _ _ Tip _
777 = Tip
778 hedgeDiffWithKey _ blo bhi (Bin _ kx x l r) Tip
779 = join kx x (filterGt blo l) (filterLt bhi r)
780 hedgeDiffWithKey f blo bhi t (Bin _ kx x l r)
781 = case found of
782 Nothing -> merge tl tr
783 Just (ky,y) ->
784 case f ky y x of
785 Nothing -> merge tl tr
786 Just z -> z `seq` join ky z tl tr
787 where
788 bmi = JustS kx
789 lt = trim blo bmi t
790 (found,gt) = trimLookupLo kx bhi t
791 tl = hedgeDiffWithKey f blo bmi lt l
792 tr = hedgeDiffWithKey f bmi bhi gt r
793 #if __GLASGOW_HASKELL__ >= 700
794 {-# INLINABLE hedgeDiffWithKey #-}
795 #endif
796
797 {--------------------------------------------------------------------
798 Intersection
799 --------------------------------------------------------------------}
800
801 -- | /O(n+m)/. Intersection with a combining function.
802 --
803 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
804
805 intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
806 intersectionWith f m1 m2
807 = intersectionWithKey (\_ x y -> f x y) m1 m2
808 {-# INLINE intersectionWith #-}
809
810 -- | /O(n+m)/. Intersection with a combining function.
811 -- Intersection is more efficient on (bigset \``intersection`\` smallset).
812 --
813 -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
814 -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
815
816
817 intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
818 intersectionWithKey _ Tip _ = Tip
819 intersectionWithKey _ _ Tip = Tip
820 intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =
821 if s1 >= s2 then
822 let (lt,found,gt) = splitLookupWithKey k2 t1
823 tl = intersectionWithKey f lt l2
824 tr = intersectionWithKey f gt r2
825 in case found of
826 Just (k,x) -> join k (f k x x2) tl tr
827 Nothing -> merge tl tr
828 else let (lt,found,gt) = splitLookup k1 t2
829 tl = intersectionWithKey f l1 lt
830 tr = intersectionWithKey f r1 gt
831 in case found of
832 Just x -> let x' = f k1 x1 x in x' `seq` join k1 x' tl tr
833 Nothing -> merge tl tr
834 #if __GLASGOW_HASKELL__ >= 700
835 {-# INLINABLE intersectionWithKey #-}
836 #endif
837
838 {--------------------------------------------------------------------
839 Filter and partition
840 --------------------------------------------------------------------}
841
842 -- | /O(n)/. Map values and collect the 'Just' results.
843 --
844 -- > let f x = if x == "a" then Just "new a" else Nothing
845 -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
846
847 mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
848 mapMaybe f = mapMaybeWithKey (\_ x -> f x)
849 #if __GLASGOW_HASKELL__ >= 700
850 {-# INLINABLE mapMaybe #-}
851 #endif
852
853 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
854 --
855 -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
856 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
857
858 mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b
859 mapMaybeWithKey _ Tip = Tip
860 mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
861 Just y -> y `seq` join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
862 Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
863 #if __GLASGOW_HASKELL__ >= 700
864 {-# INLINABLE mapMaybeWithKey #-}
865 #endif
866
867 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
868 --
869 -- > let f a = if a < "c" then Left a else Right a
870 -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
871 -- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
872 -- >
873 -- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
874 -- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
875
876 mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c)
877 mapEither f m
878 = mapEitherWithKey (\_ x -> f x) m
879 #if __GLASGOW_HASKELL__ >= 700
880 {-# INLINABLE mapEither #-}
881 #endif
882
883 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
884 --
885 -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
886 -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
887 -- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
888 -- >
889 -- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
890 -- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
891
892 mapEitherWithKey :: Ord k =>
893 (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
894 mapEitherWithKey _ Tip = (Tip, Tip)
895 mapEitherWithKey f (Bin _ kx x l r) = case f kx x of
896 Left y -> y `seq` (join kx y l1 r1 `strictPair` merge l2 r2)
897 Right z -> z `seq` (merge l1 r1 `strictPair` join kx z l2 r2)
898 where
899 (l1,l2) = mapEitherWithKey f l
900 (r1,r2) = mapEitherWithKey f r
901 #if __GLASGOW_HASKELL__ >= 700
902 {-# INLINABLE mapEitherWithKey #-}
903 #endif
904
905 {--------------------------------------------------------------------
906 Mapping
907 --------------------------------------------------------------------}
908 -- | /O(n)/. Map a function over all values in the map.
909 --
910 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
911
912 map :: (a -> b) -> Map k a -> Map k b
913 map f = mapWithKey (\_ x -> f x)
914 #if __GLASGOW_HASKELL__ >= 700
915 {-# INLINABLE map #-}
916 #endif
917
918 -- | /O(n)/. Map a function over all values in the map.
919 --
920 -- > let f key x = (show key) ++ ":" ++ x
921 -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
922
923 mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
924 mapWithKey _ Tip = Tip
925 mapWithKey f (Bin sx kx x l r) = let x' = f kx x
926 in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
927 #if __GLASGOW_HASKELL__ >= 700
928 {-# INLINABLE mapWithKey #-}
929 #endif
930
931 -- | /O(n)/. The function 'mapAccum' threads an accumulating
932 -- argument through the map in ascending order of keys.
933 --
934 -- > let f a b = (a ++ b, b ++ "X")
935 -- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
936
937 mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
938 mapAccum f a m
939 = mapAccumWithKey (\a' _ x' -> f a' x') a m
940 #if __GLASGOW_HASKELL__ >= 700
941 {-# INLINABLE mapAccum #-}
942 #endif
943
944 -- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating
945 -- argument through the map in ascending order of keys.
946 --
947 -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
948 -- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
949
950 mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
951 mapAccumWithKey f a t
952 = mapAccumL f a t
953 #if __GLASGOW_HASKELL__ >= 700
954 {-# INLINABLE mapAccumWithKey #-}
955 #endif
956
957 -- | /O(n)/. The function 'mapAccumL' threads an accumulating
958 -- argument through the map in ascending order of keys.
959 mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
960 mapAccumL _ a Tip = (a,Tip)
961 mapAccumL f a (Bin sx kx x l r) =
962 let (a1,l') = mapAccumL f a l
963 (a2,x') = f a1 kx x
964 (a3,r') = mapAccumL f a2 r
965 in x' `seq` (a3,Bin sx kx x' l' r')
966 #if __GLASGOW_HASKELL__ >= 700
967 {-# INLINABLE mapAccumL #-}
968 #endif
969
970 -- | /O(n)/. The function 'mapAccumR' threads an accumulating
971 -- argument through the map in descending order of keys.
972 mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
973 mapAccumRWithKey _ a Tip = (a,Tip)
974 mapAccumRWithKey f a (Bin sx kx x l r) =
975 let (a1,r') = mapAccumRWithKey f a r
976 (a2,x') = f a1 kx x
977 (a3,l') = mapAccumRWithKey f a2 l
978 in x' `seq` (a3,Bin sx kx x' l' r')
979 #if __GLASGOW_HASKELL__ >= 700
980 {-# INLINABLE mapAccumRWithKey #-}
981 #endif
982
983 -- | /O(n*log n)/.
984 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
985 --
986 -- The size of the result may be smaller if @f@ maps two or more distinct
987 -- keys to the same new key. In this case the value at the greatest of
988 -- the original keys is retained.
989 --
990 -- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) == fromList [(4, "b"), (6, "a")]
991 -- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
992 -- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
993
994 mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
995 mapKeys = mapKeysWith (\x _ -> x)
996 #if __GLASGOW_HASKELL__ >= 700
997 {-# INLINABLE mapKeys #-}
998 #endif
999
1000 -- | /O(n*log n)/.
1001 -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
1002 --
1003 -- The size of the result may be smaller if @f@ maps two or more distinct
1004 -- keys to the same new key. In this case the associated values will be
1005 -- combined using @c@.
1006 --
1007 -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
1008 -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
1009
1010 mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
1011 mapKeysWith c f = fromListWith c . List.map fFirst . toList
1012 where fFirst (x,y) = (f x, y)
1013 #if __GLASGOW_HASKELL__ >= 700
1014 {-# INLINABLE mapKeysWith #-}
1015 #endif
1016
1017
1018 -- | /O(n)/.
1019 -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
1020 -- is strictly monotonic.
1021 -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
1022 -- /The precondition is not checked./
1023 -- Semi-formally, we have:
1024 --
1025 -- > and [x < y ==> f x < f y | x <- ls, y <- ls]
1026 -- > ==> mapKeysMonotonic f s == mapKeys f s
1027 -- > where ls = keys s
1028 --
1029 -- This means that @f@ maps distinct original keys to distinct resulting keys.
1030 -- This function has better performance than 'mapKeys'.
1031 --
1032 -- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
1033 -- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) == True
1034 -- > valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) == False
1035
1036 mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
1037 mapKeysMonotonic _ Tip = Tip
1038 mapKeysMonotonic f (Bin sz k x l r) =
1039 let k' = f k
1040 in k' `seq` Bin sz k' x (mapKeysMonotonic f l) (mapKeysMonotonic f r)
1041 #if __GLASGOW_HASKELL__ >= 700
1042 {-# INLINABLE mapKeysMonotonic #-}
1043 #endif
1044
1045 {--------------------------------------------------------------------
1046 Lists
1047 use [foldlStrict] to reduce demand on the control-stack
1048 --------------------------------------------------------------------}
1049 -- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.
1050 -- If the list contains more than one value for the same key, the last value
1051 -- for the key is retained.
1052 --
1053 -- > fromList [] == empty
1054 -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
1055 -- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
1056
1057 fromList :: Ord k => [(k,a)] -> Map k a
1058 fromList xs
1059 = foldlStrict ins empty xs
1060 where
1061 ins t (k,x) = insert k x t
1062 #if __GLASGOW_HASKELL__ >= 700
1063 {-# INLINABLE fromList #-}
1064 #endif
1065
1066 -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
1067 --
1068 -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
1069 -- > fromListWith (++) [] == empty
1070
1071 fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a
1072 fromListWith f xs
1073 = fromListWithKey (\_ x y -> f x y) xs
1074 #if __GLASGOW_HASKELL__ >= 700
1075 {-# INLINABLE fromListWith #-}
1076 #endif
1077
1078 -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.
1079 --
1080 -- > let f k a1 a2 = (show k) ++ a1 ++ a2
1081 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]
1082 -- > fromListWithKey f [] == empty
1083
1084 fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
1085 fromListWithKey f xs
1086 = foldlStrict ins empty xs
1087 where
1088 ins t (k,x) = insertWithKey f k x t
1089 #if __GLASGOW_HASKELL__ >= 700
1090 {-# INLINABLE fromListWithKey #-}
1091 #endif
1092
1093 {--------------------------------------------------------------------
1094 Building trees from ascending/descending lists can be done in linear time.
1095
1096 Note that if [xs] is ascending that:
1097 fromAscList xs == fromList xs
1098 fromAscListWith f xs == fromListWith f xs
1099 --------------------------------------------------------------------}
1100 -- | /O(n)/. Build a map from an ascending list in linear time.
1101 -- /The precondition (input list is ascending) is not checked./
1102 --
1103 -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1104 -- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
1105 -- > valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) == True
1106 -- > valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) == False
1107
1108 fromAscList :: Eq k => [(k,a)] -> Map k a
1109 fromAscList xs
1110 = fromAscListWithKey (\_ x _ -> x) xs
1111 #if __GLASGOW_HASKELL__ >= 700
1112 {-# INLINABLE fromAscList #-}
1113 #endif
1114
1115 -- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.
1116 -- /The precondition (input list is ascending) is not checked./
1117 --
1118 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
1119 -- > valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) == True
1120 -- > valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False
1121
1122 fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
1123 fromAscListWith f xs
1124 = fromAscListWithKey (\_ x y -> f x y) xs
1125 #if __GLASGOW_HASKELL__ >= 700
1126 {-# INLINABLE fromAscListWith #-}
1127 #endif
1128
1129 -- | /O(n)/. Build a map from an ascending list in linear time with a
1130 -- combining function for equal keys.
1131 -- /The precondition (input list is ascending) is not checked./
1132 --
1133 -- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
1134 -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]
1135 -- > valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) == True
1136 -- > valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False
1137
1138 fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
1139 fromAscListWithKey f xs
1140 = fromDistinctAscList (combineEq f xs)
1141 where
1142 -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
1143 combineEq _ xs'
1144 = case xs' of
1145 [] -> []
1146 [x] -> [x]
1147 (x:xx) -> combineEq' x xx
1148
1149 combineEq' z [] = [z]
1150 combineEq' z@(kz,zz) (x@(kx,xx):xs')
1151 | kx==kz = let yy = f kx xx zz in yy `seq` combineEq' (kx,yy) xs'
1152 | otherwise = z:combineEq' x xs'
1153 #if __GLASGOW_HASKELL__ >= 700
1154 {-# INLINABLE fromAscListWithKey #-}
1155 #endif
1156
1157 -- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.
1158 -- /The precondition is not checked./
1159 --
1160 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1161 -- > valid (fromDistinctAscList [(3,"b"), (5,"a")]) == True
1162 -- > valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) == False
1163
1164 fromDistinctAscList :: [(k,a)] -> Map k a
1165 fromDistinctAscList xs
1166 = create const (length xs) xs
1167 where
1168 -- 1) use continuations so that we use heap space instead of stack space.
1169 -- 2) special case for n==5 to create bushier trees.
1170 create c 0 xs' = c Tip xs'
1171 create c 5 xs' = case xs' of
1172 ((k1,x1):(k2,x2):(k3,x3):(k4,x4):(k5,x5):xx)
1173 -> x1 `seq` x2 `seq` x3 `seq` x4 `seq` x5 `seq`
1174 c (bin k4 x4 (bin k2 x2 (singleton k1 x1) (singleton k3 x3))
1175 (singleton k5 x5)) xx
1176 _ -> error "fromDistinctAscList create"
1177 create c n xs' = seq nr $ create (createR nr c) nl xs'
1178 where nl = n `div` 2
1179 nr = n - nl - 1
1180
1181 createR n c l ((k,x):ys) = x `seq` create (createB l k x c) n ys
1182 createR _ _ _ [] = error "fromDistinctAscList createR []"
1183 createB l k x c r zs = x `seq` c (bin k x l r) zs
1184 #if __GLASGOW_HASKELL__ >= 700
1185 {-# INLINABLE fromDistinctAscList #-}
1186 #endif