Improve Foldable instances.
[packages/containers.git] / Data / IntMap / Base.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__
3 {-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-}
4 #endif
5 #if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
6 {-# LANGUAGE Trustworthy #-}
7 #endif
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Data.IntMap.Base
11 -- Copyright : (c) Daan Leijen 2002
12 -- (c) Andriy Palamarchuk 2008
13 -- License : BSD-style
14 -- Maintainer : libraries@haskell.org
15 -- Stability : provisional
16 -- Portability : portable
17 --
18 -- This defines the data structures and core (hidden) manipulations
19 -- on representations.
20 -----------------------------------------------------------------------------
21
22 -- [Note: INLINE bit fiddling]
23 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
24 -- It is essential that the bit fiddling functions like mask, zero, branchMask
25 -- etc are inlined. If they do not, the memory allocation skyrockets. The GHC
26 -- usually gets it right, but it is disastrous if it does not. Therefore we
27 -- explicitly mark these functions INLINE.
28
29
30 -- [Note: Local 'go' functions and capturing]
31 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
32 -- Care must be taken when using 'go' function which captures an argument.
33 -- Sometimes (for example when the argument is passed to a data constructor,
34 -- as in insert), GHC heap-allocates more than necessary. Therefore C-- code
35 -- must be checked for increased allocation when creating and modifying such
36 -- functions.
37
38
39 -- [Note: Order of constructors]
40 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 -- The order of constructors of IntMap matters when considering performance.
42 -- Currently in GHC 7.0, when type has 3 constructors, they are matched from
43 -- the first to the last -- the best performance is achieved when the
44 -- constructors are ordered by frequency.
45 -- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil
46 -- improves the benchmark by circa 10%.
47
48 module Data.IntMap.Base (
49 -- * Map type
50 IntMap(..), Key -- instance Eq,Show
51
52 -- * Operators
53 , (!), (\\)
54
55 -- * Query
56 , null
57 , size
58 , member
59 , notMember
60 , lookup
61 , findWithDefault
62 , lookupLT
63 , lookupGT
64 , lookupLE
65 , lookupGE
66
67 -- * Construction
68 , empty
69 , singleton
70
71 -- ** Insertion
72 , insert
73 , insertWith
74 , insertWithKey
75 , insertLookupWithKey
76
77 -- ** Delete\/Update
78 , delete
79 , adjust
80 , adjustWithKey
81 , update
82 , updateWithKey
83 , updateLookupWithKey
84 , alter
85
86 -- * Combine
87
88 -- ** Union
89 , union
90 , unionWith
91 , unionWithKey
92 , unions
93 , unionsWith
94
95 -- ** Difference
96 , difference
97 , differenceWith
98 , differenceWithKey
99
100 -- ** Intersection
101 , intersection
102 , intersectionWith
103 , intersectionWithKey
104
105 -- ** Universal combining function
106 , mergeWithKey
107 , mergeWithKey'
108
109 -- * Traversal
110 -- ** Map
111 , map
112 , mapWithKey
113 , traverseWithKey
114 , mapAccum
115 , mapAccumWithKey
116 , mapAccumRWithKey
117 , mapKeys
118 , mapKeysWith
119 , mapKeysMonotonic
120
121 -- * Folds
122 , foldr
123 , foldl
124 , foldrWithKey
125 , foldlWithKey
126 -- ** Strict folds
127 , foldr'
128 , foldl'
129 , foldrWithKey'
130 , foldlWithKey'
131
132 -- * Conversion
133 , elems
134 , keys
135 , assocs
136 , keysSet
137 , fromSet
138
139 -- ** Lists
140 , toList
141 , fromList
142 , fromListWith
143 , fromListWithKey
144
145 -- ** Ordered lists
146 , toAscList
147 , toDescList
148 , fromAscList
149 , fromAscListWith
150 , fromAscListWithKey
151 , fromDistinctAscList
152
153 -- * Filter
154 , filter
155 , filterWithKey
156 , partition
157 , partitionWithKey
158
159 , mapMaybe
160 , mapMaybeWithKey
161 , mapEither
162 , mapEitherWithKey
163
164 , split
165 , splitLookup
166
167 -- * Submap
168 , isSubmapOf, isSubmapOfBy
169 , isProperSubmapOf, isProperSubmapOfBy
170
171 -- * Min\/Max
172 , findMin
173 , findMax
174 , deleteMin
175 , deleteMax
176 , deleteFindMin
177 , deleteFindMax
178 , updateMin
179 , updateMax
180 , updateMinWithKey
181 , updateMaxWithKey
182 , minView
183 , maxView
184 , minViewWithKey
185 , maxViewWithKey
186
187 -- * Debugging
188 , showTree
189 , showTreeWith
190
191 -- * Internal types
192 , Mask, Prefix, Nat
193
194 -- * Utility
195 , natFromInt
196 , intFromNat
197 , join
198 , bin
199 , zero
200 , nomatch
201 , match
202 , mask
203 , maskW
204 , shorter
205 , branchMask
206 , highestBitMask
207 , foldlStrict
208 ) where
209
210 import Control.Applicative (Applicative(pure, (<*>)), (<$>))
211 import Control.DeepSeq (NFData(rnf))
212 import Control.Monad (liftM)
213 import Data.Bits
214 import qualified Data.Foldable as Foldable
215 import Data.Maybe (fromMaybe)
216 import Data.Monoid (Monoid(..))
217 import Data.Traversable (Traversable(traverse))
218 import Data.Typeable
219 import Data.Word (Word)
220 import Prelude hiding (lookup, map, filter, foldr, foldl, null)
221
222 import Data.BitUtil
223 import Data.IntSet.Base (Key)
224 import qualified Data.IntSet.Base as IntSet
225 import Data.StrictPair
226
227 #if __GLASGOW_HASKELL__
228 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
229 DataType, mkDataType)
230 import GHC.Exts (build)
231 import Text.Read
232 #endif
233
234 -- Use macros to define strictness of functions.
235 -- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
236 -- We do not use BangPatterns, because they are not in any standard and we
237 -- want the compilers to be compiled by as many compilers as possible.
238 #define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
239
240 -- A "Nat" is a natural machine word (an unsigned Int)
241 type Nat = Word
242
243 natFromInt :: Key -> Nat
244 natFromInt = fromIntegral
245 {-# INLINE natFromInt #-}
246
247 intFromNat :: Nat -> Key
248 intFromNat = fromIntegral
249 {-# INLINE intFromNat #-}
250
251 {--------------------------------------------------------------------
252 Types
253 --------------------------------------------------------------------}
254
255
256 -- | A map of integers to values @a@.
257
258 -- See Note: Order of constructors
259 data IntMap a = Bin {-# UNPACK #-} !Prefix
260 {-# UNPACK #-} !Mask
261 !(IntMap a)
262 !(IntMap a)
263 | Tip {-# UNPACK #-} !Key a
264 | Nil
265
266 type Prefix = Int
267 type Mask = Int
268
269 {--------------------------------------------------------------------
270 Operators
271 --------------------------------------------------------------------}
272
273 -- | /O(min(n,W))/. Find the value at a key.
274 -- Calls 'error' when the element can not be found.
275 --
276 -- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
277 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
278
279 (!) :: IntMap a -> Key -> a
280 m ! k = find k m
281
282 -- | Same as 'difference'.
283 (\\) :: IntMap a -> IntMap b -> IntMap a
284 m1 \\ m2 = difference m1 m2
285
286 infixl 9 \\{-This comment teaches CPP correct behaviour -}
287
288 {--------------------------------------------------------------------
289 Types
290 --------------------------------------------------------------------}
291
292 instance Monoid (IntMap a) where
293 mempty = empty
294 mappend = union
295 mconcat = unions
296
297 instance Foldable.Foldable IntMap where
298 fold t = go t
299 where go Nil = mempty
300 go (Tip _ v) = v
301 go (Bin _ _ l r) = go l `mappend` go r
302 {-# INLINABLE fold #-}
303 foldr = foldr
304 {-# INLINE foldr #-}
305 foldl = foldl
306 {-# INLINE foldl #-}
307 foldMap f t = go t
308 where go Nil = mempty
309 go (Tip _ v) = f v
310 go (Bin _ _ l r) = go l `mappend` go r
311 {-# INLINE foldMap #-}
312
313 instance Traversable IntMap where
314 traverse f = traverseWithKey (\_ -> f)
315
316 instance NFData a => NFData (IntMap a) where
317 rnf Nil = ()
318 rnf (Tip _ v) = rnf v
319 rnf (Bin _ _ l r) = rnf l `seq` rnf r
320
321 #if __GLASGOW_HASKELL__
322
323 {--------------------------------------------------------------------
324 A Data instance
325 --------------------------------------------------------------------}
326
327 -- This instance preserves data abstraction at the cost of inefficiency.
328 -- We provide limited reflection services for the sake of data abstraction.
329
330 instance Data a => Data (IntMap a) where
331 gfoldl f z im = z fromList `f` (toList im)
332 toConstr _ = fromListConstr
333 gunfold k z c = case constrIndex c of
334 1 -> k (z fromList)
335 _ -> error "gunfold"
336 dataTypeOf _ = intMapDataType
337 dataCast1 f = gcast1 f
338
339 fromListConstr :: Constr
340 fromListConstr = mkConstr intMapDataType "fromList" [] Prefix
341
342 intMapDataType :: DataType
343 intMapDataType = mkDataType "Data.IntMap.Base.IntMap" [fromListConstr]
344
345 #endif
346
347 {--------------------------------------------------------------------
348 Query
349 --------------------------------------------------------------------}
350 -- | /O(1)/. Is the map empty?
351 --
352 -- > Data.IntMap.null (empty) == True
353 -- > Data.IntMap.null (singleton 1 'a') == False
354
355 null :: IntMap a -> Bool
356 null Nil = True
357 null _ = False
358 {-# INLINE null #-}
359
360 -- | /O(n)/. Number of elements in the map.
361 --
362 -- > size empty == 0
363 -- > size (singleton 1 'a') == 1
364 -- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3
365 size :: IntMap a -> Int
366 size t
367 = case t of
368 Bin _ _ l r -> size l + size r
369 Tip _ _ -> 1
370 Nil -> 0
371
372 -- | /O(min(n,W))/. Is the key a member of the map?
373 --
374 -- > member 5 (fromList [(5,'a'), (3,'b')]) == True
375 -- > member 1 (fromList [(5,'a'), (3,'b')]) == False
376
377 -- See Note: Local 'go' functions and capturing]
378 member :: Key -> IntMap a -> Bool
379 member k = k `seq` go
380 where
381 go (Bin p m l r) | nomatch k p m = False
382 | zero k m = go l
383 | otherwise = go r
384 go (Tip kx _) = k == kx
385 go Nil = False
386
387 -- | /O(min(n,W))/. Is the key not a member of the map?
388 --
389 -- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
390 -- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
391
392 notMember :: Key -> IntMap a -> Bool
393 notMember k m = not $ member k m
394
395 -- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.
396
397 -- See Note: Local 'go' functions and capturing]
398 lookup :: Key -> IntMap a -> Maybe a
399 lookup k = k `seq` go
400 where
401 go (Bin p m l r) | nomatch k p m = Nothing
402 | zero k m = go l
403 | otherwise = go r
404 go (Tip kx x) | k == kx = Just x
405 | otherwise = Nothing
406 go Nil = Nothing
407
408
409 -- See Note: Local 'go' functions and capturing]
410 find :: Key -> IntMap a -> a
411 find k = k `seq` go
412 where
413 go (Bin p m l r) | nomatch k p m = not_found
414 | zero k m = go l
415 | otherwise = go r
416 go (Tip kx x) | k == kx = x
417 | otherwise = not_found
418 go Nil = not_found
419
420 not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map")
421
422 -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
423 -- returns the value at key @k@ or returns @def@ when the key is not an
424 -- element of the map.
425 --
426 -- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
427 -- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
428
429 -- See Note: Local 'go' functions and capturing]
430 findWithDefault :: a -> Key -> IntMap a -> a
431 findWithDefault def k = k `seq` go
432 where
433 go (Bin p m l r) | nomatch k p m = def
434 | zero k m = go l
435 | otherwise = go r
436 go (Tip kx x) | k == kx = x
437 | otherwise = def
438 go Nil = def
439
440 -- | /O(log n)/. Find largest key smaller than the given one and return the
441 -- corresponding (key, value) pair.
442 --
443 -- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing
444 -- > lookupLT 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
445
446 -- See Note: Local 'go' functions and capturing.
447 lookupLT :: Key -> IntMap a -> Maybe (Key, a)
448 lookupLT k t = k `seq` case t of
449 Bin _ m l r | m < 0 -> if k >= 0 then go r l else go Nil r
450 _ -> go Nil t
451 where
452 go def (Bin p m l r) | nomatch k p m = if k < p then unsafeFindMax def else unsafeFindMax r
453 | zero k m = go def l
454 | otherwise = go l r
455 go def (Tip ky y) | k <= ky = unsafeFindMax def
456 | otherwise = Just (ky, y)
457 go def Nil = unsafeFindMax def
458
459 -- | /O(log n)/. Find smallest key greater than the given one and return the
460 -- corresponding (key, value) pair.
461 --
462 -- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
463 -- > lookupGT 5 (fromList [(3,'a'), (5,'b')]) == Nothing
464
465 -- See Note: Local 'go' functions and capturing.
466 lookupGT :: Key -> IntMap a -> Maybe (Key, a)
467 lookupGT k t = k `seq` case t of
468 Bin _ m l r | m < 0 -> if k >= 0 then go Nil l else go l r
469 _ -> go Nil t
470 where
471 go def (Bin p m l r) | nomatch k p m = if k < p then unsafeFindMin l else unsafeFindMin def
472 | zero k m = go r l
473 | otherwise = go def r
474 go def (Tip ky y) | k >= ky = unsafeFindMin def
475 | otherwise = Just (ky, y)
476 go def Nil = unsafeFindMin def
477
478 -- | /O(log n)/. Find largest key smaller or equal to the given one and return
479 -- the corresponding (key, value) pair.
480 --
481 -- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing
482 -- > lookupLE 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
483 -- > lookupLE 5 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
484
485 -- See Note: Local 'go' functions and capturing.
486 lookupLE :: Key -> IntMap a -> Maybe (Key, a)
487 lookupLE k t = k `seq` case t of
488 Bin _ m l r | m < 0 -> if k >= 0 then go r l else go Nil r
489 _ -> go Nil t
490 where
491 go def (Bin p m l r) | nomatch k p m = if k < p then unsafeFindMax def else unsafeFindMax r
492 | zero k m = go def l
493 | otherwise = go l r
494 go def (Tip ky y) | k < ky = unsafeFindMax def
495 | otherwise = Just (ky, y)
496 go def Nil = unsafeFindMax def
497
498 -- | /O(log n)/. Find smallest key greater or equal to the given one and return
499 -- the corresponding (key, value) pair.
500 --
501 -- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
502 -- > lookupGE 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
503 -- > lookupGE 6 (fromList [(3,'a'), (5,'b')]) == Nothing
504
505 -- See Note: Local 'go' functions and capturing.
506 lookupGE :: Key -> IntMap a -> Maybe (Key, a)
507 lookupGE k t = k `seq` case t of
508 Bin _ m l r | m < 0 -> if k >= 0 then go Nil l else go l r
509 _ -> go Nil t
510 where
511 go def (Bin p m l r) | nomatch k p m = if k < p then unsafeFindMin l else unsafeFindMin def
512 | zero k m = go r l
513 | otherwise = go def r
514 go def (Tip ky y) | k > ky = unsafeFindMin def
515 | otherwise = Just (ky, y)
516 go def Nil = unsafeFindMin def
517
518
519 -- Helper function for lookupGE and lookupGT. It assumes that if a Bin node is
520 -- given, it has m > 0.
521 unsafeFindMin :: IntMap a -> Maybe (Key, a)
522 unsafeFindMin Nil = Nothing
523 unsafeFindMin (Tip ky y) = Just (ky, y)
524 unsafeFindMin (Bin _ _ l _) = unsafeFindMin l
525
526 -- Helper function for lookupLE and lookupLT. It assumes that if a Bin node is
527 -- given, it has m > 0.
528 unsafeFindMax :: IntMap a -> Maybe (Key, a)
529 unsafeFindMax Nil = Nothing
530 unsafeFindMax (Tip ky y) = Just (ky, y)
531 unsafeFindMax (Bin _ _ _ r) = unsafeFindMax r
532
533 {--------------------------------------------------------------------
534 Construction
535 --------------------------------------------------------------------}
536 -- | /O(1)/. The empty map.
537 --
538 -- > empty == fromList []
539 -- > size empty == 0
540
541 empty :: IntMap a
542 empty
543 = Nil
544 {-# INLINE empty #-}
545
546 -- | /O(1)/. A map of one element.
547 --
548 -- > singleton 1 'a' == fromList [(1, 'a')]
549 -- > size (singleton 1 'a') == 1
550
551 singleton :: Key -> a -> IntMap a
552 singleton k x
553 = Tip k x
554 {-# INLINE singleton #-}
555
556 {--------------------------------------------------------------------
557 Insert
558 --------------------------------------------------------------------}
559 -- | /O(min(n,W))/. Insert a new key\/value pair in the map.
560 -- If the key is already present in the map, the associated value is
561 -- replaced with the supplied value, i.e. 'insert' is equivalent to
562 -- @'insertWith' 'const'@.
563 --
564 -- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
565 -- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
566 -- > insert 5 'x' empty == singleton 5 'x'
567
568 insert :: Key -> a -> IntMap a -> IntMap a
569 insert k x t = k `seq`
570 case t of
571 Bin p m l r
572 | nomatch k p m -> join k (Tip k x) p t
573 | zero k m -> Bin p m (insert k x l) r
574 | otherwise -> Bin p m l (insert k x r)
575 Tip ky _
576 | k==ky -> Tip k x
577 | otherwise -> join k (Tip k x) ky t
578 Nil -> Tip k x
579
580 -- right-biased insertion, used by 'union'
581 -- | /O(min(n,W))/. Insert with a combining function.
582 -- @'insertWith' f key value mp@
583 -- will insert the pair (key, value) into @mp@ if key does
584 -- not exist in the map. If the key does exist, the function will
585 -- insert @f new_value old_value@.
586 --
587 -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
588 -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
589 -- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
590
591 insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
592 insertWith f k x t
593 = insertWithKey (\_ x' y' -> f x' y') k x t
594
595 -- | /O(min(n,W))/. Insert with a combining function.
596 -- @'insertWithKey' f key value mp@
597 -- will insert the pair (key, value) into @mp@ if key does
598 -- not exist in the map. If the key does exist, the function will
599 -- insert @f key new_value old_value@.
600 --
601 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
602 -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
603 -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
604 -- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
605
606 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
607 insertWithKey f k x t = k `seq`
608 case t of
609 Bin p m l r
610 | nomatch k p m -> join k (Tip k x) p t
611 | zero k m -> Bin p m (insertWithKey f k x l) r
612 | otherwise -> Bin p m l (insertWithKey f k x r)
613 Tip ky y
614 | k==ky -> Tip k (f k x y)
615 | otherwise -> join k (Tip k x) ky t
616 Nil -> Tip k x
617
618 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
619 -- is a pair where the first element is equal to (@'lookup' k map@)
620 -- and the second element equal to (@'insertWithKey' f k x map@).
621 --
622 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
623 -- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
624 -- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
625 -- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
626 --
627 -- This is how to define @insertLookup@ using @insertLookupWithKey@:
628 --
629 -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
630 -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
631 -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
632
633 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
634 insertLookupWithKey f k x t = k `seq`
635 case t of
636 Bin p m l r
637 | nomatch k p m -> (Nothing,join k (Tip k x) p t)
638 | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
639 | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
640 Tip ky y
641 | k==ky -> (Just y,Tip k (f k x y))
642 | otherwise -> (Nothing,join k (Tip k x) ky t)
643 Nil -> (Nothing,Tip k x)
644
645
646 {--------------------------------------------------------------------
647 Deletion
648 --------------------------------------------------------------------}
649 -- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
650 -- a member of the map, the original map is returned.
651 --
652 -- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
653 -- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
654 -- > delete 5 empty == empty
655
656 delete :: Key -> IntMap a -> IntMap a
657 delete k t = k `seq`
658 case t of
659 Bin p m l r
660 | nomatch k p m -> t
661 | zero k m -> bin p m (delete k l) r
662 | otherwise -> bin p m l (delete k r)
663 Tip ky _
664 | k==ky -> Nil
665 | otherwise -> t
666 Nil -> Nil
667
668 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
669 -- a member of the map, the original map is returned.
670 --
671 -- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
672 -- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
673 -- > adjust ("new " ++) 7 empty == empty
674
675 adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
676 adjust f k m
677 = adjustWithKey (\_ x -> f x) k m
678
679 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
680 -- a member of the map, the original map is returned.
681 --
682 -- > let f key x = (show key) ++ ":new " ++ x
683 -- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
684 -- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
685 -- > adjustWithKey f 7 empty == empty
686
687 adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
688 adjustWithKey f
689 = updateWithKey (\k' x -> Just (f k' x))
690
691 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
692 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
693 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
694 --
695 -- > let f x = if x == "a" then Just "new a" else Nothing
696 -- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
697 -- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
698 -- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
699
700 update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
701 update f
702 = updateWithKey (\_ x -> f x)
703
704 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
705 -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
706 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
707 --
708 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
709 -- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
710 -- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
711 -- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
712
713 updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
714 updateWithKey f k t = k `seq`
715 case t of
716 Bin p m l r
717 | nomatch k p m -> t
718 | zero k m -> bin p m (updateWithKey f k l) r
719 | otherwise -> bin p m l (updateWithKey f k r)
720 Tip ky y
721 | k==ky -> case (f k y) of
722 Just y' -> Tip ky y'
723 Nothing -> Nil
724 | otherwise -> t
725 Nil -> Nil
726
727 -- | /O(min(n,W))/. Lookup and update.
728 -- The function returns original value, if it is updated.
729 -- This is different behavior than 'Data.Map.updateLookupWithKey'.
730 -- Returns the original key value if the map entry is deleted.
731 --
732 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
733 -- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])
734 -- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
735 -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
736
737 updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
738 updateLookupWithKey f k t = k `seq`
739 case t of
740 Bin p m l r
741 | nomatch k p m -> (Nothing,t)
742 | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
743 | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
744 Tip ky y
745 | k==ky -> case (f k y) of
746 Just y' -> (Just y,Tip ky y')
747 Nothing -> (Just y,Nil)
748 | otherwise -> (Nothing,t)
749 Nil -> (Nothing,Nil)
750
751
752
753 -- | /O(min(n,W))/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
754 -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
755 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
756 alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
757 alter f k t = k `seq`
758 case t of
759 Bin p m l r
760 | nomatch k p m -> case f Nothing of
761 Nothing -> t
762 Just x -> join k (Tip k x) p t
763 | zero k m -> bin p m (alter f k l) r
764 | otherwise -> bin p m l (alter f k r)
765 Tip ky y
766 | k==ky -> case f (Just y) of
767 Just x -> Tip ky x
768 Nothing -> Nil
769 | otherwise -> case f Nothing of
770 Just x -> join k (Tip k x) ky t
771 Nothing -> Tip ky y
772 Nil -> case f Nothing of
773 Just x -> Tip k x
774 Nothing -> Nil
775
776
777 {--------------------------------------------------------------------
778 Union
779 --------------------------------------------------------------------}
780 -- | The union of a list of maps.
781 --
782 -- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
783 -- > == fromList [(3, "b"), (5, "a"), (7, "C")]
784 -- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
785 -- > == fromList [(3, "B3"), (5, "A3"), (7, "C")]
786
787 unions :: [IntMap a] -> IntMap a
788 unions xs
789 = foldlStrict union empty xs
790
791 -- | The union of a list of maps, with a combining operation.
792 --
793 -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
794 -- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
795
796 unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
797 unionsWith f ts
798 = foldlStrict (unionWith f) empty ts
799
800 -- | /O(n+m)/. The (left-biased) union of two maps.
801 -- It prefers the first map when duplicate keys are encountered,
802 -- i.e. (@'union' == 'unionWith' 'const'@).
803 --
804 -- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]
805
806 union :: IntMap a -> IntMap a -> IntMap a
807 union m1 m2
808 = mergeWithKey' Bin const id id m1 m2
809
810 -- | /O(n+m)/. The union with a combining function.
811 --
812 -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
813
814 unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
815 unionWith f m1 m2
816 = unionWithKey (\_ x y -> f x y) m1 m2
817
818 -- | /O(n+m)/. The union with a combining function.
819 --
820 -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
821 -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
822
823 unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
824 unionWithKey f m1 m2
825 = mergeWithKey' Bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 (f k1 x1 x2)) id id m1 m2
826
827 {--------------------------------------------------------------------
828 Difference
829 --------------------------------------------------------------------}
830 -- | /O(n+m)/. Difference between two maps (based on keys).
831 --
832 -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"
833
834 difference :: IntMap a -> IntMap b -> IntMap a
835 difference m1 m2
836 = mergeWithKey (\_ _ _ -> Nothing) id (const Nil) m1 m2
837
838 -- | /O(n+m)/. Difference with a combining function.
839 --
840 -- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
841 -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
842 -- > == singleton 3 "b:B"
843
844 differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
845 differenceWith f m1 m2
846 = differenceWithKey (\_ x y -> f x y) m1 m2
847
848 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
849 -- encountered, the combining function is applied to the key and both values.
850 -- If it returns 'Nothing', the element is discarded (proper set difference).
851 -- If it returns (@'Just' y@), the element is updated with a new value @y@.
852 --
853 -- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
854 -- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
855 -- > == singleton 3 "3:b|B"
856
857 differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
858 differenceWithKey f m1 m2
859 = mergeWithKey f id (const Nil) m1 m2
860
861
862 {--------------------------------------------------------------------
863 Intersection
864 --------------------------------------------------------------------}
865 -- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
866 --
867 -- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
868
869 intersection :: IntMap a -> IntMap b -> IntMap a
870 intersection m1 m2
871 = mergeWithKey' bin const (const Nil) (const Nil) m1 m2
872
873 -- | /O(n+m)/. The intersection with a combining function.
874 --
875 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
876
877 intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
878 intersectionWith f m1 m2
879 = intersectionWithKey (\_ x y -> f x y) m1 m2
880
881 -- | /O(n+m)/. The intersection with a combining function.
882 --
883 -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
884 -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
885
886 intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
887 intersectionWithKey f m1 m2
888 = mergeWithKey' bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 (f k1 x1 x2)) (const Nil) (const Nil) m1 m2
889
890 {--------------------------------------------------------------------
891 MergeWithKey
892 --------------------------------------------------------------------}
893
894 -- | /O(n+m)/. A high-performance universal combining function. Using
895 -- 'mergeWithKey', all combining functions can be defined without any loss of
896 -- efficiency (with exception of 'union', 'difference' and 'intersection',
897 -- where sharing of some nodes is lost with 'mergeWithKey').
898 --
899 -- Please make sure you know what is going on when using 'mergeWithKey',
900 -- otherwise you can be surprised by unexpected code growth or even
901 -- corruption of the data structure.
902 --
903 -- When 'mergeWithKey' is given three arguments, it is inlined to the call
904 -- site. You should therefore use 'mergeWithKey' only to define your custom
905 -- combining functions. For example, you could define 'unionWithKey',
906 -- 'differenceWithKey' and 'intersectionWithKey' as
907 --
908 -- > myUnionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) id id m1 m2
909 -- > myDifferenceWithKey f m1 m2 = mergeWithKey f id (const empty) m1 m2
910 -- > myIntersectionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) (const empty) (const empty) m1 m2
911 --
912 -- When calling @'mergeWithKey' combine only1 only2@, a function combining two
913 -- 'IntMap's is created, such that
914 --
915 -- * if a key is present in both maps, it is passed with both corresponding
916 -- values to the @combine@ function. Depending on the result, the key is either
917 -- present in the result with specified value, or is left out;
918 --
919 -- * a nonempty subtree present only in the first map is passed to @only1@ and
920 -- the output is added to the result;
921 --
922 -- * a nonempty subtree present only in the second map is passed to @only2@ and
923 -- the output is added to the result.
924 --
925 -- The @only1@ and @only2@ methods /must return a map with a subset (possibly empty) of the keys of the given map/.
926 -- The values can be modified arbitrarily. Most common variants of @only1@ and
927 -- @only2@ are 'id' and @'const' 'empty'@, but for example @'map' f@ or
928 -- @'filterWithKey' f@ could be used for any @f@.
929
930 mergeWithKey :: (Key -> a -> b -> Maybe c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
931 -> IntMap a -> IntMap b -> IntMap c
932 mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2
933 where -- We use the lambda form to avoid non-exhaustive pattern matches warning.
934 combine = \(Tip k1 x1) (Tip _k2 x2) -> case f k1 x1 x2 of Nothing -> Nil
935 Just x -> Tip k1 x
936 {-# INLINE combine #-}
937 {-# INLINE mergeWithKey #-}
938
939 -- Slightly more general version of mergeWithKey. It differs in the following:
940 --
941 -- * the combining function operates on maps instead of keys and values. The
942 -- reason is to enable sharing in union, difference and intersection.
943 --
944 -- * mergeWithKey' is given an equivalent of bin. The reason is that in union*,
945 -- Bin constructor can be used, because we know both subtrees are nonempty.
946
947 mergeWithKey' :: (Prefix -> Mask -> IntMap c -> IntMap c -> IntMap c)
948 -> (IntMap a -> IntMap b -> IntMap c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
949 -> IntMap a -> IntMap b -> IntMap c
950 mergeWithKey' bin' f g1 g2 = go
951 where
952 go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
953 | shorter m1 m2 = merge1
954 | shorter m2 m1 = merge2
955 | p1 == p2 = bin' p1 m1 (go l1 l2) (go r1 r2)
956 | otherwise = maybe_join p1 (g1 t1) p2 (g2 t2)
957 where
958 merge1 | nomatch p2 p1 m1 = maybe_join p1 (g1 t1) p2 (g2 t2)
959 | zero p2 m1 = bin' p1 m1 (go l1 t2) (g1 r1)
960 | otherwise = bin' p1 m1 (g1 l1) (go r1 t2)
961 merge2 | nomatch p1 p2 m2 = maybe_join p1 (g1 t1) p2 (g2 t2)
962 | zero p1 m2 = bin' p2 m2 (go t1 l2) (g2 r2)
963 | otherwise = bin' p2 m2 (g2 l2) (go t1 r2)
964
965 go t1'@(Bin _ _ _ _) t2'@(Tip k2' _) = merge t2' k2' t1'
966 where merge t2 k2 t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = maybe_join p1 (g1 t1) k2 (g2 t2)
967 | zero k2 m1 = bin' p1 m1 (merge t2 k2 l1) (g1 r1)
968 | otherwise = bin' p1 m1 (g1 l1) (merge t2 k2 r1)
969 merge t2 k2 t1@(Tip k1 _) | k1 == k2 = f t1 t2
970 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
971 merge t2 _ Nil = g2 t2
972
973 go t1@(Bin _ _ _ _) Nil = g1 t1
974
975 go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
976 where merge t1 k1 t2@(Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = maybe_join k1 (g1 t1) p2 (g2 t2)
977 | zero k1 m2 = bin' p2 m2 (merge t1 k1 l2) (g2 r2)
978 | otherwise = bin' p2 m2 (g2 l2) (merge t1 k1 r2)
979 merge t1 k1 t2@(Tip k2 _) | k1 == k2 = f t1 t2
980 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
981 merge t1 _ Nil = g1 t1
982
983 go Nil t2 = g2 t2
984
985 maybe_join _ Nil _ t2 = t2
986 maybe_join _ t1 _ Nil = t1
987 maybe_join p1 t1 p2 t2 = join p1 t1 p2 t2
988 {-# INLINE maybe_join #-}
989 {-# INLINE mergeWithKey' #-}
990
991 {--------------------------------------------------------------------
992 Min\/Max
993 --------------------------------------------------------------------}
994
995 -- | /O(min(n,W))/. Update the value at the minimal key.
996 --
997 -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
998 -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
999
1000 updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
1001 updateMinWithKey f t =
1002 case t of Bin p m l r | m < 0 -> bin p m l (go f r)
1003 _ -> go f t
1004 where
1005 go f' (Bin p m l r) = bin p m (go f' l) r
1006 go f' (Tip k y) = case f' k y of
1007 Just y' -> Tip k y'
1008 Nothing -> Nil
1009 go _ Nil = error "updateMinWithKey Nil"
1010
1011 -- | /O(min(n,W))/. Update the value at the maximal key.
1012 --
1013 -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
1014 -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1015
1016 updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
1017 updateMaxWithKey f t =
1018 case t of Bin p m l r | m < 0 -> bin p m (go f l) r
1019 _ -> go f t
1020 where
1021 go f' (Bin p m l r) = bin p m l (go f' r)
1022 go f' (Tip k y) = case f' k y of
1023 Just y' -> Tip k y'
1024 Nothing -> Nil
1025 go _ Nil = error "updateMaxWithKey Nil"
1026
1027 -- | /O(min(n,W))/. Retrieves the maximal (key,value) pair of the map, and
1028 -- the map stripped of that element, or 'Nothing' if passed an empty map.
1029 --
1030 -- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
1031 -- > maxViewWithKey empty == Nothing
1032
1033 maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
1034 maxViewWithKey t =
1035 case t of Nil -> Nothing
1036 Bin p m l r | m < 0 -> case go l of (result, l') -> Just (result, bin p m l' r)
1037 _ -> Just (go t)
1038 where
1039 go (Bin p m l r) = case go r of (result, r') -> (result, bin p m l r')
1040 go (Tip k y) = ((k, y), Nil)
1041 go Nil = error "maxViewWithKey Nil"
1042
1043 -- | /O(min(n,W))/. Retrieves the minimal (key,value) pair of the map, and
1044 -- the map stripped of that element, or 'Nothing' if passed an empty map.
1045 --
1046 -- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
1047 -- > minViewWithKey empty == Nothing
1048
1049 minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
1050 minViewWithKey t =
1051 case t of Nil -> Nothing
1052 Bin p m l r | m < 0 -> case go r of (result, r') -> Just (result, bin p m l r')
1053 _ -> Just (go t)
1054 where
1055 go (Bin p m l r) = case go l of (result, l') -> (result, bin p m l' r)
1056 go (Tip k y) = ((k, y), Nil)
1057 go Nil = error "minViewWithKey Nil"
1058
1059 -- | /O(min(n,W))/. Update the value at the maximal key.
1060 --
1061 -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
1062 -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1063
1064 updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a
1065 updateMax f = updateMaxWithKey (const f)
1066
1067 -- | /O(min(n,W))/. Update the value at the minimal key.
1068 --
1069 -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
1070 -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1071
1072 updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a
1073 updateMin f = updateMinWithKey (const f)
1074
1075 -- Similar to the Arrow instance.
1076 first :: (a -> c) -> (a, b) -> (c, b)
1077 first f (x,y) = (f x,y)
1078
1079 -- | /O(min(n,W))/. Retrieves the maximal key of the map, and the map
1080 -- stripped of that element, or 'Nothing' if passed an empty map.
1081 maxView :: IntMap a -> Maybe (a, IntMap a)
1082 maxView t = liftM (first snd) (maxViewWithKey t)
1083
1084 -- | /O(min(n,W))/. Retrieves the minimal key of the map, and the map
1085 -- stripped of that element, or 'Nothing' if passed an empty map.
1086 minView :: IntMap a -> Maybe (a, IntMap a)
1087 minView t = liftM (first snd) (minViewWithKey t)
1088
1089 -- | /O(min(n,W))/. Delete and find the maximal element.
1090 deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
1091 deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey
1092
1093 -- | /O(min(n,W))/. Delete and find the minimal element.
1094 deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
1095 deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey
1096
1097 -- | /O(min(n,W))/. The minimal key of the map.
1098 findMin :: IntMap a -> (Key, a)
1099 findMin Nil = error $ "findMin: empty map has no minimal element"
1100 findMin (Tip k v) = (k,v)
1101 findMin (Bin _ m l r)
1102 | m < 0 = go r
1103 | otherwise = go l
1104 where go (Tip k v) = (k,v)
1105 go (Bin _ _ l' _) = go l'
1106 go Nil = error "findMax Nil"
1107
1108 -- | /O(min(n,W))/. The maximal key of the map.
1109 findMax :: IntMap a -> (Key, a)
1110 findMax Nil = error $ "findMax: empty map has no maximal element"
1111 findMax (Tip k v) = (k,v)
1112 findMax (Bin _ m l r)
1113 | m < 0 = go l
1114 | otherwise = go r
1115 where go (Tip k v) = (k,v)
1116 go (Bin _ _ _ r') = go r'
1117 go Nil = error "findMax Nil"
1118
1119 -- | /O(min(n,W))/. Delete the minimal key. Returns an empty map if the map is empty.
1120 --
1121 -- Note that this is a change of behaviour for consistency with 'Data.Map.Map' &#8211;
1122 -- versions prior to 0.5 threw an error if the 'IntMap' was already empty.
1123 deleteMin :: IntMap a -> IntMap a
1124 deleteMin = maybe Nil snd . minView
1125
1126 -- | /O(min(n,W))/. Delete the maximal key. Returns an empty map if the map is empty.
1127 --
1128 -- Note that this is a change of behaviour for consistency with 'Data.Map.Map' &#8211;
1129 -- versions prior to 0.5 threw an error if the 'IntMap' was already empty.
1130 deleteMax :: IntMap a -> IntMap a
1131 deleteMax = maybe Nil snd . maxView
1132
1133
1134 {--------------------------------------------------------------------
1135 Submap
1136 --------------------------------------------------------------------}
1137 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
1138 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
1139 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1140 isProperSubmapOf m1 m2
1141 = isProperSubmapOfBy (==) m1 m2
1142
1143 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
1144 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
1145 @m1@ and @m2@ are not equal,
1146 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
1147 applied to their respective values. For example, the following
1148 expressions are all 'True':
1149
1150 > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1151 > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1152
1153 But the following are all 'False':
1154
1155 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
1156 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
1157 > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1158 -}
1159 isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
1160 isProperSubmapOfBy predicate t1 t2
1161 = case submapCmp predicate t1 t2 of
1162 LT -> True
1163 _ -> False
1164
1165 submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
1166 submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1167 | shorter m1 m2 = GT
1168 | shorter m2 m1 = submapCmpLt
1169 | p1 == p2 = submapCmpEq
1170 | otherwise = GT -- disjoint
1171 where
1172 submapCmpLt | nomatch p1 p2 m2 = GT
1173 | zero p1 m2 = submapCmp predicate t1 l2
1174 | otherwise = submapCmp predicate t1 r2
1175 submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of
1176 (GT,_ ) -> GT
1177 (_ ,GT) -> GT
1178 (EQ,EQ) -> EQ
1179 _ -> LT
1180
1181 submapCmp _ (Bin _ _ _ _) _ = GT
1182 submapCmp predicate (Tip kx x) (Tip ky y)
1183 | (kx == ky) && predicate x y = EQ
1184 | otherwise = GT -- disjoint
1185 submapCmp predicate (Tip k x) t
1186 = case lookup k t of
1187 Just y | predicate x y -> LT
1188 _ -> GT -- disjoint
1189 submapCmp _ Nil Nil = EQ
1190 submapCmp _ Nil _ = LT
1191
1192 -- | /O(n+m)/. Is this a submap?
1193 -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
1194 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1195 isSubmapOf m1 m2
1196 = isSubmapOfBy (==) m1 m2
1197
1198 {- | /O(n+m)/.
1199 The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
1200 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
1201 applied to their respective values. For example, the following
1202 expressions are all 'True':
1203
1204 > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1205 > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1206 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
1207
1208 But the following are all 'False':
1209
1210 > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
1211 > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1212 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
1213 -}
1214 isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
1215 isSubmapOfBy predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1216 | shorter m1 m2 = False
1217 | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy predicate t1 l2
1218 else isSubmapOfBy predicate t1 r2)
1219 | otherwise = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2
1220 isSubmapOfBy _ (Bin _ _ _ _) _ = False
1221 isSubmapOfBy predicate (Tip k x) t = case lookup k t of
1222 Just y -> predicate x y
1223 Nothing -> False
1224 isSubmapOfBy _ Nil _ = True
1225
1226 {--------------------------------------------------------------------
1227 Mapping
1228 --------------------------------------------------------------------}
1229 -- | /O(n)/. Map a function over all values in the map.
1230 --
1231 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
1232
1233 map :: (a -> b) -> IntMap a -> IntMap b
1234 map f t
1235 = case t of
1236 Bin p m l r -> Bin p m (map f l) (map f r)
1237 Tip k x -> Tip k (f x)
1238 Nil -> Nil
1239
1240 -- | /O(n)/. Map a function over all values in the map.
1241 --
1242 -- > let f key x = (show key) ++ ":" ++ x
1243 -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
1244
1245 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
1246 mapWithKey f t
1247 = case t of
1248 Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
1249 Tip k x -> Tip k (f k x)
1250 Nil -> Nil
1251
1252 -- | /O(n)/.
1253 -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
1254 -- That is, behaves exactly like a regular 'traverse' except that the traversing
1255 -- function also has access to the key associated with a value.
1256 --
1257 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])
1258 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')]) == Nothing
1259 traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
1260 traverseWithKey f = go
1261 where
1262 go Nil = pure Nil
1263 go (Tip k v) = Tip k <$> f k v
1264 go (Bin p m l r) = Bin p m <$> go l <*> go r
1265 {-# INLINE traverseWithKey #-}
1266
1267 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
1268 -- argument through the map in ascending order of keys.
1269 --
1270 -- > let f a b = (a ++ b, b ++ "X")
1271 -- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
1272
1273 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1274 mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
1275
1276 -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
1277 -- argument through the map in ascending order of keys.
1278 --
1279 -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
1280 -- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
1281
1282 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1283 mapAccumWithKey f a t
1284 = mapAccumL f a t
1285
1286 -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
1287 -- argument through the map in ascending order of keys.
1288 mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1289 mapAccumL f a t
1290 = case t of
1291 Bin p m l r -> let (a1,l') = mapAccumL f a l
1292 (a2,r') = mapAccumL f a1 r
1293 in (a2,Bin p m l' r')
1294 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1295 Nil -> (a,Nil)
1296
1297 -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
1298 -- argument through the map in descending order of keys.
1299 mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1300 mapAccumRWithKey f a t
1301 = case t of
1302 Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
1303 (a2,l') = mapAccumRWithKey f a1 l
1304 in (a2,Bin p m l' r')
1305 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1306 Nil -> (a,Nil)
1307
1308 -- | /O(n*min(n,W))/.
1309 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
1310 --
1311 -- The size of the result may be smaller if @f@ maps two or more distinct
1312 -- keys to the same new key. In this case the value at the greatest of the
1313 -- original keys is retained.
1314 --
1315 -- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) == fromList [(4, "b"), (6, "a")]
1316 -- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
1317 -- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
1318
1319 mapKeys :: (Key->Key) -> IntMap a -> IntMap a
1320 mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
1321
1322 -- | /O(n*min(n,W))/.
1323 -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
1324 --
1325 -- The size of the result may be smaller if @f@ maps two or more distinct
1326 -- keys to the same new key. In this case the associated values will be
1327 -- combined using @c@.
1328 --
1329 -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
1330 -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
1331
1332 mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a
1333 mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
1334
1335 -- | /O(n*min(n,W))/.
1336 -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
1337 -- is strictly monotonic.
1338 -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
1339 -- /The precondition is not checked./
1340 -- Semi-formally, we have:
1341 --
1342 -- > and [x < y ==> f x < f y | x <- ls, y <- ls]
1343 -- > ==> mapKeysMonotonic f s == mapKeys f s
1344 -- > where ls = keys s
1345 --
1346 -- This means that @f@ maps distinct original keys to distinct resulting keys.
1347 -- This function has slightly better performance than 'mapKeys'.
1348 --
1349 -- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
1350
1351 mapKeysMonotonic :: (Key->Key) -> IntMap a -> IntMap a
1352 mapKeysMonotonic f = fromDistinctAscList . foldrWithKey (\k x xs -> (f k, x) : xs) []
1353
1354 {--------------------------------------------------------------------
1355 Filter
1356 --------------------------------------------------------------------}
1357 -- | /O(n)/. Filter all values that satisfy some predicate.
1358 --
1359 -- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1360 -- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
1361 -- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
1362
1363 filter :: (a -> Bool) -> IntMap a -> IntMap a
1364 filter p m
1365 = filterWithKey (\_ x -> p x) m
1366
1367 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
1368 --
1369 -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1370
1371 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
1372 filterWithKey predicate t
1373 = case t of
1374 Bin p m l r
1375 -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
1376 Tip k x
1377 | predicate k x -> t
1378 | otherwise -> Nil
1379 Nil -> Nil
1380
1381 -- | /O(n)/. Partition the map according to some predicate. The first
1382 -- map contains all elements that satisfy the predicate, the second all
1383 -- elements that fail the predicate. See also 'split'.
1384 --
1385 -- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1386 -- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1387 -- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1388
1389 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1390 partition p m
1391 = partitionWithKey (\_ x -> p x) m
1392
1393 -- | /O(n)/. Partition the map according to some predicate. The first
1394 -- map contains all elements that satisfy the predicate, the second all
1395 -- elements that fail the predicate. See also 'split'.
1396 --
1397 -- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
1398 -- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1399 -- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1400
1401 partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1402 partitionWithKey predicate0 t0 = toPair $ go predicate0 t0
1403 where
1404 go predicate t
1405 = case t of
1406 Bin p m l r
1407 -> let (l1 :*: l2) = go predicate l
1408 (r1 :*: r2) = go predicate r
1409 in bin p m l1 r1 :*: bin p m l2 r2
1410 Tip k x
1411 | predicate k x -> (t :*: Nil)
1412 | otherwise -> (Nil :*: t)
1413 Nil -> (Nil :*: Nil)
1414
1415 -- | /O(n)/. Map values and collect the 'Just' results.
1416 --
1417 -- > let f x = if x == "a" then Just "new a" else Nothing
1418 -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
1419
1420 mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
1421 mapMaybe f = mapMaybeWithKey (\_ x -> f x)
1422
1423 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
1424 --
1425 -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
1426 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
1427
1428 mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
1429 mapMaybeWithKey f (Bin p m l r)
1430 = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
1431 mapMaybeWithKey f (Tip k x) = case f k x of
1432 Just y -> Tip k y
1433 Nothing -> Nil
1434 mapMaybeWithKey _ Nil = Nil
1435
1436 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
1437 --
1438 -- > let f a = if a < "c" then Left a else Right a
1439 -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1440 -- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
1441 -- >
1442 -- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1443 -- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1444
1445 mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1446 mapEither f m
1447 = mapEitherWithKey (\_ x -> f x) m
1448
1449 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
1450 --
1451 -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
1452 -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1453 -- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
1454 -- >
1455 -- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1456 -- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
1457
1458 mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1459 mapEitherWithKey f0 t0 = toPair $ go f0 t0
1460 where
1461 go f (Bin p m l r)
1462 = bin p m l1 r1 :*: bin p m l2 r2
1463 where
1464 (l1 :*: l2) = go f l
1465 (r1 :*: r2) = go f r
1466 go f (Tip k x) = case f k x of
1467 Left y -> (Tip k y :*: Nil)
1468 Right z -> (Nil :*: Tip k z)
1469 go _ Nil = (Nil :*: Nil)
1470
1471 -- | /O(min(n,W))/. The expression (@'split' k map@) is a pair @(map1,map2)@
1472 -- where all keys in @map1@ are lower than @k@ and all keys in
1473 -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
1474 --
1475 -- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
1476 -- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
1477 -- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1478 -- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
1479 -- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
1480
1481 split :: Key -> IntMap a -> (IntMap a, IntMap a)
1482 split k t =
1483 case t of
1484 Bin _ m l r
1485 | m < 0 -> if k >= 0 -- handle negative numbers.
1486 then case go k l of (lt :*: gt) -> let lt' = union r lt
1487 in lt' `seq` (lt', gt)
1488 else case go k r of (lt :*: gt) -> let gt' = union gt l
1489 in gt' `seq` (lt, gt')
1490 _ -> case go k t of
1491 (lt :*: gt) -> (lt, gt)
1492 where
1493 go k' t'@(Bin p m l r) | nomatch k' p m = if k' > p then t' :*: Nil else Nil :*: t'
1494 | zero k' m = case go k' l of (lt :*: gt) -> lt :*: union gt r
1495 | otherwise = case go k' r of (lt :*: gt) -> union l lt :*: gt
1496 go k' t'@(Tip ky _) | k' > ky = (t' :*: Nil)
1497 | k' < ky = (Nil :*: t')
1498 | otherwise = (Nil :*: Nil)
1499 go _ Nil = (Nil :*: Nil)
1500
1501 -- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
1502 -- key was found in the original map.
1503 --
1504 -- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
1505 -- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
1506 -- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
1507 -- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
1508 -- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
1509
1510 splitLookup :: Key -> IntMap a -> (IntMap a, Maybe a, IntMap a)
1511 splitLookup k t =
1512 case t of
1513 Bin _ m l r
1514 | m < 0 -> if k >= 0 -- handle negative numbers.
1515 then case go k l of
1516 (lt, fnd, gt) -> let lt' = union r lt
1517 in lt' `seq` (lt', fnd, gt)
1518 else case go k r of
1519 (lt, fnd, gt) -> let gt' = union gt l
1520 in gt' `seq` (lt, fnd, gt')
1521 _ -> go k t
1522 where
1523 go k' t'@(Bin p m l r)
1524 | nomatch k' p m = if k' > p then (t', Nothing, Nil) else (Nil, Nothing, t')
1525 | zero k' m = case go k' l of
1526 (lt, fnd, gt) -> let gt' = union gt r in gt' `seq` (lt, fnd, gt')
1527 | otherwise = case go k' r of
1528 (lt, fnd, gt) -> let lt' = union l lt in lt' `seq` (lt', fnd, gt)
1529 go k' t'@(Tip ky y) | k' > ky = (t', Nothing, Nil)
1530 | k' < ky = (Nil, Nothing, t')
1531 | otherwise = (Nil, Just y, Nil)
1532 go _ Nil = (Nil, Nothing, Nil)
1533
1534 {--------------------------------------------------------------------
1535 Fold
1536 --------------------------------------------------------------------}
1537 -- | /O(n)/. Fold the values in the map using the given right-associative
1538 -- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
1539 --
1540 -- For example,
1541 --
1542 -- > elems map = foldr (:) [] map
1543 --
1544 -- > let f a len = len + (length a)
1545 -- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
1546 foldr :: (a -> b -> b) -> b -> IntMap a -> b
1547 foldr f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1548 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1549 | otherwise -> go (go z r) l
1550 _ -> go z t
1551 where
1552 go z' Nil = z'
1553 go z' (Tip _ x) = f x z'
1554 go z' (Bin _ _ l r) = go (go z' r) l
1555 {-# INLINE foldr #-}
1556
1557 -- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
1558 -- evaluated before using the result in the next application. This
1559 -- function is strict in the starting value.
1560 foldr' :: (a -> b -> b) -> b -> IntMap a -> b
1561 foldr' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1562 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1563 | otherwise -> go (go z r) l
1564 _ -> go z t
1565 where
1566 STRICT_1_OF_2(go)
1567 go z' Nil = z'
1568 go z' (Tip _ x) = f x z'
1569 go z' (Bin _ _ l r) = go (go z' r) l
1570 {-# INLINE foldr' #-}
1571
1572 -- | /O(n)/. Fold the values in the map using the given left-associative
1573 -- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
1574 --
1575 -- For example,
1576 --
1577 -- > elems = reverse . foldl (flip (:)) []
1578 --
1579 -- > let f len a = len + (length a)
1580 -- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
1581 foldl :: (a -> b -> a) -> a -> IntMap b -> a
1582 foldl f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1583 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1584 | otherwise -> go (go z l) r
1585 _ -> go z t
1586 where
1587 go z' Nil = z'
1588 go z' (Tip _ x) = f z' x
1589 go z' (Bin _ _ l r) = go (go z' l) r
1590 {-# INLINE foldl #-}
1591
1592 -- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
1593 -- evaluated before using the result in the next application. This
1594 -- function is strict in the starting value.
1595 foldl' :: (a -> b -> a) -> a -> IntMap b -> a
1596 foldl' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1597 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1598 | otherwise -> go (go z l) r
1599 _ -> go z t
1600 where
1601 STRICT_1_OF_2(go)
1602 go z' Nil = z'
1603 go z' (Tip _ x) = f z' x
1604 go z' (Bin _ _ l r) = go (go z' l) r
1605 {-# INLINE foldl' #-}
1606
1607 -- | /O(n)/. Fold the keys and values in the map using the given right-associative
1608 -- binary operator, such that
1609 -- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
1610 --
1611 -- For example,
1612 --
1613 -- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
1614 --
1615 -- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
1616 -- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
1617 foldrWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1618 foldrWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1619 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1620 | otherwise -> go (go z r) l
1621 _ -> go z t
1622 where
1623 go z' Nil = z'
1624 go z' (Tip kx x) = f kx x z'
1625 go z' (Bin _ _ l r) = go (go z' r) l
1626 {-# INLINE foldrWithKey #-}
1627
1628 -- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
1629 -- evaluated before using the result in the next application. This
1630 -- function is strict in the starting value.
1631 foldrWithKey' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1632 foldrWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1633 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1634 | otherwise -> go (go z r) l
1635 _ -> go z t
1636 where
1637 STRICT_1_OF_2(go)
1638 go z' Nil = z'
1639 go z' (Tip kx x) = f kx x z'
1640 go z' (Bin _ _ l r) = go (go z' r) l
1641 {-# INLINE foldrWithKey' #-}
1642
1643 -- | /O(n)/. Fold the keys and values in the map using the given left-associative
1644 -- binary operator, such that
1645 -- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
1646 --
1647 -- For example,
1648 --
1649 -- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []
1650 --
1651 -- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
1652 -- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
1653 foldlWithKey :: (a -> Key -> b -> a) -> a -> IntMap b -> a
1654 foldlWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1655 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1656 | otherwise -> go (go z l) r
1657 _ -> go z t
1658 where
1659 go z' Nil = z'
1660 go z' (Tip kx x) = f z' kx x
1661 go z' (Bin _ _ l r) = go (go z' l) r
1662 {-# INLINE foldlWithKey #-}
1663
1664 -- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
1665 -- evaluated before using the result in the next application. This
1666 -- function is strict in the starting value.
1667 foldlWithKey' :: (a -> Key -> b -> a) -> a -> IntMap b -> a
1668 foldlWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1669 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1670 | otherwise -> go (go z l) r
1671 _ -> go z t
1672 where
1673 STRICT_1_OF_2(go)
1674 go z' Nil = z'
1675 go z' (Tip kx x) = f z' kx x
1676 go z' (Bin _ _ l r) = go (go z' l) r
1677 {-# INLINE foldlWithKey' #-}
1678
1679 {--------------------------------------------------------------------
1680 List variations
1681 --------------------------------------------------------------------}
1682 -- | /O(n)/.
1683 -- Return all elements of the map in the ascending order of their keys.
1684 -- Subject to list fusion.
1685 --
1686 -- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
1687 -- > elems empty == []
1688
1689 elems :: IntMap a -> [a]
1690 elems = foldr (:) []
1691
1692 -- | /O(n)/. Return all keys of the map in ascending order. Subject to list
1693 -- fusion.
1694 --
1695 -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
1696 -- > keys empty == []
1697
1698 keys :: IntMap a -> [Key]
1699 keys = foldrWithKey (\k _ ks -> k : ks) []
1700
1701 -- | /O(n)/. An alias for 'toAscList'. Returns all key\/value pairs in the
1702 -- map in ascending key order. Subject to list fusion.
1703 --
1704 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1705 -- > assocs empty == []
1706
1707 assocs :: IntMap a -> [(Key,a)]
1708 assocs = toAscList
1709
1710 -- | /O(n*min(n,W))/. The set of all keys of the map.
1711 --
1712 -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5]
1713 -- > keysSet empty == Data.IntSet.empty
1714
1715 keysSet :: IntMap a -> IntSet.IntSet
1716 keysSet Nil = IntSet.Nil
1717 keysSet (Tip kx _) = IntSet.singleton kx
1718 keysSet (Bin p m l r)
1719 | m .&. IntSet.suffixBitMask == 0 = IntSet.Bin p m (keysSet l) (keysSet r)
1720 | otherwise = IntSet.Tip (p .&. IntSet.prefixBitMask) (computeBm (computeBm 0 l) r)
1721 where STRICT_1_OF_2(computeBm)
1722 computeBm acc (Bin _ _ l' r') = computeBm (computeBm acc l') r'
1723 computeBm acc (Tip kx _) = acc .|. IntSet.bitmapOf kx
1724 computeBm _ Nil = error "Data.IntSet.keysSet: Nil"
1725
1726 -- | /O(n)/. Build a map from a set of keys and a function which for each key
1727 -- computes its value.
1728 --
1729 -- > fromSet (\k -> replicate k 'a') (Data.IntSet.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]
1730 -- > fromSet undefined Data.IntSet.empty == empty
1731
1732 fromSet :: (Key -> a) -> IntSet.IntSet -> IntMap a
1733 fromSet _ IntSet.Nil = Nil
1734 fromSet f (IntSet.Bin p m l r) = Bin p m (fromSet f l) (fromSet f r)
1735 fromSet f (IntSet.Tip kx bm) = buildTree f kx bm (IntSet.suffixBitMask + 1)
1736 where -- This is slightly complicated, as we to convert the dense
1737 -- representation of IntSet into tree representation of IntMap.
1738 --
1739 -- We are given a nonzero bit mask 'bmask' of 'bits' bits with prefix 'prefix'.
1740 -- We split bmask into halves corresponding to left and right subtree.
1741 -- If they are both nonempty, we create a Bin node, otherwise exactly
1742 -- one of them is nonempty and we construct the IntMap from that half.
1743 buildTree g prefix bmask bits = prefix `seq` bmask `seq` case bits of
1744 0 -> Tip prefix (g prefix)
1745 _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of
1746 bits2 | bmask .&. ((1 `shiftLL` bits2) - 1) == 0 ->
1747 buildTree g (prefix + bits2) (bmask `shiftRL` bits2) bits2
1748 | (bmask `shiftRL` bits2) .&. ((1 `shiftLL` bits2) - 1) == 0 ->
1749 buildTree g prefix bmask bits2
1750 | otherwise ->
1751 Bin prefix bits2 (buildTree g prefix bmask bits2) (buildTree g (prefix + bits2) (bmask `shiftRL` bits2) bits2)
1752
1753 {--------------------------------------------------------------------
1754 Lists
1755 --------------------------------------------------------------------}
1756 -- | /O(n)/. Convert the map to a list of key\/value pairs. Subject to list
1757 -- fusion.
1758 --
1759 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1760 -- > toList empty == []
1761
1762 toList :: IntMap a -> [(Key,a)]
1763 toList = toAscList
1764
1765 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
1766 -- keys are in ascending order. Subject to list fusion.
1767 --
1768 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1769
1770 toAscList :: IntMap a -> [(Key,a)]
1771 toAscList = foldrWithKey (\k x xs -> (k,x):xs) []
1772
1773 -- | /O(n)/. Convert the map to a list of key\/value pairs where the keys
1774 -- are in descending order. Subject to list fusion.
1775 --
1776 -- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]
1777
1778 toDescList :: IntMap a -> [(Key,a)]
1779 toDescList = foldlWithKey (\xs k x -> (k,x):xs) []
1780
1781 -- List fusion for the list generating functions.
1782 #if __GLASGOW_HASKELL__
1783 -- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.
1784 -- They are important to convert unfused methods back, see mapFB in prelude.
1785 foldrFB :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1786 foldrFB = foldrWithKey
1787 {-# INLINE[0] foldrFB #-}
1788 foldlFB :: (a -> Key -> b -> a) -> a -> IntMap b -> a
1789 foldlFB = foldlWithKey
1790 {-# INLINE[0] foldlFB #-}
1791
1792 -- Inline assocs and toList, so that we need to fuse only toAscList.
1793 {-# INLINE assocs #-}
1794 {-# INLINE toList #-}
1795
1796 -- The fusion is enabled up to phase 2 included. If it does not succeed,
1797 -- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to
1798 -- elems,keys,to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were
1799 -- used in a list fusion, otherwise it would go away in phase 1), and let compiler
1800 -- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to
1801 -- inline it before phase 0, otherwise the fusion rules would not fire at all.
1802 {-# NOINLINE[0] elems #-}
1803 {-# NOINLINE[0] keys #-}
1804 {-# NOINLINE[0] toAscList #-}
1805 {-# NOINLINE[0] toDescList #-}
1806 {-# RULES "IntMap.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
1807 {-# RULES "IntMap.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
1808 {-# RULES "IntMap.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
1809 {-# RULES "IntMap.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
1810 {-# RULES "IntMap.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
1811 {-# RULES "IntMap.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
1812 {-# RULES "IntMap.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
1813 {-# RULES "IntMap.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
1814 #endif
1815
1816
1817 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
1818 --
1819 -- > fromList [] == empty
1820 -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
1821 -- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
1822
1823 fromList :: [(Key,a)] -> IntMap a
1824 fromList xs
1825 = foldlStrict ins empty xs
1826 where
1827 ins t (k,x) = insert k x t
1828
1829 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
1830 --
1831 -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")]
1832 -- > fromListWith (++) [] == empty
1833
1834 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1835 fromListWith f xs
1836 = fromListWithKey (\_ x y -> f x y) xs
1837
1838 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
1839 --
1840 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
1841 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]
1842 -- > fromListWithKey f [] == empty
1843
1844 fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1845 fromListWithKey f xs
1846 = foldlStrict ins empty xs
1847 where
1848 ins t (k,x) = insertWithKey f k x t
1849
1850 -- | /O(n)/. Build a map from a list of key\/value pairs where
1851 -- the keys are in ascending order.
1852 --
1853 -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1854 -- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
1855
1856 fromAscList :: [(Key,a)] -> IntMap a
1857 fromAscList xs
1858 = fromAscListWithKey (\_ x _ -> x) xs
1859
1860 -- | /O(n)/. Build a map from a list of key\/value pairs where
1861 -- the keys are in ascending order, with a combining function on equal keys.
1862 -- /The precondition (input list is ascending) is not checked./
1863 --
1864 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
1865
1866 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1867 fromAscListWith f xs
1868 = fromAscListWithKey (\_ x y -> f x y) xs
1869
1870 -- | /O(n)/. Build a map from a list of key\/value pairs where
1871 -- the keys are in ascending order, with a combining function on equal keys.
1872 -- /The precondition (input list is ascending) is not checked./
1873 --
1874 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
1875 -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "5:b|a")]
1876
1877 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1878 fromAscListWithKey _ [] = Nil
1879 fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
1880 where
1881 -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
1882 combineEq z [] = [z]
1883 combineEq z@(kz,zz) (x@(kx,xx):xs)
1884 | kx==kz = let yy = f kx xx zz in combineEq (kx,yy) xs
1885 | otherwise = z:combineEq x xs
1886
1887 -- | /O(n)/. Build a map from a list of key\/value pairs where
1888 -- the keys are in ascending order and all distinct.
1889 -- /The precondition (input list is strictly ascending) is not checked./
1890 --
1891 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1892
1893 fromDistinctAscList :: [(Key,a)] -> IntMap a
1894 fromDistinctAscList [] = Nil
1895 fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
1896 where
1897 work (kx,vx) [] stk = finish kx (Tip kx vx) stk
1898 work (kx,vx) (z@(kz,_):zs) stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
1899
1900 reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
1901 reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
1902 reduce z zs m px tx stk@(Push py ty stk') =
1903 let mxy = branchMask px py
1904 pxy = mask px mxy
1905 in if shorter m mxy
1906 then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
1907 else work z zs (Push px tx stk)
1908
1909 finish _ t Nada = t
1910 finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
1911 where m = branchMask px py
1912 p = mask px m
1913
1914 data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
1915
1916
1917 {--------------------------------------------------------------------
1918 Eq
1919 --------------------------------------------------------------------}
1920 instance Eq a => Eq (IntMap a) where
1921 t1 == t2 = equal t1 t2
1922 t1 /= t2 = nequal t1 t2
1923
1924 equal :: Eq a => IntMap a -> IntMap a -> Bool
1925 equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1926 = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
1927 equal (Tip kx x) (Tip ky y)
1928 = (kx == ky) && (x==y)
1929 equal Nil Nil = True
1930 equal _ _ = False
1931
1932 nequal :: Eq a => IntMap a -> IntMap a -> Bool
1933 nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1934 = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
1935 nequal (Tip kx x) (Tip ky y)
1936 = (kx /= ky) || (x/=y)
1937 nequal Nil Nil = False
1938 nequal _ _ = True
1939
1940 {--------------------------------------------------------------------
1941 Ord
1942 --------------------------------------------------------------------}
1943
1944 instance Ord a => Ord (IntMap a) where
1945 compare m1 m2 = compare (toList m1) (toList m2)
1946
1947 {--------------------------------------------------------------------
1948 Functor
1949 --------------------------------------------------------------------}
1950
1951 instance Functor IntMap where
1952 fmap = map
1953
1954 {--------------------------------------------------------------------
1955 Show
1956 --------------------------------------------------------------------}
1957
1958 instance Show a => Show (IntMap a) where
1959 showsPrec d m = showParen (d > 10) $
1960 showString "fromList " . shows (toList m)
1961
1962 {--------------------------------------------------------------------
1963 Read
1964 --------------------------------------------------------------------}
1965 instance (Read e) => Read (IntMap e) where
1966 #ifdef __GLASGOW_HASKELL__
1967 readPrec = parens $ prec 10 $ do
1968 Ident "fromList" <- lexP
1969 xs <- readPrec
1970 return (fromList xs)
1971
1972 readListPrec = readListPrecDefault
1973 #else
1974 readsPrec p = readParen (p > 10) $ \ r -> do
1975 ("fromList",s) <- lex r
1976 (xs,t) <- reads s
1977 return (fromList xs,t)
1978 #endif
1979
1980 {--------------------------------------------------------------------
1981 Typeable
1982 --------------------------------------------------------------------}
1983
1984 #include "Typeable.h"
1985 INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
1986
1987 {--------------------------------------------------------------------
1988 Helpers
1989 --------------------------------------------------------------------}
1990 {--------------------------------------------------------------------
1991 Join
1992 --------------------------------------------------------------------}
1993 join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
1994 join p1 t1 p2 t2
1995 | zero p1 m = Bin p m t1 t2
1996 | otherwise = Bin p m t2 t1
1997 where
1998 m = branchMask p1 p2
1999 p = mask p1 m
2000 {-# INLINE join #-}
2001
2002 {--------------------------------------------------------------------
2003 @bin@ assures that we never have empty trees within a tree.
2004 --------------------------------------------------------------------}
2005 bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
2006 bin _ _ l Nil = l
2007 bin _ _ Nil r = r
2008 bin p m l r = Bin p m l r
2009 {-# INLINE bin #-}
2010
2011
2012 {--------------------------------------------------------------------
2013 Endian independent bit twiddling
2014 --------------------------------------------------------------------}
2015 zero :: Key -> Mask -> Bool
2016 zero i m
2017 = (natFromInt i) .&. (natFromInt m) == 0
2018 {-# INLINE zero #-}
2019
2020 nomatch,match :: Key -> Prefix -> Mask -> Bool
2021 nomatch i p m
2022 = (mask i m) /= p
2023 {-# INLINE nomatch #-}
2024
2025 match i p m
2026 = (mask i m) == p
2027 {-# INLINE match #-}
2028
2029 mask :: Key -> Mask -> Prefix
2030 mask i m
2031 = maskW (natFromInt i) (natFromInt m)
2032 {-# INLINE mask #-}
2033
2034
2035 {--------------------------------------------------------------------
2036 Big endian operations
2037 --------------------------------------------------------------------}
2038 maskW :: Nat -> Nat -> Prefix
2039 maskW i m
2040 = intFromNat (i .&. (complement (m-1) `xor` m))
2041 {-# INLINE maskW #-}
2042
2043 shorter :: Mask -> Mask -> Bool
2044 shorter m1 m2
2045 = (natFromInt m1) > (natFromInt m2)
2046 {-# INLINE shorter #-}
2047
2048 branchMask :: Prefix -> Prefix -> Mask
2049 branchMask p1 p2
2050 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
2051 {-# INLINE branchMask #-}
2052
2053 {--------------------------------------------------------------------
2054 Utilities
2055 --------------------------------------------------------------------}
2056
2057 foldlStrict :: (a -> b -> a) -> a -> [b] -> a
2058 foldlStrict f = go
2059 where
2060 go z [] = z
2061 go z (x:xs) = let z' = f z x in z' `seq` go z' xs
2062 {-# INLINE foldlStrict #-}
2063
2064 {--------------------------------------------------------------------
2065 Debugging
2066 --------------------------------------------------------------------}
2067 -- | /O(n)/. Show the tree that implements the map. The tree is shown
2068 -- in a compressed, hanging format.
2069 showTree :: Show a => IntMap a -> String
2070 showTree s
2071 = showTreeWith True False s
2072
2073
2074 {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
2075 the tree that implements the map. If @hang@ is
2076 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
2077 @wide@ is 'True', an extra wide version is shown.
2078 -}
2079 showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
2080 showTreeWith hang wide t
2081 | hang = (showsTreeHang wide [] t) ""
2082 | otherwise = (showsTree wide [] [] t) ""
2083
2084 showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
2085 showsTree wide lbars rbars t
2086 = case t of
2087 Bin p m l r
2088 -> showsTree wide (withBar rbars) (withEmpty rbars) r .
2089 showWide wide rbars .
2090 showsBars lbars . showString (showBin p m) . showString "\n" .
2091 showWide wide lbars .
2092 showsTree wide (withEmpty lbars) (withBar lbars) l
2093 Tip k x
2094 -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
2095 Nil -> showsBars lbars . showString "|\n"
2096
2097 showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
2098 showsTreeHang wide bars t
2099 = case t of
2100 Bin p m l r
2101 -> showsBars bars . showString (showBin p m) . showString "\n" .
2102 showWide wide bars .
2103 showsTreeHang wide (withBar bars) l .
2104 showWide wide bars .
2105 showsTreeHang wide (withEmpty bars) r
2106 Tip k x
2107 -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
2108 Nil -> showsBars bars . showString "|\n"
2109
2110 showBin :: Prefix -> Mask -> String
2111 showBin _ _
2112 = "*" -- ++ show (p,m)
2113
2114 showWide :: Bool -> [String] -> String -> String
2115 showWide wide bars
2116 | wide = showString (concat (reverse bars)) . showString "|\n"
2117 | otherwise = id
2118
2119 showsBars :: [String] -> ShowS
2120 showsBars bars
2121 = case bars of
2122 [] -> id
2123 _ -> showString (concat (reverse (tail bars))) . showString node
2124
2125 node :: String
2126 node = "+--"
2127
2128 withBar, withEmpty :: [String] -> [String]
2129 withBar bars = "| ":bars
2130 withEmpty bars = " ":bars