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