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