1 {-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.IntMap
5 -- Copyright : (c) Daan Leijen 2002
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
11 -- An efficient implementation of maps from integer keys to values.
13 -- Since many function names (but not the type name) clash with
14 -- "Prelude" names, this module is usually imported @qualified@, e.g.
16 -- > import Data.IntMap (IntMap)
17 -- > import qualified Data.IntMap as IntMap
19 -- The implementation is based on /big-endian patricia trees/. This data
20 -- structure performs especially well on binary operations like 'union'
21 -- and 'intersection'. However, my benchmarks show that it is also
22 -- (much) faster on insertions and deletions when compared to a generic
23 -- size-balanced map implementation (see "Data.Map" and "Data.FiniteMap").
25 -- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
26 -- Workshop on ML, September 1998, pages 77-86,
27 -- <http://www.cse.ogi.edu/~andy/pub/finite.htm>
29 -- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
30 -- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
31 -- October 1968, pages 514-534.
33 -- Many operations have a worst-case complexity of /O(min(n,W))/.
34 -- This means that the operation can become linear in the number of
35 -- elements with a maximum of /W/ -- the number of bits in an 'Int'
37 -----------------------------------------------------------------------------
41 IntMap, Key -- instance Eq,Show
60 , insertWith, insertWithKey, insertLookupWithKey
118 , fromDistinctAscList
135 , isSubmapOf, isSubmapOfBy
136 , isProperSubmapOf, isProperSubmapOfBy
161 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
163 import qualified Data.IntSet as IntSet
164 import Data.Monoid (Monoid(..))
166 import Data.Foldable (Foldable(foldMap))
167 import Control.Monad ( liftM )
170 import qualified Prelude
171 import Debug.QuickCheck
172 import List (nub,sort)
173 import qualified List
176 #if __GLASGOW_HASKELL__
178 import Data.Generics.Basics (Data(..), mkNorepType)
179 import Data.Generics.Instances ()
182 #if __GLASGOW_HASKELL__ >= 503
183 import GHC.Exts ( Word(..), Int(..), shiftRL# )
184 #elif __GLASGOW_HASKELL__
186 import GlaExts ( Word(..), Int(..), shiftRL# )
191 infixl 9 \\{-This comment teaches CPP correct behaviour -}
193 -- A "Nat" is a natural machine word (an unsigned Int)
196 natFromInt :: Key -> Nat
197 natFromInt i = fromIntegral i
199 intFromNat :: Nat -> Key
200 intFromNat w = fromIntegral w
202 shiftRL :: Nat -> Key -> Nat
203 #if __GLASGOW_HASKELL__
204 {--------------------------------------------------------------------
205 GHC: use unboxing to get @shiftRL@ inlined.
206 --------------------------------------------------------------------}
207 shiftRL (W# x) (I# i)
210 shiftRL x i = shiftR x i
213 {--------------------------------------------------------------------
215 --------------------------------------------------------------------}
217 -- | /O(min(n,W))/. Find the value at a key.
218 -- Calls 'error' when the element can not be found.
220 (!) :: IntMap a -> Key -> a
223 -- | /O(n+m)/. See 'difference'.
224 (\\) :: IntMap a -> IntMap b -> IntMap a
225 m1 \\ m2 = difference m1 m2
227 {--------------------------------------------------------------------
229 --------------------------------------------------------------------}
230 -- | A map of integers to values @a@.
232 | Tip {-# UNPACK #-} !Key a
233 | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a)
239 instance Monoid (IntMap a) where
244 instance Foldable IntMap where
245 foldMap f Nil = mempty
246 foldMap f (Tip _k v) = f v
247 foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r
249 #if __GLASGOW_HASKELL__
251 {--------------------------------------------------------------------
253 --------------------------------------------------------------------}
255 -- This instance preserves data abstraction at the cost of inefficiency.
256 -- We omit reflection services for the sake of data abstraction.
258 instance Data a => Data (IntMap a) where
259 gfoldl f z im = z fromList `f` (toList im)
260 toConstr _ = error "toConstr"
261 gunfold _ _ = error "gunfold"
262 dataTypeOf _ = mkNorepType "Data.IntMap.IntMap"
263 dataCast1 f = gcast1 f
267 {--------------------------------------------------------------------
269 --------------------------------------------------------------------}
270 -- | /O(1)/. Is the map empty?
271 null :: IntMap a -> Bool
275 -- | /O(n)/. Number of elements in the map.
276 size :: IntMap a -> Int
279 Bin p m l r -> size l + size r
283 -- | /O(min(n,W))/. Is the key a member of the map?
284 member :: Key -> IntMap a -> Bool
290 -- | /O(log n)/. Is the key not a member of the map?
291 notMember :: Key -> IntMap a -> Bool
292 notMember k m = not $ member k m
294 -- | /O(min(n,W))/. Lookup the value at a key in the map.
295 lookup :: (Monad m) => Key -> IntMap a -> m a
296 lookup k t = case lookup' k t of
298 Nothing -> fail "Data.IntMap.lookup: Key not found"
300 lookup' :: Key -> IntMap a -> Maybe a
302 = let nk = natFromInt k in seq nk (lookupN nk t)
304 lookupN :: Nat -> IntMap a -> Maybe a
308 | zeroN k (natFromInt m) -> lookupN k l
309 | otherwise -> lookupN k r
311 | (k == natFromInt kx) -> Just x
312 | otherwise -> Nothing
315 find' :: Key -> IntMap a -> a
318 Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
322 -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
323 -- returns the value at key @k@ or returns @def@ when the key is not an
324 -- element of the map.
325 findWithDefault :: a -> Key -> IntMap a -> a
326 findWithDefault def k m
331 {--------------------------------------------------------------------
333 --------------------------------------------------------------------}
334 -- | /O(1)/. The empty map.
339 -- | /O(1)/. A map of one element.
340 singleton :: Key -> a -> IntMap a
344 {--------------------------------------------------------------------
346 --------------------------------------------------------------------}
347 -- | /O(min(n,W))/. Insert a new key\/value pair in the map.
348 -- If the key is already present in the map, the associated value is
349 -- replaced with the supplied value, i.e. 'insert' is equivalent to
350 -- @'insertWith' 'const'@.
351 insert :: Key -> a -> IntMap a -> IntMap a
355 | nomatch k p m -> join k (Tip k x) p t
356 | zero k m -> Bin p m (insert k x l) r
357 | otherwise -> Bin p m l (insert k x r)
360 | otherwise -> join k (Tip k x) ky t
363 -- right-biased insertion, used by 'union'
364 -- | /O(min(n,W))/. Insert with a combining function.
365 -- @'insertWith' f key value mp@
366 -- will insert the pair (key, value) into @mp@ if key does
367 -- not exist in the map. If the key does exist, the function will
368 -- insert @f new_value old_value@.
369 insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
371 = insertWithKey (\k x y -> f x y) k x t
373 -- | /O(min(n,W))/. Insert with a combining function.
374 -- @'insertWithKey' f key value mp@
375 -- will insert the pair (key, value) into @mp@ if key does
376 -- not exist in the map. If the key does exist, the function will
377 -- insert @f key new_value old_value@.
378 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
379 insertWithKey f k x t
382 | nomatch k p m -> join k (Tip k x) p t
383 | zero k m -> Bin p m (insertWithKey f k x l) r
384 | otherwise -> Bin p m l (insertWithKey f k x r)
386 | k==ky -> Tip k (f k x y)
387 | otherwise -> join k (Tip k x) ky t
391 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
392 -- is a pair where the first element is equal to (@'lookup' k map@)
393 -- and the second element equal to (@'insertWithKey' f k x map@).
394 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
395 insertLookupWithKey f k x t
398 | nomatch k p m -> (Nothing,join k (Tip k x) p t)
399 | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
400 | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
402 | k==ky -> (Just y,Tip k (f k x y))
403 | otherwise -> (Nothing,join k (Tip k x) ky t)
404 Nil -> (Nothing,Tip k x)
407 {--------------------------------------------------------------------
409 [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
410 --------------------------------------------------------------------}
411 -- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
412 -- a member of the map, the original map is returned.
413 delete :: Key -> IntMap a -> IntMap a
418 | zero k m -> bin p m (delete k l) r
419 | otherwise -> bin p m l (delete k r)
425 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
426 -- a member of the map, the original map is returned.
427 adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
429 = adjustWithKey (\k x -> f x) k m
431 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
432 -- a member of the map, the original map is returned.
433 adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
435 = updateWithKey (\k x -> Just (f k x)) k m
437 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
438 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
439 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
440 update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
442 = updateWithKey (\k x -> f x) k m
444 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
445 -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
446 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
447 updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
452 | zero k m -> bin p m (updateWithKey f k l) r
453 | otherwise -> bin p m l (updateWithKey f k r)
455 | k==ky -> case (f k y) of
461 -- | /O(min(n,W))/. Lookup and update.
462 updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
463 updateLookupWithKey f k t
466 | nomatch k p m -> (Nothing,t)
467 | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
468 | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
470 | k==ky -> case (f k y) of
471 Just y' -> (Just y,Tip ky y')
472 Nothing -> (Just y,Nil)
473 | otherwise -> (Nothing,t)
478 -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
479 -- 'alter' can be used to insert, delete, or update a value in a 'Map'.
480 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
484 | nomatch k p m -> case f Nothing of
486 Just x -> join k (Tip k x) p t
487 | zero k m -> bin p m (alter f k l) r
488 | otherwise -> bin p m l (alter f k r)
490 | k==ky -> case f (Just y) of
493 | otherwise -> case f Nothing of
494 Just x -> join k (Tip k x) ky t
496 Nil -> case f Nothing of
501 {--------------------------------------------------------------------
503 --------------------------------------------------------------------}
504 -- | The union of a list of maps.
505 unions :: [IntMap a] -> IntMap a
507 = foldlStrict union empty xs
509 -- | The union of a list of maps, with a combining operation
510 unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
512 = foldlStrict (unionWith f) empty ts
514 -- | /O(n+m)/. The (left-biased) union of two maps.
515 -- It prefers the first map when duplicate keys are encountered,
516 -- i.e. (@'union' == 'unionWith' 'const'@).
517 union :: IntMap a -> IntMap a -> IntMap a
518 union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
519 | shorter m1 m2 = union1
520 | shorter m2 m1 = union2
521 | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
522 | otherwise = join p1 t1 p2 t2
524 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
525 | zero p2 m1 = Bin p1 m1 (union l1 t2) r1
526 | otherwise = Bin p1 m1 l1 (union r1 t2)
528 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
529 | zero p1 m2 = Bin p2 m2 (union t1 l2) r2
530 | otherwise = Bin p2 m2 l2 (union t1 r2)
532 union (Tip k x) t = insert k x t
533 union t (Tip k x) = insertWith (\x y -> y) k x t -- right bias
537 -- | /O(n+m)/. The union with a combining function.
538 unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
540 = unionWithKey (\k x y -> f x y) m1 m2
542 -- | /O(n+m)/. The union with a combining function.
543 unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
544 unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
545 | shorter m1 m2 = union1
546 | shorter m2 m1 = union2
547 | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
548 | otherwise = join p1 t1 p2 t2
550 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
551 | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
552 | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
554 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
555 | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
556 | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
558 unionWithKey f (Tip k x) t = insertWithKey f k x t
559 unionWithKey f t (Tip k x) = insertWithKey (\k x y -> f k y x) k x t -- right bias
560 unionWithKey f Nil t = t
561 unionWithKey f t Nil = t
563 {--------------------------------------------------------------------
565 --------------------------------------------------------------------}
566 -- | /O(n+m)/. Difference between two maps (based on keys).
567 difference :: IntMap a -> IntMap b -> IntMap a
568 difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
569 | shorter m1 m2 = difference1
570 | shorter m2 m1 = difference2
571 | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
574 difference1 | nomatch p2 p1 m1 = t1
575 | zero p2 m1 = bin p1 m1 (difference l1 t2) r1
576 | otherwise = bin p1 m1 l1 (difference r1 t2)
578 difference2 | nomatch p1 p2 m2 = t1
579 | zero p1 m2 = difference t1 l2
580 | otherwise = difference t1 r2
582 difference t1@(Tip k x) t2
586 difference Nil t = Nil
587 difference t (Tip k x) = delete k t
590 -- | /O(n+m)/. Difference with a combining function.
591 differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
592 differenceWith f m1 m2
593 = differenceWithKey (\k x y -> f x y) m1 m2
595 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
596 -- encountered, the combining function is applied to the key and both values.
597 -- If it returns 'Nothing', the element is discarded (proper set difference).
598 -- If it returns (@'Just' y@), the element is updated with a new value @y@.
599 differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
600 differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
601 | shorter m1 m2 = difference1
602 | shorter m2 m1 = difference2
603 | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
606 difference1 | nomatch p2 p1 m1 = t1
607 | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
608 | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
610 difference2 | nomatch p1 p2 m2 = t1
611 | zero p1 m2 = differenceWithKey f t1 l2
612 | otherwise = differenceWithKey f t1 r2
614 differenceWithKey f t1@(Tip k x) t2
615 = case lookup k t2 of
616 Just y -> case f k x y of
621 differenceWithKey f Nil t = Nil
622 differenceWithKey f t (Tip k y) = updateWithKey (\k x -> f k x y) k t
623 differenceWithKey f t Nil = t
626 {--------------------------------------------------------------------
628 --------------------------------------------------------------------}
629 -- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
630 intersection :: IntMap a -> IntMap b -> IntMap a
631 intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
632 | shorter m1 m2 = intersection1
633 | shorter m2 m1 = intersection2
634 | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
637 intersection1 | nomatch p2 p1 m1 = Nil
638 | zero p2 m1 = intersection l1 t2
639 | otherwise = intersection r1 t2
641 intersection2 | nomatch p1 p2 m2 = Nil
642 | zero p1 m2 = intersection t1 l2
643 | otherwise = intersection t1 r2
645 intersection t1@(Tip k x) t2
648 intersection t (Tip k x)
652 intersection Nil t = Nil
653 intersection t Nil = Nil
655 -- | /O(n+m)/. The intersection with a combining function.
656 intersectionWith :: (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
657 intersectionWith f m1 m2
658 = intersectionWithKey (\k x y -> f x y) m1 m2
660 -- | /O(n+m)/. The intersection with a combining function.
661 intersectionWithKey :: (Key -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
662 intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
663 | shorter m1 m2 = intersection1
664 | shorter m2 m1 = intersection2
665 | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
668 intersection1 | nomatch p2 p1 m1 = Nil
669 | zero p2 m1 = intersectionWithKey f l1 t2
670 | otherwise = intersectionWithKey f r1 t2
672 intersection2 | nomatch p1 p2 m2 = Nil
673 | zero p1 m2 = intersectionWithKey f t1 l2
674 | otherwise = intersectionWithKey f t1 r2
676 intersectionWithKey f t1@(Tip k x) t2
677 = case lookup k t2 of
678 Just y -> Tip k (f k x y)
680 intersectionWithKey f t1 (Tip k y)
681 = case lookup k t1 of
682 Just x -> Tip k (f k x y)
684 intersectionWithKey f Nil t = Nil
685 intersectionWithKey f t Nil = Nil
688 {--------------------------------------------------------------------
690 --------------------------------------------------------------------}
692 -- | /O(log n)/. Update the value at the minimal key.
693 updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
696 Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
697 Bin p m l r -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
698 Tip k y -> Tip k (f k y)
699 Nil -> error "maxView: empty map has no maximal element"
701 updateMinWithKeyUnsigned f t
703 Bin p m l r -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
704 Tip k y -> Tip k (f k y)
706 -- | /O(log n)/. Update the value at the maximal key.
707 updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
710 Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f r in Bin p m r t'
711 Bin p m l r -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' l
712 Tip k y -> Tip k (f k y)
713 Nil -> error "maxView: empty map has no maximal element"
715 updateMaxWithKeyUnsigned f t
717 Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
718 Tip k y -> Tip k (f k y)
721 -- | /O(log n)/. Retrieves the maximal (key,value) couple of the map, and the map stripped from that element.
722 -- @fail@s (in the monad) when passed an empty map.
723 maxViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)
726 Bin p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in return (result, bin p m t' r)
727 Bin p m l r -> let (result, t') = maxViewUnsigned r in return (result, bin p m l t')
728 Tip k y -> return ((k,y), Nil)
729 Nil -> fail "maxView: empty map has no maximal element"
733 Bin p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
734 Tip k y -> ((k,y), Nil)
736 -- | /O(log n)/. Retrieves the minimal (key,value) couple of the map, and the map stripped from that element.
737 -- @fail@s (in the monad) when passed an empty map.
738 minViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)
741 Bin p m l r | m < 0 -> let (result, t') = minViewUnsigned r in return (result, bin p m l t')
742 Bin p m l r -> let (result, t') = minViewUnsigned l in return (result, bin p m t' r)
743 Tip k y -> return ((k,y),Nil)
744 Nil -> fail "minView: empty map has no minimal element"
748 Bin p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
749 Tip k y -> ((k,y),Nil)
752 -- | /O(log n)/. Update the value at the maximal key.
753 updateMax :: (a -> a) -> IntMap a -> IntMap a
754 updateMax f = updateMaxWithKey (const f)
756 -- | /O(log n)/. Update the value at the minimal key.
757 updateMin :: (a -> a) -> IntMap a -> IntMap a
758 updateMin f = updateMinWithKey (const f)
761 -- Duplicate the Identity monad here because base < mtl.
762 newtype Identity a = Identity { runIdentity :: a }
763 instance Monad Identity where
764 return a = Identity a
765 m >>= k = k (runIdentity m)
766 -- Similar to the Arrow instance.
767 first f (x,y) = (f x,y)
770 -- | /O(log n)/. Retrieves the maximal key of the map, and the map stripped from that element.
771 -- @fail@s (in the monad) when passed an empty map.
772 maxView t = liftM (first snd) (maxViewWithKey t)
774 -- | /O(log n)/. Retrieves the minimal key of the map, and the map stripped from that element.
775 -- @fail@s (in the monad) when passed an empty map.
776 minView t = liftM (first snd) (minViewWithKey t)
778 -- | /O(log n)/. Delete and find the maximal element.
779 deleteFindMax = runIdentity . maxView
781 -- | /O(log n)/. Delete and find the minimal element.
782 deleteFindMin = runIdentity . minView
784 -- | /O(log n)/. The minimal key of the map.
785 findMin = fst . runIdentity . minView
787 -- | /O(log n)/. The maximal key of the map.
788 findMax = fst . runIdentity . maxView
790 -- | /O(log n)/. Delete the minimal key.
791 deleteMin = snd . runIdentity . minView
793 -- | /O(log n)/. Delete the maximal key.
794 deleteMax = snd . runIdentity . maxView
797 {--------------------------------------------------------------------
799 --------------------------------------------------------------------}
800 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
801 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
802 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
803 isProperSubmapOf m1 m2
804 = isProperSubmapOfBy (==) m1 m2
806 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
807 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
808 @m1@ and @m2@ are not equal,
809 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
810 applied to their respective values. For example, the following
811 expressions are all 'True':
813 > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
814 > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
816 But the following are all 'False':
818 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
819 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
820 > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
822 isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
823 isProperSubmapOfBy pred t1 t2
824 = case submapCmp pred t1 t2 of
828 submapCmp pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
830 | shorter m2 m1 = submapCmpLt
831 | p1 == p2 = submapCmpEq
832 | otherwise = GT -- disjoint
834 submapCmpLt | nomatch p1 p2 m2 = GT
835 | zero p1 m2 = submapCmp pred t1 l2
836 | otherwise = submapCmp pred t1 r2
837 submapCmpEq = case (submapCmp pred l1 l2, submapCmp pred r1 r2) of
843 submapCmp pred (Bin p m l r) t = GT
844 submapCmp pred (Tip kx x) (Tip ky y)
845 | (kx == ky) && pred x y = EQ
846 | otherwise = GT -- disjoint
847 submapCmp pred (Tip k x) t
849 Just y | pred x y -> LT
850 other -> GT -- disjoint
851 submapCmp pred Nil Nil = EQ
852 submapCmp pred Nil t = LT
854 -- | /O(n+m)/. Is this a submap?
855 -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
856 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
858 = isSubmapOfBy (==) m1 m2
861 The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
862 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
863 applied to their respective values. For example, the following
864 expressions are all 'True':
866 > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
867 > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
868 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
870 But the following are all 'False':
872 > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
873 > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
874 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
877 isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
878 isSubmapOfBy pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
879 | shorter m1 m2 = False
880 | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy pred t1 l2
881 else isSubmapOfBy pred t1 r2)
882 | otherwise = (p1==p2) && isSubmapOfBy pred l1 l2 && isSubmapOfBy pred r1 r2
883 isSubmapOfBy pred (Bin p m l r) t = False
884 isSubmapOfBy pred (Tip k x) t = case lookup k t of
887 isSubmapOfBy pred Nil t = True
889 {--------------------------------------------------------------------
891 --------------------------------------------------------------------}
892 -- | /O(n)/. Map a function over all values in the map.
893 map :: (a -> b) -> IntMap a -> IntMap b
895 = mapWithKey (\k x -> f x) m
897 -- | /O(n)/. Map a function over all values in the map.
898 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
901 Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
902 Tip k x -> Tip k (f k x)
905 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
906 -- argument through the map in ascending order of keys.
907 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
909 = mapAccumWithKey (\a k x -> f a x) a m
911 -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
912 -- argument through the map in ascending order of keys.
913 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
914 mapAccumWithKey f a t
917 -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
918 -- argument through the map in ascending order of keys.
919 mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
922 Bin p m l r -> let (a1,l') = mapAccumL f a l
923 (a2,r') = mapAccumL f a1 r
924 in (a2,Bin p m l' r')
925 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
929 -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
930 -- argument throught the map in descending order of keys.
931 mapAccumR :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
934 Bin p m l r -> let (a1,r') = mapAccumR f a r
935 (a2,l') = mapAccumR f a1 l
936 in (a2,Bin p m l' r')
937 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
940 {--------------------------------------------------------------------
942 --------------------------------------------------------------------}
943 -- | /O(n)/. Filter all values that satisfy some predicate.
944 filter :: (a -> Bool) -> IntMap a -> IntMap a
946 = filterWithKey (\k x -> p x) m
948 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
949 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
953 -> bin p m (filterWithKey pred l) (filterWithKey pred r)
959 -- | /O(n)/. partition the map according to some predicate. The first
960 -- map contains all elements that satisfy the predicate, the second all
961 -- elements that fail the predicate. See also 'split'.
962 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
964 = partitionWithKey (\k x -> p x) m
966 -- | /O(n)/. partition the map according to some predicate. The first
967 -- map contains all elements that satisfy the predicate, the second all
968 -- elements that fail the predicate. See also 'split'.
969 partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
970 partitionWithKey pred t
973 -> let (l1,l2) = partitionWithKey pred l
974 (r1,r2) = partitionWithKey pred r
975 in (bin p m l1 r1, bin p m l2 r2)
977 | pred k x -> (t,Nil)
978 | otherwise -> (Nil,t)
981 -- | /O(n)/. Map values and collect the 'Just' results.
982 mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
984 = mapMaybeWithKey (\k x -> f x) m
986 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
987 mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
988 mapMaybeWithKey f (Bin p m l r)
989 = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
990 mapMaybeWithKey f (Tip k x) = case f k x of
993 mapMaybeWithKey f Nil = Nil
995 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
996 mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
998 = mapEitherWithKey (\k x -> f x) m
1000 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
1001 mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1002 mapEitherWithKey f (Bin p m l r)
1003 = (bin p m l1 r1, bin p m l2 r2)
1005 (l1,l2) = mapEitherWithKey f l
1006 (r1,r2) = mapEitherWithKey f r
1007 mapEitherWithKey f (Tip k x) = case f k x of
1008 Left y -> (Tip k y, Nil)
1009 Right z -> (Nil, Tip k z)
1010 mapEitherWithKey f Nil = (Nil, Nil)
1012 -- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
1013 -- where all keys in @map1@ are lower than @k@ and all keys in
1014 -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
1015 split :: Key -> IntMap a -> (IntMap a,IntMap a)
1019 | m < 0 -> (if k >= 0 -- handle negative numbers.
1020 then let (lt,gt) = split' k l in (union r lt, gt)
1021 else let (lt,gt) = split' k r in (lt, union gt l))
1022 | otherwise -> split' k t
1026 | otherwise -> (Nil,Nil)
1029 split' :: Key -> IntMap a -> (IntMap a,IntMap a)
1033 | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
1034 | zero k m -> let (lt,gt) = split k l in (lt,union gt r)
1035 | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
1039 | otherwise -> (Nil,Nil)
1042 -- | /O(log n)/. Performs a 'split' but also returns whether the pivot
1043 -- key was found in the original map.
1044 splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
1048 | m < 0 -> (if k >= 0 -- handle negative numbers.
1049 then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt)
1050 else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l))
1051 | otherwise -> splitLookup' k t
1053 | k>ky -> (t,Nothing,Nil)
1054 | k<ky -> (Nil,Nothing,t)
1055 | otherwise -> (Nil,Just y,Nil)
1056 Nil -> (Nil,Nothing,Nil)
1058 splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
1062 | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
1063 | zero k m -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
1064 | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
1066 | k>ky -> (t,Nothing,Nil)
1067 | k<ky -> (Nil,Nothing,t)
1068 | otherwise -> (Nil,Just y,Nil)
1069 Nil -> (Nil,Nothing,Nil)
1071 {--------------------------------------------------------------------
1073 --------------------------------------------------------------------}
1074 -- | /O(n)/. Fold the values in the map, such that
1075 -- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
1078 -- > elems map = fold (:) [] map
1080 fold :: (a -> b -> b) -> b -> IntMap a -> b
1082 = foldWithKey (\k x y -> f x y) z t
1084 -- | /O(n)/. Fold the keys and values in the map, such that
1085 -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
1088 -- > keys map = foldWithKey (\k x ks -> k:ks) [] map
1090 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1094 foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1097 Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r -- put negative numbers before.
1098 Bin _ _ _ _ -> foldr' f z t
1102 foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1105 Bin p m l r -> foldr' f (foldr' f z r) l
1111 {--------------------------------------------------------------------
1113 --------------------------------------------------------------------}
1115 -- Return all elements of the map in the ascending order of their keys.
1116 elems :: IntMap a -> [a]
1118 = foldWithKey (\k x xs -> x:xs) [] m
1120 -- | /O(n)/. Return all keys of the map in ascending order.
1121 keys :: IntMap a -> [Key]
1123 = foldWithKey (\k x ks -> k:ks) [] m
1125 -- | /O(n*min(n,W))/. The set of all keys of the map.
1126 keysSet :: IntMap a -> IntSet.IntSet
1127 keysSet m = IntSet.fromDistinctAscList (keys m)
1130 -- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
1131 assocs :: IntMap a -> [(Key,a)]
1136 {--------------------------------------------------------------------
1138 --------------------------------------------------------------------}
1139 -- | /O(n)/. Convert the map to a list of key\/value pairs.
1140 toList :: IntMap a -> [(Key,a)]
1142 = foldWithKey (\k x xs -> (k,x):xs) [] t
1144 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
1145 -- keys are in ascending order.
1146 toAscList :: IntMap a -> [(Key,a)]
1148 = -- NOTE: the following algorithm only works for big-endian trees
1149 let (pos,neg) = span (\(k,x) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos
1151 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
1152 fromList :: [(Key,a)] -> IntMap a
1154 = foldlStrict ins empty xs
1156 ins t (k,x) = insert k x t
1158 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
1159 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1161 = fromListWithKey (\k x y -> f x y) xs
1163 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
1164 fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1165 fromListWithKey f xs
1166 = foldlStrict ins empty xs
1168 ins t (k,x) = insertWithKey f k x t
1170 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1171 -- the keys are in ascending order.
1172 fromAscList :: [(Key,a)] -> IntMap a
1176 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1177 -- the keys are in ascending order, with a combining function on equal keys.
1178 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1179 fromAscListWith f xs
1182 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1183 -- the keys are in ascending order, with a combining function on equal keys.
1184 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1185 fromAscListWithKey f xs
1186 = fromListWithKey f xs
1188 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1189 -- the keys are in ascending order and all distinct.
1190 fromDistinctAscList :: [(Key,a)] -> IntMap a
1191 fromDistinctAscList xs
1195 {--------------------------------------------------------------------
1197 --------------------------------------------------------------------}
1198 instance Eq a => Eq (IntMap a) where
1199 t1 == t2 = equal t1 t2
1200 t1 /= t2 = nequal t1 t2
1202 equal :: Eq a => IntMap a -> IntMap a -> Bool
1203 equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1204 = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
1205 equal (Tip kx x) (Tip ky y)
1206 = (kx == ky) && (x==y)
1207 equal Nil Nil = True
1210 nequal :: Eq a => IntMap a -> IntMap a -> Bool
1211 nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1212 = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
1213 nequal (Tip kx x) (Tip ky y)
1214 = (kx /= ky) || (x/=y)
1215 nequal Nil Nil = False
1218 {--------------------------------------------------------------------
1220 --------------------------------------------------------------------}
1222 instance Ord a => Ord (IntMap a) where
1223 compare m1 m2 = compare (toList m1) (toList m2)
1225 {--------------------------------------------------------------------
1227 --------------------------------------------------------------------}
1229 instance Functor IntMap where
1232 {--------------------------------------------------------------------
1234 --------------------------------------------------------------------}
1236 instance Show a => Show (IntMap a) where
1237 showsPrec d m = showParen (d > 10) $
1238 showString "fromList " . shows (toList m)
1240 showMap :: (Show a) => [(Key,a)] -> ShowS
1244 = showChar '{' . showElem x . showTail xs
1246 showTail [] = showChar '}'
1247 showTail (x:xs) = showChar ',' . showElem x . showTail xs
1249 showElem (k,x) = shows k . showString ":=" . shows x
1251 {--------------------------------------------------------------------
1253 --------------------------------------------------------------------}
1254 instance (Read e) => Read (IntMap e) where
1255 #ifdef __GLASGOW_HASKELL__
1256 readPrec = parens $ prec 10 $ do
1257 Ident "fromList" <- lexP
1259 return (fromList xs)
1261 readListPrec = readListPrecDefault
1263 readsPrec p = readParen (p > 10) $ \ r -> do
1264 ("fromList",s) <- lex r
1266 return (fromList xs,t)
1269 {--------------------------------------------------------------------
1271 --------------------------------------------------------------------}
1273 #include "Typeable.h"
1274 INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
1276 {--------------------------------------------------------------------
1278 --------------------------------------------------------------------}
1279 -- | /O(n)/. Show the tree that implements the map. The tree is shown
1280 -- in a compressed, hanging format.
1281 showTree :: Show a => IntMap a -> String
1283 = showTreeWith True False s
1286 {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
1287 the tree that implements the map. If @hang@ is
1288 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
1289 @wide@ is 'True', an extra wide version is shown.
1291 showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
1292 showTreeWith hang wide t
1293 | hang = (showsTreeHang wide [] t) ""
1294 | otherwise = (showsTree wide [] [] t) ""
1296 showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
1297 showsTree wide lbars rbars t
1300 -> showsTree wide (withBar rbars) (withEmpty rbars) r .
1301 showWide wide rbars .
1302 showsBars lbars . showString (showBin p m) . showString "\n" .
1303 showWide wide lbars .
1304 showsTree wide (withEmpty lbars) (withBar lbars) l
1306 -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1307 Nil -> showsBars lbars . showString "|\n"
1309 showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
1310 showsTreeHang wide bars t
1313 -> showsBars bars . showString (showBin p m) . showString "\n" .
1314 showWide wide bars .
1315 showsTreeHang wide (withBar bars) l .
1316 showWide wide bars .
1317 showsTreeHang wide (withEmpty bars) r
1319 -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1320 Nil -> showsBars bars . showString "|\n"
1323 = "*" -- ++ show (p,m)
1326 | wide = showString (concat (reverse bars)) . showString "|\n"
1329 showsBars :: [String] -> ShowS
1333 _ -> showString (concat (reverse (tail bars))) . showString node
1336 withBar bars = "| ":bars
1337 withEmpty bars = " ":bars
1340 {--------------------------------------------------------------------
1342 --------------------------------------------------------------------}
1343 {--------------------------------------------------------------------
1345 --------------------------------------------------------------------}
1346 join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
1348 | zero p1 m = Bin p m t1 t2
1349 | otherwise = Bin p m t2 t1
1351 m = branchMask p1 p2
1354 {--------------------------------------------------------------------
1355 @bin@ assures that we never have empty trees within a tree.
1356 --------------------------------------------------------------------}
1357 bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
1360 bin p m l r = Bin p m l r
1363 {--------------------------------------------------------------------
1364 Endian independent bit twiddling
1365 --------------------------------------------------------------------}
1366 zero :: Key -> Mask -> Bool
1368 = (natFromInt i) .&. (natFromInt m) == 0
1370 nomatch,match :: Key -> Prefix -> Mask -> Bool
1377 mask :: Key -> Mask -> Prefix
1379 = maskW (natFromInt i) (natFromInt m)
1382 zeroN :: Nat -> Nat -> Bool
1383 zeroN i m = (i .&. m) == 0
1385 {--------------------------------------------------------------------
1386 Big endian operations
1387 --------------------------------------------------------------------}
1388 maskW :: Nat -> Nat -> Prefix
1390 = intFromNat (i .&. (complement (m-1) `xor` m))
1392 shorter :: Mask -> Mask -> Bool
1394 = (natFromInt m1) > (natFromInt m2)
1396 branchMask :: Prefix -> Prefix -> Mask
1398 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
1400 {----------------------------------------------------------------------
1401 Finding the highest bit (mask) in a word [x] can be done efficiently in
1403 * convert to a floating point value and the mantissa tells us the
1404 [log2(x)] that corresponds with the highest bit position. The mantissa
1405 is retrieved either via the standard C function [frexp] or by some bit
1406 twiddling on IEEE compatible numbers (float). Note that one needs to
1407 use at least [double] precision for an accurate mantissa of 32 bit
1409 * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
1410 * use processor specific assembler instruction (asm).
1412 The most portable way would be [bit], but is it efficient enough?
1413 I have measured the cycle counts of the different methods on an AMD
1414 Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
1416 highestBitMask: method cycles
1423 highestBit: method cycles
1430 Wow, the bit twiddling is on today's RISC like machines even faster
1431 than a single CISC instruction (BSR)!
1432 ----------------------------------------------------------------------}
1434 {----------------------------------------------------------------------
1435 [highestBitMask] returns a word where only the highest bit is set.
1436 It is found by first setting all bits in lower positions than the
1437 highest bit and than taking an exclusive or with the original value.
1438 Allthough the function may look expensive, GHC compiles this into
1439 excellent C code that subsequently compiled into highly efficient
1440 machine code. The algorithm is derived from Jorg Arndt's FXT library.
1441 ----------------------------------------------------------------------}
1442 highestBitMask :: Nat -> Nat
1444 = case (x .|. shiftRL x 1) of
1445 x -> case (x .|. shiftRL x 2) of
1446 x -> case (x .|. shiftRL x 4) of
1447 x -> case (x .|. shiftRL x 8) of
1448 x -> case (x .|. shiftRL x 16) of
1449 x -> case (x .|. shiftRL x 32) of -- for 64 bit platforms
1450 x -> (x `xor` (shiftRL x 1))
1453 {--------------------------------------------------------------------
1455 --------------------------------------------------------------------}
1459 (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
1462 {--------------------------------------------------------------------
1464 --------------------------------------------------------------------}
1465 testTree :: [Int] -> IntMap Int
1466 testTree xs = fromList [(x,x*x*30696 `mod` 65521) | x <- xs]
1467 test1 = testTree [1..20]
1468 test2 = testTree [30,29..10]
1469 test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
1471 {--------------------------------------------------------------------
1473 --------------------------------------------------------------------}
1478 { configMaxTest = 500
1479 , configMaxFail = 5000
1480 , configSize = \n -> (div n 2 + 3)
1481 , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
1485 {--------------------------------------------------------------------
1486 Arbitrary, reasonably balanced trees
1487 --------------------------------------------------------------------}
1488 instance Arbitrary a => Arbitrary (IntMap a) where
1489 arbitrary = do{ ks <- arbitrary
1490 ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
1491 ; return (fromList xs)
1495 {--------------------------------------------------------------------
1496 Single, Insert, Delete
1497 --------------------------------------------------------------------}
1498 prop_Single :: Key -> Int -> Bool
1500 = (insert k x empty == singleton k x)
1502 prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
1503 prop_InsertDelete k x t
1504 = not (member k t) ==> delete k (insert k x t) == t
1506 prop_UpdateDelete :: Key -> IntMap Int -> Bool
1507 prop_UpdateDelete k t
1508 = update (const Nothing) k t == delete k t
1511 {--------------------------------------------------------------------
1513 --------------------------------------------------------------------}
1514 prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
1515 prop_UnionInsert k x t
1516 = union (singleton k x) t == insert k x t
1518 prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
1519 prop_UnionAssoc t1 t2 t3
1520 = union t1 (union t2 t3) == union (union t1 t2) t3
1522 prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
1523 prop_UnionComm t1 t2
1524 = (union t1 t2 == unionWith (\x y -> y) t2 t1)
1527 prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
1529 = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
1530 == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
1532 prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
1534 = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
1535 == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
1537 {--------------------------------------------------------------------
1539 --------------------------------------------------------------------}
1541 = forAll (choose (5,100)) $ \n ->
1542 let xs = [(x,()) | x <- [0..n::Int]]
1543 in fromAscList xs == fromList xs
1545 prop_List :: [Key] -> Bool
1547 = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])