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