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