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