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