Manually inline {Map,IntMap}.map.
[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 combine (Tip k1 x1) (Tip _k2 x2) = case f k1 x1 x2 of Nothing -> Nil
833 Just x -> Tip k1 x
834 {-# INLINE combine #-}
835 {-# INLINE mergeWithKey #-}
836
837 -- Slightly more general version of mergeWithKey. It differs in the following:
838 --
839 -- * the combining function operates on maps instead of keys and values. The
840 -- reason is to enable sharing in union, difference and intersection.
841 --
842 -- * mergeWithKey' is given an equivalent of bin. The reason is that in union*,
843 -- Bin constructor can be used, because we know both subtrees are nonempty.
844
845 mergeWithKey' :: (Prefix -> Mask -> IntMap c -> IntMap c -> IntMap c)
846 -> (IntMap a -> IntMap b -> IntMap c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
847 -> IntMap a -> IntMap b -> IntMap c
848 mergeWithKey' bin' f g1 g2 = go
849 where
850 go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
851 | shorter m1 m2 = merge1
852 | shorter m2 m1 = merge2
853 | p1 == p2 = bin' p1 m1 (go l1 l2) (go r1 r2)
854 | otherwise = maybe_join p1 (g1 t1) p2 (g2 t2)
855 where
856 merge1 | nomatch p2 p1 m1 = maybe_join p1 (g1 t1) p2 (g2 t2)
857 | zero p2 m1 = bin' p1 m1 (go l1 t2) (g1 r1)
858 | otherwise = bin' p1 m1 (g1 l1) (go r1 t2)
859 merge2 | nomatch p1 p2 m2 = maybe_join p1 (g1 t1) p2 (g2 t2)
860 | zero p1 m2 = bin' p2 m2 (go t1 l2) (g2 r2)
861 | otherwise = bin' p2 m2 (g2 l2) (go t1 r2)
862
863 go t1'@(Bin _ _ _ _) t2@(Tip k2 x2) = merge t1'
864 where merge t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = maybe_join p1 (g1 t1) k2 (g2 t2)
865 | zero k2 m1 = bin' p1 m1 (merge l1) (g1 r1)
866 | otherwise = bin' p1 m1 (g1 l1) (merge r1)
867 merge t1@(Tip k1 x1) | k1 == k2 = f t1 t2
868 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
869 merge Nil = g2 t2
870
871 go t1@(Bin _ _ _ _) Nil = g1 t1
872
873 go t1@(Tip k1 x1) t2' = merge t2'
874 where merge t2@(Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = maybe_join k1 (g1 t1) p2 (g2 t2)
875 | zero k1 m2 = bin' p2 m2 (merge l2) (g2 r2)
876 | otherwise = bin' p2 m2 (g2 l2) (merge r2)
877 merge t2@(Tip k2 x2) | k1 == k2 = f t1 t2
878 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
879 merge Nil = g1 t1
880
881 go Nil t2 = g2 t2
882
883 maybe_join _ Nil _ t2 = t2
884 maybe_join _ t1 _ Nil = t1
885 maybe_join p1 t1 p2 t2 = join p1 t1 p2 t2
886 {-# INLINE maybe_join #-}
887 {-# INLINE mergeWithKey' #-}
888
889 {--------------------------------------------------------------------
890 Min\/Max
891 --------------------------------------------------------------------}
892
893 -- | /O(min(n,W))/. Update the value at the minimal key.
894 --
895 -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
896 -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
897
898 updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
899 updateMinWithKey f t =
900 case t of Bin p m l r | m < 0 -> bin p m l (go f r)
901 _ -> go f t
902 where
903 go f' (Bin p m l r) = bin p m (go f' l) r
904 go f' (Tip k y) = case f' k y of
905 Just y' -> Tip k y'
906 Nothing -> Nil
907 go _ Nil = error "updateMinWithKey Nil"
908
909 -- | /O(min(n,W))/. Update the value at the maximal key.
910 --
911 -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
912 -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
913
914 updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
915 updateMaxWithKey f t =
916 case t of Bin p m l r | m < 0 -> bin p m (go f l) r
917 _ -> go f t
918 where
919 go f' (Bin p m l r) = bin p m l (go f' r)
920 go f' (Tip k y) = case f' k y of
921 Just y' -> Tip k y'
922 Nothing -> Nil
923 go _ Nil = error "updateMaxWithKey Nil"
924
925 -- | /O(min(n,W))/. Retrieves the maximal (key,value) pair of the map, and
926 -- the map stripped of that element, or 'Nothing' if passed an empty map.
927 --
928 -- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
929 -- > maxViewWithKey empty == Nothing
930
931 maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
932 maxViewWithKey t =
933 case t of Nil -> Nothing
934 Bin p m l r | m < 0 -> case go l of (result, l') -> Just (result, bin p m l' r)
935 _ -> Just (go t)
936 where
937 go (Bin p m l r) = case go r of (result, r') -> (result, bin p m l r')
938 go (Tip k y) = ((k, y), Nil)
939 go Nil = error "maxViewWithKey Nil"
940
941 -- | /O(min(n,W))/. Retrieves the minimal (key,value) pair of the map, and
942 -- the map stripped of that element, or 'Nothing' if passed an empty map.
943 --
944 -- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
945 -- > minViewWithKey empty == Nothing
946
947 minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
948 minViewWithKey t =
949 case t of Nil -> Nothing
950 Bin p m l r | m < 0 -> case go r of (result, r') -> Just (result, bin p m l r')
951 _ -> Just (go t)
952 where
953 go (Bin p m l r) = case go l of (result, l') -> (result, bin p m l' r)
954 go (Tip k y) = ((k, y), Nil)
955 go Nil = error "minViewWithKey Nil"
956
957 -- | /O(min(n,W))/. Update the value at the maximal key.
958 --
959 -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
960 -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
961
962 updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a
963 updateMax f = updateMaxWithKey (const f)
964
965 -- | /O(min(n,W))/. Update the value at the minimal key.
966 --
967 -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
968 -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
969
970 updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a
971 updateMin f = updateMinWithKey (const f)
972
973 -- Similar to the Arrow instance.
974 first :: (a -> c) -> (a, b) -> (c, b)
975 first f (x,y) = (f x,y)
976
977 -- | /O(min(n,W))/. Retrieves the maximal key of the map, and the map
978 -- stripped of that element, or 'Nothing' if passed an empty map.
979 maxView :: IntMap a -> Maybe (a, IntMap a)
980 maxView t = liftM (first snd) (maxViewWithKey t)
981
982 -- | /O(min(n,W))/. Retrieves the minimal key of the map, and the map
983 -- stripped of that element, or 'Nothing' if passed an empty map.
984 minView :: IntMap a -> Maybe (a, IntMap a)
985 minView t = liftM (first snd) (minViewWithKey t)
986
987 -- | /O(min(n,W))/. Delete and find the maximal element.
988 deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
989 deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey
990
991 -- | /O(min(n,W))/. Delete and find the minimal element.
992 deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
993 deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey
994
995 -- | /O(min(n,W))/. The minimal key of the map.
996 findMin :: IntMap a -> (Key, a)
997 findMin Nil = error $ "findMin: empty map has no minimal element"
998 findMin (Tip k v) = (k,v)
999 findMin (Bin _ m l r)
1000 | m < 0 = go r
1001 | otherwise = go l
1002 where go (Tip k v) = (k,v)
1003 go (Bin _ _ l' _) = go l'
1004 go Nil = error "findMax Nil"
1005
1006 -- | /O(min(n,W))/. The maximal key of the map.
1007 findMax :: IntMap a -> (Key, a)
1008 findMax Nil = error $ "findMax: empty map has no maximal element"
1009 findMax (Tip k v) = (k,v)
1010 findMax (Bin _ m l r)
1011 | m < 0 = go l
1012 | otherwise = go r
1013 where go (Tip k v) = (k,v)
1014 go (Bin _ _ _ r') = go r'
1015 go Nil = error "findMax Nil"
1016
1017 -- | /O(min(n,W))/. Delete the minimal key. An error is thrown if the IntMap is already empty.
1018 -- Note, this is not the same behavior Map.
1019 deleteMin :: IntMap a -> IntMap a
1020 deleteMin = maybe Nil snd . minView
1021
1022 -- | /O(min(n,W))/. Delete the maximal key. An error is thrown if the IntMap is already empty.
1023 -- Note, this is not the same behavior Map.
1024 deleteMax :: IntMap a -> IntMap a
1025 deleteMax = maybe Nil snd . maxView
1026
1027
1028 {--------------------------------------------------------------------
1029 Submap
1030 --------------------------------------------------------------------}
1031 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
1032 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
1033 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1034 isProperSubmapOf m1 m2
1035 = isProperSubmapOfBy (==) m1 m2
1036
1037 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
1038 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
1039 @m1@ and @m2@ are not equal,
1040 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
1041 applied to their respective values. For example, the following
1042 expressions are all 'True':
1043
1044 > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1045 > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1046
1047 But the following are all 'False':
1048
1049 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
1050 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
1051 > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1052 -}
1053 isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
1054 isProperSubmapOfBy predicate t1 t2
1055 = case submapCmp predicate t1 t2 of
1056 LT -> True
1057 _ -> False
1058
1059 submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
1060 submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1061 | shorter m1 m2 = GT
1062 | shorter m2 m1 = submapCmpLt
1063 | p1 == p2 = submapCmpEq
1064 | otherwise = GT -- disjoint
1065 where
1066 submapCmpLt | nomatch p1 p2 m2 = GT
1067 | zero p1 m2 = submapCmp predicate t1 l2
1068 | otherwise = submapCmp predicate t1 r2
1069 submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of
1070 (GT,_ ) -> GT
1071 (_ ,GT) -> GT
1072 (EQ,EQ) -> EQ
1073 _ -> LT
1074
1075 submapCmp _ (Bin _ _ _ _) _ = GT
1076 submapCmp predicate (Tip kx x) (Tip ky y)
1077 | (kx == ky) && predicate x y = EQ
1078 | otherwise = GT -- disjoint
1079 submapCmp predicate (Tip k x) t
1080 = case lookup k t of
1081 Just y | predicate x y -> LT
1082 _ -> GT -- disjoint
1083 submapCmp _ Nil Nil = EQ
1084 submapCmp _ Nil _ = LT
1085
1086 -- | /O(n+m)/. Is this a submap?
1087 -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
1088 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1089 isSubmapOf m1 m2
1090 = isSubmapOfBy (==) m1 m2
1091
1092 {- | /O(n+m)/.
1093 The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
1094 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
1095 applied to their respective values. For example, the following
1096 expressions are all 'True':
1097
1098 > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1099 > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1100 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
1101
1102 But the following are all 'False':
1103
1104 > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
1105 > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1106 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
1107 -}
1108 isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
1109 isSubmapOfBy predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1110 | shorter m1 m2 = False
1111 | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy predicate t1 l2
1112 else isSubmapOfBy predicate t1 r2)
1113 | otherwise = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2
1114 isSubmapOfBy _ (Bin _ _ _ _) _ = False
1115 isSubmapOfBy predicate (Tip k x) t = case lookup k t of
1116 Just y -> predicate x y
1117 Nothing -> False
1118 isSubmapOfBy _ Nil _ = True
1119
1120 {--------------------------------------------------------------------
1121 Mapping
1122 --------------------------------------------------------------------}
1123 -- | /O(n)/. Map a function over all values in the map.
1124 --
1125 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
1126
1127 map :: (a -> b) -> IntMap a -> IntMap b
1128 map f t
1129 = case t of
1130 Bin p m l r -> Bin p m (map f l) (map f r)
1131 Tip k x -> Tip k (f x)
1132 Nil -> Nil
1133
1134 -- | /O(n)/. Map a function over all values in the map.
1135 --
1136 -- > let f key x = (show key) ++ ":" ++ x
1137 -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
1138
1139 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
1140 mapWithKey f t
1141 = case t of
1142 Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
1143 Tip k x -> Tip k (f k x)
1144 Nil -> Nil
1145
1146 -- | /O(n)/.
1147 -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
1148 -- That is, behaves exactly like a regular 'traverse' except that the traversing
1149 -- function also has access to the key associated with a value.
1150 --
1151 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])
1152 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')]) == Nothing
1153 {-# INLINE traverseWithKey #-}
1154 traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
1155 traverseWithKey f = go
1156 where
1157 go Nil = pure Nil
1158 go (Tip k v) = Tip k <$> f k v
1159 go (Bin p m l r) = Bin p m <$> go l <*> go r
1160
1161 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
1162 -- argument through the map in ascending order of keys.
1163 --
1164 -- > let f a b = (a ++ b, b ++ "X")
1165 -- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
1166
1167 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1168 mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
1169
1170 -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
1171 -- argument through the map in ascending order of keys.
1172 --
1173 -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
1174 -- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
1175
1176 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1177 mapAccumWithKey f a t
1178 = mapAccumL f a t
1179
1180 -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
1181 -- argument through the map in ascending order of keys.
1182 mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1183 mapAccumL f a t
1184 = case t of
1185 Bin p m l r -> let (a1,l') = mapAccumL f a l
1186 (a2,r') = mapAccumL f a1 r
1187 in (a2,Bin p m l' r')
1188 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1189 Nil -> (a,Nil)
1190
1191 -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
1192 -- argument through the map in descending order of keys.
1193 mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1194 mapAccumRWithKey f a t
1195 = case t of
1196 Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
1197 (a2,l') = mapAccumRWithKey f a1 l
1198 in (a2,Bin p m l' r')
1199 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1200 Nil -> (a,Nil)
1201
1202 -- | /O(n*min(n,W))/.
1203 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
1204 --
1205 -- The size of the result may be smaller if @f@ maps two or more distinct
1206 -- keys to the same new key. In this case the value at the greatest of the
1207 -- original keys is retained.
1208 --
1209 -- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) == fromList [(4, "b"), (6, "a")]
1210 -- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
1211 -- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
1212
1213 mapKeys :: (Key->Key) -> IntMap a -> IntMap a
1214 mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
1215
1216 -- | /O(n*min(n,W))/.
1217 -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
1218 --
1219 -- The size of the result may be smaller if @f@ maps two or more distinct
1220 -- keys to the same new key. In this case the associated values will be
1221 -- combined using @c@.
1222 --
1223 -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
1224 -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
1225
1226 mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a
1227 mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
1228
1229 -- | /O(n*min(n,W))/.
1230 -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
1231 -- is strictly monotonic.
1232 -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
1233 -- /The precondition is not checked./
1234 -- Semi-formally, we have:
1235 --
1236 -- > and [x < y ==> f x < f y | x <- ls, y <- ls]
1237 -- > ==> mapKeysMonotonic f s == mapKeys f s
1238 -- > where ls = keys s
1239 --
1240 -- This means that @f@ maps distinct original keys to distinct resulting keys.
1241 -- This function has slightly better performance than 'mapKeys'.
1242 --
1243 -- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
1244
1245 mapKeysMonotonic :: (Key->Key) -> IntMap a -> IntMap a
1246 mapKeysMonotonic f = fromDistinctAscList . foldrWithKey (\k x xs -> (f k, x) : xs) []
1247
1248 {--------------------------------------------------------------------
1249 Filter
1250 --------------------------------------------------------------------}
1251 -- | /O(n)/. Filter all values that satisfy some predicate.
1252 --
1253 -- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1254 -- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
1255 -- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
1256
1257 filter :: (a -> Bool) -> IntMap a -> IntMap a
1258 filter p m
1259 = filterWithKey (\_ x -> p x) m
1260
1261 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
1262 --
1263 -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1264
1265 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
1266 filterWithKey predicate t
1267 = case t of
1268 Bin p m l r
1269 -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
1270 Tip k x
1271 | predicate k x -> t
1272 | otherwise -> Nil
1273 Nil -> Nil
1274
1275 -- | /O(n)/. Partition the map according to some predicate. The first
1276 -- map contains all elements that satisfy the predicate, the second all
1277 -- elements that fail the predicate. See also 'split'.
1278 --
1279 -- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1280 -- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1281 -- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1282
1283 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1284 partition p m
1285 = partitionWithKey (\_ x -> p x) m
1286
1287 -- | /O(n)/. Partition the map according to some predicate. The first
1288 -- map contains all elements that satisfy the predicate, the second all
1289 -- elements that fail the predicate. See also 'split'.
1290 --
1291 -- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
1292 -- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1293 -- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1294
1295 partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1296 partitionWithKey predicate t
1297 = case t of
1298 Bin p m l r
1299 -> let (l1,l2) = partitionWithKey predicate l
1300 (r1,r2) = partitionWithKey predicate r
1301 in (bin p m l1 r1, bin p m l2 r2)
1302 Tip k x
1303 | predicate k x -> (t,Nil)
1304 | otherwise -> (Nil,t)
1305 Nil -> (Nil,Nil)
1306
1307 -- | /O(n)/. Map values and collect the 'Just' results.
1308 --
1309 -- > let f x = if x == "a" then Just "new a" else Nothing
1310 -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
1311
1312 mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
1313 mapMaybe f = mapMaybeWithKey (\_ x -> f x)
1314
1315 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
1316 --
1317 -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
1318 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
1319
1320 mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
1321 mapMaybeWithKey f (Bin p m l r)
1322 = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
1323 mapMaybeWithKey f (Tip k x) = case f k x of
1324 Just y -> Tip k y
1325 Nothing -> Nil
1326 mapMaybeWithKey _ Nil = Nil
1327
1328 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
1329 --
1330 -- > let f a = if a < "c" then Left a else Right a
1331 -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1332 -- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
1333 -- >
1334 -- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1335 -- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1336
1337 mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1338 mapEither f m
1339 = mapEitherWithKey (\_ x -> f x) m
1340
1341 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
1342 --
1343 -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
1344 -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1345 -- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
1346 -- >
1347 -- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1348 -- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
1349
1350 mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1351 mapEitherWithKey f (Bin p m l r)
1352 = (bin p m l1 r1, bin p m l2 r2)
1353 where
1354 (l1,l2) = mapEitherWithKey f l
1355 (r1,r2) = mapEitherWithKey f r
1356 mapEitherWithKey f (Tip k x) = case f k x of
1357 Left y -> (Tip k y, Nil)
1358 Right z -> (Nil, Tip k z)
1359 mapEitherWithKey _ Nil = (Nil, Nil)
1360
1361 -- | /O(min(n,W))/. The expression (@'split' k map@) is a pair @(map1,map2)@
1362 -- where all keys in @map1@ are lower than @k@ and all keys in
1363 -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
1364 --
1365 -- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
1366 -- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
1367 -- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1368 -- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
1369 -- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
1370
1371 split :: Key -> IntMap a -> (IntMap a, IntMap a)
1372 split k t =
1373 case t of Bin _ m l r | m < 0 -> if k >= 0 -- handle negative numbers.
1374 then case go k l of (lt, gt) -> (union r lt, gt)
1375 else case go k r of (lt, gt) -> (lt, union gt l)
1376 _ -> go k t
1377 where
1378 go k' t'@(Bin p m l r) | nomatch k' p m = if k' > p then (t', Nil) else (Nil, t')
1379 | zero k' m = case go k' l of (lt, gt) -> (lt, union gt r)
1380 | otherwise = case go k' r of (lt, gt) -> (union l lt, gt)
1381 go k' t'@(Tip ky _) | k' > ky = (t', Nil)
1382 | k' < ky = (Nil, t')
1383 | otherwise = (Nil, Nil)
1384 go _ Nil = (Nil, Nil)
1385
1386 -- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
1387 -- key was found in the original map.
1388 --
1389 -- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
1390 -- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
1391 -- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
1392 -- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
1393 -- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
1394
1395 splitLookup :: Key -> IntMap a -> (IntMap a, Maybe a, IntMap a)
1396 splitLookup k t =
1397 case t of Bin _ m l r | m < 0 -> if k >= 0 -- handle negative numbers.
1398 then case go k l of (lt, fnd, gt) -> (union r lt, fnd, gt)
1399 else case go k r of (lt, fnd, gt) -> (lt, fnd, union gt l)
1400 _ -> go k t
1401 where
1402 go k' t'@(Bin p m l r) | nomatch k' p m = if k' > p then (t', Nothing, Nil) else (Nil, Nothing, t')
1403 | zero k' m = case go k' l of (lt, fnd, gt) -> (lt, fnd, union gt r)
1404 | otherwise = case go k' r of (lt, fnd, gt) -> (union l lt, fnd, gt)
1405 go k' t'@(Tip ky y) | k' > ky = (t', Nothing, Nil)
1406 | k' < ky = (Nil, Nothing, t')
1407 | otherwise = (Nil, Just y, Nil)
1408 go _ Nil = (Nil, Nothing, Nil)
1409
1410 {--------------------------------------------------------------------
1411 Fold
1412 --------------------------------------------------------------------}
1413 -- | /O(n)/. Fold the values in the map using the given right-associative
1414 -- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
1415 --
1416 -- For example,
1417 --
1418 -- > elems map = foldr (:) [] map
1419 --
1420 -- > let f a len = len + (length a)
1421 -- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
1422 foldr :: (a -> b -> b) -> b -> IntMap a -> b
1423 foldr f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1424 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1425 | otherwise -> go (go z r) l
1426 _ -> go z t
1427 where
1428 go z' Nil = z'
1429 go z' (Tip _ x) = f x z'
1430 go z' (Bin _ _ l r) = go (go z' r) l
1431 {-# INLINE foldr #-}
1432
1433 -- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
1434 -- evaluated before using the result in the next application. This
1435 -- function is strict in the starting value.
1436 foldr' :: (a -> b -> b) -> b -> IntMap a -> b
1437 foldr' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1438 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1439 | otherwise -> go (go z r) l
1440 _ -> go z t
1441 where
1442 STRICT_1_OF_2(go)
1443 go z' Nil = z'
1444 go z' (Tip _ x) = f x z'
1445 go z' (Bin _ _ l r) = go (go z' r) l
1446 {-# INLINE foldr' #-}
1447
1448 -- | /O(n)/. Fold the values in the map using the given left-associative
1449 -- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
1450 --
1451 -- For example,
1452 --
1453 -- > elems = reverse . foldl (flip (:)) []
1454 --
1455 -- > let f len a = len + (length a)
1456 -- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
1457 foldl :: (a -> b -> a) -> a -> IntMap b -> a
1458 foldl f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1459 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1460 | otherwise -> go (go z l) r
1461 _ -> go z t
1462 where
1463 go z' Nil = z'
1464 go z' (Tip _ x) = f z' x
1465 go z' (Bin _ _ l r) = go (go z' l) r
1466 {-# INLINE foldl #-}
1467
1468 -- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
1469 -- evaluated before using the result in the next application. This
1470 -- function is strict in the starting value.
1471 foldl' :: (a -> b -> a) -> a -> IntMap b -> a
1472 foldl' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1473 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1474 | otherwise -> go (go z l) r
1475 _ -> go z t
1476 where
1477 STRICT_1_OF_2(go)
1478 go z' Nil = z'
1479 go z' (Tip _ x) = f z' x
1480 go z' (Bin _ _ l r) = go (go z' l) r
1481 {-# INLINE foldl' #-}
1482
1483 -- | /O(n)/. Fold the keys and values in the map using the given right-associative
1484 -- binary operator, such that
1485 -- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
1486 --
1487 -- For example,
1488 --
1489 -- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
1490 --
1491 -- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
1492 -- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
1493 foldrWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
1494 foldrWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1495 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1496 | otherwise -> go (go z r) l
1497 _ -> go z t
1498 where
1499 go z' Nil = z'
1500 go z' (Tip kx x) = f kx x z'
1501 go z' (Bin _ _ l r) = go (go z' r) l
1502 {-# INLINE foldrWithKey #-}
1503
1504 -- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
1505 -- evaluated before using the result in the next application. This
1506 -- function is strict in the starting value.
1507 foldrWithKey' :: (Int -> a -> b -> b) -> b -> IntMap a -> b
1508 foldrWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1509 case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
1510 | otherwise -> go (go z r) l
1511 _ -> go z t
1512 where
1513 STRICT_1_OF_2(go)
1514 go z' Nil = z'
1515 go z' (Tip kx x) = f kx x z'
1516 go z' (Bin _ _ l r) = go (go z' r) l
1517 {-# INLINE foldrWithKey' #-}
1518
1519 -- | /O(n)/. Fold the keys and values in the map using the given left-associative
1520 -- binary operator, such that
1521 -- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
1522 --
1523 -- For example,
1524 --
1525 -- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []
1526 --
1527 -- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
1528 -- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
1529 foldlWithKey :: (a -> Int -> b -> a) -> a -> IntMap b -> a
1530 foldlWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1531 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1532 | otherwise -> go (go z l) r
1533 _ -> go z t
1534 where
1535 go z' Nil = z'
1536 go z' (Tip kx x) = f z' kx x
1537 go z' (Bin _ _ l r) = go (go z' l) r
1538 {-# INLINE foldlWithKey #-}
1539
1540 -- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
1541 -- evaluated before using the result in the next application. This
1542 -- function is strict in the starting value.
1543 foldlWithKey' :: (a -> Int -> b -> a) -> a -> IntMap b -> a
1544 foldlWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
1545 case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
1546 | otherwise -> go (go z l) r
1547 _ -> go z t
1548 where
1549 STRICT_1_OF_2(go)
1550 go z' Nil = z'
1551 go z' (Tip kx x) = f z' kx x
1552 go z' (Bin _ _ l r) = go (go z' l) r
1553 {-# INLINE foldlWithKey' #-}
1554
1555 {--------------------------------------------------------------------
1556 List variations
1557 --------------------------------------------------------------------}
1558 -- | /O(n)/.
1559 -- Return all elements of the map in the ascending order of their keys.
1560 -- Subject to list fusion.
1561 --
1562 -- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
1563 -- > elems empty == []
1564
1565 elems :: IntMap a -> [a]
1566 elems = foldr (:) []
1567
1568 -- | /O(n)/. Return all keys of the map in ascending order. Subject to list
1569 -- fusion.
1570 --
1571 -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
1572 -- > keys empty == []
1573
1574 keys :: IntMap a -> [Key]
1575 keys = foldrWithKey (\k _ ks -> k : ks) []
1576
1577 -- | /O(n*min(n,W))/. The set of all keys of the map.
1578 --
1579 -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5]
1580 -- > keysSet empty == Data.IntSet.empty
1581
1582 keysSet :: IntMap a -> IntSet.IntSet
1583 keysSet m = IntSet.fromDistinctAscList (keys m)
1584
1585
1586 -- | /O(n)/. An alias for 'toAscList'. Returns all key\/value pairs in the
1587 -- map in ascending key order. Subject to list fusion.
1588 --
1589 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1590 -- > assocs empty == []
1591
1592 assocs :: IntMap a -> [(Key,a)]
1593 assocs = toAscList
1594
1595
1596 {--------------------------------------------------------------------
1597 Lists
1598 --------------------------------------------------------------------}
1599 -- | /O(n)/. Convert the map to a list of key\/value pairs. Subject to list
1600 -- fusion.
1601 --
1602 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1603 -- > toList empty == []
1604
1605 toList :: IntMap a -> [(Key,a)]
1606 toList = toAscList
1607
1608 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
1609 -- keys are in ascending order. Subject to list fusion.
1610 --
1611 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1612
1613 toAscList :: IntMap a -> [(Key,a)]
1614 toAscList = foldrWithKey (\k x xs -> (k,x):xs) []
1615
1616 -- | /O(n)/. Convert the map to a list of key\/value pairs where the keys
1617 -- are in descending order. Subject to list fusion.
1618 --
1619 -- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]
1620
1621 toDescList :: IntMap a -> [(Key,a)]
1622 toDescList = foldlWithKey (\xs k x -> (k,x):xs) []
1623
1624 -- List fusion for the list generating functions.
1625 #if __GLASGOW_HASKELL__
1626 -- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.
1627 -- They are important to convert unfused methods back, see mapFB in prelude.
1628 foldrFB :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1629 foldrFB = foldrWithKey
1630 {-# INLINE[0] foldrFB #-}
1631 foldlFB :: (a -> Key -> b -> a) -> a -> IntMap b -> a
1632 foldlFB = foldlWithKey
1633 {-# INLINE[0] foldlFB #-}
1634
1635 -- Inline assocs and toList, so that we need to fuse only toAscList.
1636 {-# INLINE assocs #-}
1637 {-# INLINE toList #-}
1638
1639 -- The fusion is enabled up to phase 2 included. If it does not succeed,
1640 -- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to
1641 -- elems,keys,to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were
1642 -- used in a list fusion, otherwise it would go away in phase 1), and let compiler
1643 -- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to
1644 -- inline it before phase 0, otherwise the fusion rules would not fire at all.
1645 {-# NOINLINE[0] elems #-}
1646 {-# NOINLINE[0] keys #-}
1647 {-# NOINLINE[0] toAscList #-}
1648 {-# NOINLINE[0] toDescList #-}
1649 {-# RULES "IntMap.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
1650 {-# RULES "IntMap.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
1651 {-# RULES "IntMap.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
1652 {-# RULES "IntMap.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
1653 {-# RULES "IntMap.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
1654 {-# RULES "IntMap.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
1655 {-# RULES "IntMap.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
1656 {-# RULES "IntMap.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
1657 #endif
1658
1659
1660 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
1661 --
1662 -- > fromList [] == empty
1663 -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
1664 -- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
1665
1666 fromList :: [(Key,a)] -> IntMap a
1667 fromList xs
1668 = foldlStrict ins empty xs
1669 where
1670 ins t (k,x) = insert k x t
1671
1672 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
1673 --
1674 -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")]
1675 -- > fromListWith (++) [] == empty
1676
1677 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1678 fromListWith f xs
1679 = fromListWithKey (\_ x y -> f x y) xs
1680
1681 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
1682 --
1683 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
1684 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]
1685 -- > fromListWithKey f [] == empty
1686
1687 fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1688 fromListWithKey f xs
1689 = foldlStrict ins empty xs
1690 where
1691 ins t (k,x) = insertWithKey f k x t
1692
1693 -- | /O(n)/. Build a map from a list of key\/value pairs where
1694 -- the keys are in ascending order.
1695 --
1696 -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1697 -- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
1698
1699 fromAscList :: [(Key,a)] -> IntMap a
1700 fromAscList xs
1701 = fromAscListWithKey (\_ x _ -> x) xs
1702
1703 -- | /O(n)/. Build a map from a list of key\/value pairs where
1704 -- the keys are in ascending order, with a combining function on equal keys.
1705 -- /The precondition (input list is ascending) is not checked./
1706 --
1707 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
1708
1709 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1710 fromAscListWith f xs
1711 = fromAscListWithKey (\_ x y -> f x y) xs
1712
1713 -- | /O(n)/. Build a map from a list of key\/value pairs where
1714 -- the keys are in ascending order, with a combining function on equal keys.
1715 -- /The precondition (input list is ascending) is not checked./
1716 --
1717 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
1718 -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "5:b|a")]
1719
1720 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1721 fromAscListWithKey _ [] = Nil
1722 fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
1723 where
1724 -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
1725 combineEq z [] = [z]
1726 combineEq z@(kz,zz) (x@(kx,xx):xs)
1727 | kx==kz = let yy = f kx xx zz in combineEq (kx,yy) xs
1728 | otherwise = z:combineEq x xs
1729
1730 -- | /O(n)/. Build a map from a list of key\/value pairs where
1731 -- the keys are in ascending order and all distinct.
1732 -- /The precondition (input list is strictly ascending) is not checked./
1733 --
1734 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1735
1736 fromDistinctAscList :: [(Key,a)] -> IntMap a
1737 fromDistinctAscList [] = Nil
1738 fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
1739 where
1740 work (kx,vx) [] stk = finish kx (Tip kx vx) stk
1741 work (kx,vx) (z@(kz,_):zs) stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
1742
1743 reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
1744 reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
1745 reduce z zs m px tx stk@(Push py ty stk') =
1746 let mxy = branchMask px py
1747 pxy = mask px mxy
1748 in if shorter m mxy
1749 then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
1750 else work z zs (Push px tx stk)
1751
1752 finish _ t Nada = t
1753 finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
1754 where m = branchMask px py
1755 p = mask px m
1756
1757 data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
1758
1759
1760 {--------------------------------------------------------------------
1761 Eq
1762 --------------------------------------------------------------------}
1763 instance Eq a => Eq (IntMap a) where
1764 t1 == t2 = equal t1 t2
1765 t1 /= t2 = nequal t1 t2
1766
1767 equal :: Eq a => IntMap a -> IntMap a -> Bool
1768 equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1769 = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
1770 equal (Tip kx x) (Tip ky y)
1771 = (kx == ky) && (x==y)
1772 equal Nil Nil = True
1773 equal _ _ = False
1774
1775 nequal :: Eq a => IntMap a -> IntMap a -> Bool
1776 nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1777 = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
1778 nequal (Tip kx x) (Tip ky y)
1779 = (kx /= ky) || (x/=y)
1780 nequal Nil Nil = False
1781 nequal _ _ = True
1782
1783 {--------------------------------------------------------------------
1784 Ord
1785 --------------------------------------------------------------------}
1786
1787 instance Ord a => Ord (IntMap a) where
1788 compare m1 m2 = compare (toList m1) (toList m2)
1789
1790 {--------------------------------------------------------------------
1791 Functor
1792 --------------------------------------------------------------------}
1793
1794 instance Functor IntMap where
1795 fmap = map
1796
1797 {--------------------------------------------------------------------
1798 Show
1799 --------------------------------------------------------------------}
1800
1801 instance Show a => Show (IntMap a) where
1802 showsPrec d m = showParen (d > 10) $
1803 showString "fromList " . shows (toList m)
1804
1805 {--------------------------------------------------------------------
1806 Read
1807 --------------------------------------------------------------------}
1808 instance (Read e) => Read (IntMap e) where
1809 #ifdef __GLASGOW_HASKELL__
1810 readPrec = parens $ prec 10 $ do
1811 Ident "fromList" <- lexP
1812 xs <- readPrec
1813 return (fromList xs)
1814
1815 readListPrec = readListPrecDefault
1816 #else
1817 readsPrec p = readParen (p > 10) $ \ r -> do
1818 ("fromList",s) <- lex r
1819 (xs,t) <- reads s
1820 return (fromList xs,t)
1821 #endif
1822
1823 {--------------------------------------------------------------------
1824 Typeable
1825 --------------------------------------------------------------------}
1826
1827 #include "Typeable.h"
1828 INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
1829
1830 {--------------------------------------------------------------------
1831 Helpers
1832 --------------------------------------------------------------------}
1833 {--------------------------------------------------------------------
1834 Join
1835 --------------------------------------------------------------------}
1836 join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
1837 join p1 t1 p2 t2
1838 | zero p1 m = Bin p m t1 t2
1839 | otherwise = Bin p m t2 t1
1840 where
1841 m = branchMask p1 p2
1842 p = mask p1 m
1843 {-# INLINE join #-}
1844
1845 {--------------------------------------------------------------------
1846 @bin@ assures that we never have empty trees within a tree.
1847 --------------------------------------------------------------------}
1848 bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
1849 bin _ _ l Nil = l
1850 bin _ _ Nil r = r
1851 bin p m l r = Bin p m l r
1852 {-# INLINE bin #-}
1853
1854
1855 {--------------------------------------------------------------------
1856 Endian independent bit twiddling
1857 --------------------------------------------------------------------}
1858 zero :: Key -> Mask -> Bool
1859 zero i m
1860 = (natFromInt i) .&. (natFromInt m) == 0
1861 {-# INLINE zero #-}
1862
1863 nomatch,match :: Key -> Prefix -> Mask -> Bool
1864 nomatch i p m
1865 = (mask i m) /= p
1866 {-# INLINE nomatch #-}
1867
1868 match i p m
1869 = (mask i m) == p
1870 {-# INLINE match #-}
1871
1872 mask :: Key -> Mask -> Prefix
1873 mask i m
1874 = maskW (natFromInt i) (natFromInt m)
1875 {-# INLINE mask #-}
1876
1877
1878 {--------------------------------------------------------------------
1879 Big endian operations
1880 --------------------------------------------------------------------}
1881 maskW :: Nat -> Nat -> Prefix
1882 maskW i m
1883 = intFromNat (i .&. (complement (m-1) `xor` m))
1884 {-# INLINE maskW #-}
1885
1886 shorter :: Mask -> Mask -> Bool
1887 shorter m1 m2
1888 = (natFromInt m1) > (natFromInt m2)
1889 {-# INLINE shorter #-}
1890
1891 branchMask :: Prefix -> Prefix -> Mask
1892 branchMask p1 p2
1893 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
1894 {-# INLINE branchMask #-}
1895
1896 {----------------------------------------------------------------------
1897 Finding the highest bit (mask) in a word [x] can be done efficiently in
1898 three ways:
1899 * convert to a floating point value and the mantissa tells us the
1900 [log2(x)] that corresponds with the highest bit position. The mantissa
1901 is retrieved either via the standard C function [frexp] or by some bit
1902 twiddling on IEEE compatible numbers (float). Note that one needs to
1903 use at least [double] precision for an accurate mantissa of 32 bit
1904 numbers.
1905 * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
1906 * use processor specific assembler instruction (asm).
1907
1908 The most portable way would be [bit], but is it efficient enough?
1909 I have measured the cycle counts of the different methods on an AMD
1910 Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
1911
1912 highestBitMask: method cycles
1913 --------------
1914 frexp 200
1915 float 33
1916 bit 11
1917 asm 12
1918
1919 highestBit: method cycles
1920 --------------
1921 frexp 195
1922 float 33
1923 bit 11
1924 asm 11
1925
1926 Wow, the bit twiddling is on today's RISC like machines even faster
1927 than a single CISC instruction (BSR)!
1928 ----------------------------------------------------------------------}
1929
1930 {----------------------------------------------------------------------
1931 [highestBitMask] returns a word where only the highest bit is set.
1932 It is found by first setting all bits in lower positions than the
1933 highest bit and than taking an exclusive or with the original value.
1934 Allthough the function may look expensive, GHC compiles this into
1935 excellent C code that subsequently compiled into highly efficient
1936 machine code. The algorithm is derived from Jorg Arndt's FXT library.
1937 ----------------------------------------------------------------------}
1938 highestBitMask :: Nat -> Nat
1939 highestBitMask x0
1940 = case (x0 .|. shiftRL x0 1) of
1941 x1 -> case (x1 .|. shiftRL x1 2) of
1942 x2 -> case (x2 .|. shiftRL x2 4) of
1943 x3 -> case (x3 .|. shiftRL x3 8) of
1944 x4 -> case (x4 .|. shiftRL x4 16) of
1945 x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms
1946 x6 -> (x6 `xor` (shiftRL x6 1))
1947 {-# INLINE highestBitMask #-}
1948
1949
1950 {--------------------------------------------------------------------
1951 Utilities
1952 --------------------------------------------------------------------}
1953
1954 foldlStrict :: (a -> b -> a) -> a -> [b] -> a
1955 foldlStrict f = go
1956 where
1957 go z [] = z
1958 go z (x:xs) = let z' = f z x in z' `seq` go z' xs
1959 {-# INLINE foldlStrict #-}
1960
1961 {--------------------------------------------------------------------
1962 Debugging
1963 --------------------------------------------------------------------}
1964 -- | /O(n)/. Show the tree that implements the map. The tree is shown
1965 -- in a compressed, hanging format.
1966 showTree :: Show a => IntMap a -> String
1967 showTree s
1968 = showTreeWith True False s
1969
1970
1971 {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
1972 the tree that implements the map. If @hang@ is
1973 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
1974 @wide@ is 'True', an extra wide version is shown.
1975 -}
1976 showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
1977 showTreeWith hang wide t
1978 | hang = (showsTreeHang wide [] t) ""
1979 | otherwise = (showsTree wide [] [] t) ""
1980
1981 showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
1982 showsTree wide lbars rbars t
1983 = case t of
1984 Bin p m l r
1985 -> showsTree wide (withBar rbars) (withEmpty rbars) r .
1986 showWide wide rbars .
1987 showsBars lbars . showString (showBin p m) . showString "\n" .
1988 showWide wide lbars .
1989 showsTree wide (withEmpty lbars) (withBar lbars) l
1990 Tip k x
1991 -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1992 Nil -> showsBars lbars . showString "|\n"
1993
1994 showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
1995 showsTreeHang wide bars t
1996 = case t of
1997 Bin p m l r
1998 -> showsBars bars . showString (showBin p m) . showString "\n" .
1999 showWide wide bars .
2000 showsTreeHang wide (withBar bars) l .
2001 showWide wide bars .
2002 showsTreeHang wide (withEmpty bars) r
2003 Tip k x
2004 -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
2005 Nil -> showsBars bars . showString "|\n"
2006
2007 showBin :: Prefix -> Mask -> String
2008 showBin _ _
2009 = "*" -- ++ show (p,m)
2010
2011 showWide :: Bool -> [String] -> String -> String
2012 showWide wide bars
2013 | wide = showString (concat (reverse bars)) . showString "|\n"
2014 | otherwise = id
2015
2016 showsBars :: [String] -> ShowS
2017 showsBars bars
2018 = case bars of
2019 [] -> id
2020 _ -> showString (concat (reverse (tail bars))) . showString node
2021
2022 node :: String
2023 node = "+--"
2024
2025 withBar, withEmpty :: [String] -> [String]
2026 withBar bars = "| ":bars
2027 withEmpty bars = " ":bars