[PATCH] Split Data.IntMap into Data.IntMap.Strict and Data.IntMap.Lazy.
Edward Z. Yang
ezyang at MIT.EDU
Fri Sep 16 21:49:28 CEST 2011
From: "Edward Z. Yang" <ezyang at mit.edu>
Deprecates insert' and insertWith', and adds a raft of new
strict functions for manipulating IntMaps in Data.IntMap.Strict.
Auxiliary module Data.IntMap.Common for defining bit manipulation
and types.
See libraries proposal:
http://www.haskell.org/pipermail/libraries/2011-May/016362.html
Signed-off-by: Edward Z. Yang <ezyang at mit.edu>
---
Data/IntMap.hs | 1817 +------------------------------------------------
Data/IntMap/Common.hs | 245 +++++++
Data/IntMap/Lazy.hs | 1783 ++++++++++++++++++++++++++++++++++++++++++++++++
Data/IntMap/Strict.hs | 883 ++++++++++++++++++++++++
containers.cabal | 4 +
5 files changed, 2932 insertions(+), 1800 deletions(-)
create mode 100644 Data/IntMap/Common.hs
create mode 100644 Data/IntMap/Lazy.hs
create mode 100644 Data/IntMap/Strict.hs
diff --git a/Data/IntMap.hs b/Data/IntMap.hs
index b214d90..1d8b0ce 100644
--- a/Data/IntMap.hs
+++ b/Data/IntMap.hs
@@ -40,13 +40,11 @@
-- This means that the operation can become linear in the number of
-- elements with a maximum of /W/ -- the number of bits in an 'Int'
-- (32 or 64).
+--
+-- This module is spine strict, but value lazy. If you require strict
+-- operations on these maps, please use "Data.IntMap.Strict".
-----------------------------------------------------------------------------
--- It is essential that the bit fiddling functions like mask, zero, branchMask
--- etc are inlined. If they do not, the memory allocation skyrockets. The GHC
--- usually gets it right, but it is disastrous if it does not. Therefore we
--- explicitly mark these functions INLINE.
-
module Data.IntMap (
-- * Map type
#if !defined(TESTING)
@@ -187,1222 +185,25 @@ module Data.IntMap (
) where
import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import Data.Bits
-import qualified Data.IntSet as IntSet
-import Data.Monoid (Monoid(..))
-import Data.Maybe (fromMaybe)
-import Data.Typeable
-import qualified Data.Foldable as Foldable
-import Data.Traversable (Traversable(traverse))
-import Control.Applicative (Applicative(pure,(<*>)),(<$>))
-import Control.Monad ( liftM )
-import Control.DeepSeq (NFData(rnf))
-{-
--- just for testing
-import qualified Prelude
-import Test.QuickCheck
-import List (nub,sort)
-import qualified List
--}
-
-#if __GLASGOW_HASKELL__
-import Text.Read
-import Data.Data (Data(..), mkNoRepType)
-#endif
-
-#if __GLASGOW_HASKELL__ >= 503
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
-#elif __GLASGOW_HASKELL__
-import Word
-import GlaExts ( Word(..), Int(..), shiftRL# )
-#else
-import Data.Word
-#endif
-
--- Use macros to define strictness of functions.
--- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
--- We do not use BangPatterns, because they are not in any standard and we
--- want the compilers to be compiled by as many compilers as possible.
-#define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
-
-infixl 9 \\{-This comment teaches CPP correct behaviour -}
-
--- A "Nat" is a natural machine word (an unsigned Int)
-type Nat = Word
-
-natFromInt :: Key -> Nat
-natFromInt = fromIntegral
-{-# INLINE natFromInt #-}
-
-intFromNat :: Nat -> Key
-intFromNat = fromIntegral
-{-# INLINE intFromNat #-}
-
-shiftRL :: Nat -> Key -> Nat
-#if __GLASGOW_HASKELL__
-{--------------------------------------------------------------------
- GHC: use unboxing to get @shiftRL@ inlined.
---------------------------------------------------------------------}
-shiftRL (W# x) (I# i)
- = W# (shiftRL# x i)
-#else
-shiftRL x i = shiftR x i
-{-# INLINE shiftRL #-}
-#endif
-
-{--------------------------------------------------------------------
- Operators
---------------------------------------------------------------------}
-
--- | /O(min(n,W))/. Find the value at a key.
--- Calls 'error' when the element can not be found.
---
--- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
--- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
-
-(!) :: IntMap a -> Key -> a
-m ! k = find k m
-
--- | Same as 'difference'.
-(\\) :: IntMap a -> IntMap b -> IntMap a
-m1 \\ m2 = difference m1 m2
-
-{--------------------------------------------------------------------
- Types
---------------------------------------------------------------------}
-
--- The order of constructors of IntMap matters when considering performance.
--- Currently in GHC 7.0, when type has 3 constructors, they are matched from
--- the first to the last -- the best performance is achieved when the
--- constructors are ordered by frequency.
--- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil
--- improves the containers_benchmark by 9.5% on x86 and by 8% on x86_64.
-
--- | A map of integers to values @a at .
-data IntMap a = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a)
- | Tip {-# UNPACK #-} !Key a
- | Nil
-
-type Prefix = Int
-type Mask = Int
-type Key = Int
-
-instance Monoid (IntMap a) where
- mempty = empty
- mappend = union
- mconcat = unions
-
-instance Foldable.Foldable IntMap where
- fold Nil = mempty
- fold (Tip _ v) = v
- fold (Bin _ _ l r) = Foldable.fold l `mappend` Foldable.fold r
- foldr = foldr
- foldl = foldl
- foldMap _ Nil = mempty
- foldMap f (Tip _k v) = f v
- foldMap f (Bin _ _ l r) = Foldable.foldMap f l `mappend` Foldable.foldMap f r
-
-instance Traversable IntMap where
- traverse _ Nil = pure Nil
- traverse f (Tip k v) = Tip k <$> f v
- traverse f (Bin p m l r) = Bin p m <$> traverse f l <*> traverse f r
-
-instance NFData a => NFData (IntMap a) where
- rnf Nil = ()
- rnf (Tip _ v) = rnf v
- rnf (Bin _ _ l r) = rnf l `seq` rnf r
-
-#if __GLASGOW_HASKELL__
-
-{--------------------------------------------------------------------
- A Data instance
---------------------------------------------------------------------}
-
--- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
-
-instance Data a => Data (IntMap a) where
- gfoldl f z im = z fromList `f` (toList im)
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Data.IntMap.IntMap"
- dataCast1 f = gcast1 f
-
-#endif
-
-{--------------------------------------------------------------------
- Query
---------------------------------------------------------------------}
--- | /O(1)/. Is the map empty?
---
--- > Data.IntMap.null (empty) == True
--- > Data.IntMap.null (singleton 1 'a') == False
-
-null :: IntMap a -> Bool
-null Nil = True
-null _ = False
-
--- | /O(n)/. Number of elements in the map.
---
--- > size empty == 0
--- > size (singleton 1 'a') == 1
--- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3
-size :: IntMap a -> Int
-size t
- = case t of
- Bin _ _ l r -> size l + size r
- Tip _ _ -> 1
- Nil -> 0
-
--- | /O(min(n,W))/. Is the key a member of the map?
---
--- > member 5 (fromList [(5,'a'), (3,'b')]) == True
--- > member 1 (fromList [(5,'a'), (3,'b')]) == False
-
-member :: Key -> IntMap a -> Bool
-member k m
- = case lookup k m of
- Nothing -> False
- Just _ -> True
-
--- | /O(log n)/. Is the key not a member of the map?
---
--- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
--- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
-
-notMember :: Key -> IntMap a -> Bool
-notMember k m = not $ member k m
-
--- The 'go' function in the lookup causes 10% speedup, but also an increased
--- memory allocation. It does not cause speedup with other methods like insert
--- and delete, so it is present only in lookup.
-
--- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.
-lookup :: Key -> IntMap a -> Maybe a
-lookup k = k `seq` go
- where
- go (Bin _ m l r)
- | zero k m = go l
- | otherwise = go r
- go (Tip kx x)
- | k == kx = Just x
- | otherwise = Nothing
- go Nil = Nothing
-
-
-find :: Key -> IntMap a -> a
-find k m
- = case lookup k m of
- Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
- Just x -> x
-
--- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
--- returns the value at key @k@ or returns @def@ when the key is not an
--- element of the map.
---
--- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
--- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
-
-findWithDefault :: a -> Key -> IntMap a -> a
-findWithDefault def k m
- = case lookup k m of
- Nothing -> def
- Just x -> x
-
-{--------------------------------------------------------------------
- Construction
---------------------------------------------------------------------}
--- | /O(1)/. The empty map.
---
--- > empty == fromList []
--- > size empty == 0
-
-empty :: IntMap a
-empty
- = Nil
-
--- | /O(1)/. A map of one element.
---
--- > singleton 1 'a' == fromList [(1, 'a')]
--- > size (singleton 1 'a') == 1
-
-singleton :: Key -> a -> IntMap a
-singleton k x
- = Tip k x
-
-{--------------------------------------------------------------------
- Insert
---------------------------------------------------------------------}
--- | /O(min(n,W))/. Insert a new key\/value pair in the map.
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value, i.e. 'insert' is equivalent to
--- @'insertWith' 'const'@.
---
--- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
--- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
--- > insert 5 'x' empty == singleton 5 'x'
-
-insert :: Key -> a -> IntMap a -> IntMap a
-insert k x t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> join k (Tip k x) p t
- | zero k m -> Bin p m (insert k x l) r
- | otherwise -> Bin p m l (insert k x r)
- Tip ky _
- | k==ky -> Tip k x
- | otherwise -> join k (Tip k x) ky t
- Nil -> Tip k x
-
--- right-biased insertion, used by 'union'
--- | /O(min(n,W))/. Insert with a combining function.
--- @'insertWith' f key value mp@
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert @f new_value old_value at .
---
--- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
--- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
--- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
-
-insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWith f k x t
- = insertWithKey (\_ x' y' -> f x' y') k x t
+import Data.IntMap.Lazy
+import qualified Data.IntMap.Strict as S
-- | Same as 'insertWith', but the combining function is applied strictly.
+-- This function is deprecated, use 'insertWith' in "Data.IntMap.Strict"
+-- instead.
insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWith' f k x t
- = insertWithKey' (\_ x' y' -> f x' y') k x t
-
--- | /O(min(n,W))/. Insert with a combining function.
--- @'insertWithKey' f key value mp@
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert @f key new_value old_value at .
---
--- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
--- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
--- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
--- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
-
-insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWithKey f k x t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> join k (Tip k x) p t
- | zero k m -> Bin p m (insertWithKey f k x l) r
- | otherwise -> Bin p m l (insertWithKey f k x r)
- Tip ky y
- | k==ky -> Tip k (f k x y)
- | otherwise -> join k (Tip k x) ky t
- Nil -> Tip k x
+insertWith' = S.insertWith
+{-# INLINE insertWith' #-}
+-- {-# DEPRECATED insertWith' "Use insertWith in Data.IntMap.Strict instead" #-}
-- | Same as 'insertWithKey', but the combining function is applied strictly.
+-- This function is deprecated, use 'insertWithKey' in "Data.IntMap.Strict"
+-- instead.
insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWithKey' f k x t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> join k (Tip k x) p t
- | zero k m -> Bin p m (insertWithKey' f k x l) r
- | otherwise -> Bin p m l (insertWithKey' f k x r)
- Tip ky y
- | k==ky -> let x' = f k x y in seq x' (Tip k x')
- | otherwise -> join k (Tip k x) ky t
- Nil -> Tip k x
-
--- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
--- is a pair where the first element is equal to (@'lookup' k map@)
--- and the second element equal to (@'insertWithKey' f k x map@).
---
--- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
--- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
--- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
--- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
---
--- This is how to define @insertLookup@ using @insertLookupWithKey@:
---
--- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
--- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
--- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
-
-insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
-insertLookupWithKey f k x t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> (Nothing,join k (Tip k x) p t)
- | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
- | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
- Tip ky y
- | k==ky -> (Just y,Tip k (f k x y))
- | otherwise -> (Nothing,join k (Tip k x) ky t)
- Nil -> (Nothing,Tip k x)
-
-
-{--------------------------------------------------------------------
- Deletion
- [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
---------------------------------------------------------------------}
--- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
--- a member of the map, the original map is returned.
---
--- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
--- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > delete 5 empty == empty
-
-delete :: Key -> IntMap a -> IntMap a
-delete k t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> t
- | zero k m -> bin p m (delete k l) r
- | otherwise -> bin p m l (delete k r)
- Tip ky _
- | k==ky -> Nil
- | otherwise -> t
- Nil -> Nil
-
--- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
---
--- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
--- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > adjust ("new " ++) 7 empty == empty
-
-adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
-adjust f k m
- = adjustWithKey (\_ x -> f x) k m
-
--- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
---
--- > let f key x = (show key) ++ ":new " ++ x
--- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
--- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > adjustWithKey f 7 empty == empty
-
-adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
-adjustWithKey f
- = updateWithKey (\k' x -> Just (f k' x))
-
--- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
---
--- > let f x = if x == "a" then Just "new a" else Nothing
--- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
--- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-
-update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
-update f
- = updateWithKey (\_ x -> f x)
-
--- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
---
--- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
--- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
--- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-
-updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
-updateWithKey f k t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> t
- | zero k m -> bin p m (updateWithKey f k l) r
- | otherwise -> bin p m l (updateWithKey f k r)
- Tip ky y
- | k==ky -> case (f k y) of
- Just y' -> Tip ky y'
- Nothing -> Nil
- | otherwise -> t
- Nil -> Nil
-
--- | /O(min(n,W))/. Lookup and update.
--- The function returns original value, if it is updated.
--- This is different behavior than 'Data.Map.updateLookupWithKey'.
--- Returns the original key value if the map entry is deleted.
---
--- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
--- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])
--- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
--- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
-
-updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
-updateLookupWithKey f k t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> (Nothing,t)
- | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
- | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
- Tip ky y
- | k==ky -> case (f k y) of
- Just y' -> (Just y,Tip ky y')
- Nothing -> (Just y,Nil)
- | otherwise -> (Nothing,t)
- Nil -> (Nothing,Nil)
-
-
-
--- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
--- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
-alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
-alter f k t = k `seq`
- case t of
- Bin p m l r
- | nomatch k p m -> case f Nothing of
- Nothing -> t
- Just x -> join k (Tip k x) p t
- | zero k m -> bin p m (alter f k l) r
- | otherwise -> bin p m l (alter f k r)
- Tip ky y
- | k==ky -> case f (Just y) of
- Just x -> Tip ky x
- Nothing -> Nil
- | otherwise -> case f Nothing of
- Just x -> join k (Tip k x) ky t
- Nothing -> Tip ky y
- Nil -> case f Nothing of
- Just x -> Tip k x
- Nothing -> Nil
-
-
-{--------------------------------------------------------------------
- Union
---------------------------------------------------------------------}
--- | The union of a list of maps.
---
--- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
--- > == fromList [(3, "b"), (5, "a"), (7, "C")]
--- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
--- > == fromList [(3, "B3"), (5, "A3"), (7, "C")]
-
-unions :: [IntMap a] -> IntMap a
-unions xs
- = foldlStrict union empty xs
-
--- | The union of a list of maps, with a combining operation.
---
--- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
--- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
-
-unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
-unionsWith f ts
- = foldlStrict (unionWith f) empty ts
-
--- | /O(n+m)/. The (left-biased) union of two maps.
--- It prefers the first map when duplicate keys are encountered,
--- i.e. (@'union' == 'unionWith' 'const'@).
---
--- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]
-
-union :: IntMap a -> IntMap a -> IntMap a
-union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = union1
- | shorter m2 m1 = union2
- | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
- | otherwise = join p1 t1 p2 t2
- where
- union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
- | zero p2 m1 = Bin p1 m1 (union l1 t2) r1
- | otherwise = Bin p1 m1 l1 (union r1 t2)
-
- union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
- | zero p1 m2 = Bin p2 m2 (union t1 l2) r2
- | otherwise = Bin p2 m2 l2 (union t1 r2)
-
-union (Tip k x) t = insert k x t
-union t (Tip k x) = insertWith (\_ y -> y) k x t -- right bias
-union Nil t = t
-union t Nil = t
-
--- | /O(n+m)/. The union with a combining function.
---
--- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
-
-unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
-unionWith f m1 m2
- = unionWithKey (\_ x y -> f x y) m1 m2
-
--- | /O(n+m)/. The union with a combining function.
---
--- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
--- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
-
-unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
-unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = union1
- | shorter m2 m1 = union2
- | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
- | otherwise = join p1 t1 p2 t2
- where
- union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
- | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
- | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
-
- union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
- | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
- | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
-
-unionWithKey f (Tip k x) t = insertWithKey f k x t
-unionWithKey f t (Tip k x) = insertWithKey (\k' x' y' -> f k' y' x') k x t -- right bias
-unionWithKey _ Nil t = t
-unionWithKey _ t Nil = t
-
-{--------------------------------------------------------------------
- Difference
---------------------------------------------------------------------}
--- | /O(n+m)/. Difference between two maps (based on keys).
---
--- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"
-
-difference :: IntMap a -> IntMap b -> IntMap a
-difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = difference1
- | shorter m2 m1 = difference2
- | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
- | otherwise = t1
- where
- difference1 | nomatch p2 p1 m1 = t1
- | zero p2 m1 = bin p1 m1 (difference l1 t2) r1
- | otherwise = bin p1 m1 l1 (difference r1 t2)
-
- difference2 | nomatch p1 p2 m2 = t1
- | zero p1 m2 = difference t1 l2
- | otherwise = difference t1 r2
-
-difference t1@(Tip k _) t2
- | member k t2 = Nil
- | otherwise = t1
-
-difference Nil _ = Nil
-difference t (Tip k _) = delete k t
-difference t Nil = t
-
--- | /O(n+m)/. Difference with a combining function.
---
--- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
--- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
--- > == singleton 3 "b:B"
-
-differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
-differenceWith f m1 m2
- = differenceWithKey (\_ x y -> f x y) m1 m2
-
--- | /O(n+m)/. Difference with a combining function. When two equal keys are
--- encountered, the combining function is applied to the key and both values.
--- If it returns 'Nothing', the element is discarded (proper set difference).
--- If it returns (@'Just' y@), the element is updated with a new value @y at .
---
--- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
--- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
--- > == singleton 3 "3:b|B"
-
-differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
-differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = difference1
- | shorter m2 m1 = difference2
- | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
- | otherwise = t1
- where
- difference1 | nomatch p2 p1 m1 = t1
- | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
- | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
-
- difference2 | nomatch p1 p2 m2 = t1
- | zero p1 m2 = differenceWithKey f t1 l2
- | otherwise = differenceWithKey f t1 r2
-
-differenceWithKey f t1@(Tip k x) t2
- = case lookup k t2 of
- Just y -> case f k x y of
- Just y' -> Tip k y'
- Nothing -> Nil
- Nothing -> t1
-
-differenceWithKey _ Nil _ = Nil
-differenceWithKey f t (Tip k y) = updateWithKey (\k' x -> f k' x y) k t
-differenceWithKey _ t Nil = t
-
-
-{--------------------------------------------------------------------
- Intersection
---------------------------------------------------------------------}
--- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
---
--- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
-
-intersection :: IntMap a -> IntMap b -> IntMap a
-intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = intersection1
- | shorter m2 m1 = intersection2
- | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
- | otherwise = Nil
- where
- intersection1 | nomatch p2 p1 m1 = Nil
- | zero p2 m1 = intersection l1 t2
- | otherwise = intersection r1 t2
-
- intersection2 | nomatch p1 p2 m2 = Nil
- | zero p1 m2 = intersection t1 l2
- | otherwise = intersection t1 r2
-
-intersection t1@(Tip k _) t2
- | member k t2 = t1
- | otherwise = Nil
-intersection t (Tip k _)
- = case lookup k t of
- Just y -> Tip k y
- Nothing -> Nil
-intersection Nil _ = Nil
-intersection _ Nil = Nil
-
--- | /O(n+m)/. The intersection with a combining function.
---
--- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
-
-intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
-intersectionWith f m1 m2
- = intersectionWithKey (\_ x y -> f x y) m1 m2
-
--- | /O(n+m)/. The intersection with a combining function.
---
--- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
--- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
-
-intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
-intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
- | shorter m1 m2 = intersection1
- | shorter m2 m1 = intersection2
- | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
- | otherwise = Nil
- where
- intersection1 | nomatch p2 p1 m1 = Nil
- | zero p2 m1 = intersectionWithKey f l1 t2
- | otherwise = intersectionWithKey f r1 t2
-
- intersection2 | nomatch p1 p2 m2 = Nil
- | zero p1 m2 = intersectionWithKey f t1 l2
- | otherwise = intersectionWithKey f t1 r2
-
-intersectionWithKey f (Tip k x) t2
- = case lookup k t2 of
- Just y -> Tip k (f k x y)
- Nothing -> Nil
-intersectionWithKey f t1 (Tip k y)
- = case lookup k t1 of
- Just x -> Tip k (f k x y)
- Nothing -> Nil
-intersectionWithKey _ Nil _ = Nil
-intersectionWithKey _ _ Nil = Nil
-
-
-{--------------------------------------------------------------------
- Min\/Max
---------------------------------------------------------------------}
-
--- | /O(log n)/. Update the value at the minimal key.
---
--- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
--- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-
-updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMinWithKey f t
- = case t of
- Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
- Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
- Tip k y -> Tip k (f k y)
- Nil -> error "maxView: empty map has no maximal element"
-
-updateMinWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMinWithKeyUnsigned f t
- = case t of
- Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
- Tip k y -> Tip k (f k y)
- Nil -> error "updateMinWithKeyUnsigned Nil"
-
--- | /O(log n)/. Update the value at the maximal key.
---
--- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
--- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-
-updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMaxWithKey f t
- = case t of
- Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
- Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
- Tip k y -> Tip k (f k y)
- Nil -> error "maxView: empty map has no maximal element"
-
-updateMaxWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMaxWithKeyUnsigned f t
- = case t of
- Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
- Tip k y -> Tip k (f k y)
- Nil -> error "updateMaxWithKeyUnsigned Nil"
-
-
--- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
--- the map stripped of that element, or 'Nothing' if passed an empty map.
---
--- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
--- > maxViewWithKey empty == Nothing
-
-maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
-maxViewWithKey t
- = case t of
- Bin p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in Just (result, bin p m t' r)
- Bin p m l r -> let (result, t') = maxViewUnsigned r in Just (result, bin p m l t')
- Tip k y -> Just ((k,y), Nil)
- Nil -> Nothing
-
-maxViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
-maxViewUnsigned t
- = case t of
- Bin p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
- Tip k y -> ((k,y), Nil)
- Nil -> error "maxViewUnsigned Nil"
-
--- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and
--- the map stripped of that element, or 'Nothing' if passed an empty map.
---
--- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
--- > minViewWithKey empty == Nothing
-
-minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
-minViewWithKey t
- = case t of
- Bin p m l r | m < 0 -> let (result, t') = minViewUnsigned r in Just (result, bin p m l t')
- Bin p m l r -> let (result, t') = minViewUnsigned l in Just (result, bin p m t' r)
- Tip k y -> Just ((k,y),Nil)
- Nil -> Nothing
-
-minViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
-minViewUnsigned t
- = case t of
- Bin p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
- Tip k y -> ((k,y),Nil)
- Nil -> error "minViewUnsigned Nil"
-
-
--- | /O(log n)/. Update the value at the maximal key.
---
--- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
--- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-
-updateMax :: (a -> a) -> IntMap a -> IntMap a
-updateMax f = updateMaxWithKey (const f)
-
--- | /O(log n)/. Update the value at the minimal key.
---
--- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
--- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-
-updateMin :: (a -> a) -> IntMap a -> IntMap a
-updateMin f = updateMinWithKey (const f)
-
--- Similar to the Arrow instance.
-first :: (a -> c) -> (a, b) -> (c, b)
-first f (x,y) = (f x,y)
-
--- | /O(log n)/. Retrieves the maximal key of the map, and the map
--- stripped of that element, or 'Nothing' if passed an empty map.
-maxView :: IntMap a -> Maybe (a, IntMap a)
-maxView t = liftM (first snd) (maxViewWithKey t)
-
--- | /O(log n)/. Retrieves the minimal key of the map, and the map
--- stripped of that element, or 'Nothing' if passed an empty map.
-minView :: IntMap a -> Maybe (a, IntMap a)
-minView t = liftM (first snd) (minViewWithKey t)
-
--- | /O(log n)/. Delete and find the maximal element.
-deleteFindMax :: IntMap a -> (a, IntMap a)
-deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxView
-
--- | /O(log n)/. Delete and find the minimal element.
-deleteFindMin :: IntMap a -> (a, IntMap a)
-deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minView
-
--- | /O(log n)/. The minimal key of the map.
-findMin :: IntMap a -> (Key, a)
-findMin Nil = error $ "findMin: empty map has no minimal element"
-findMin (Tip k v) = (k,v)
-findMin (Bin _ m l r)
- | m < 0 = go r
- | otherwise = go l
- where go (Tip k v) = (k,v)
- go (Bin _ _ l' _) = go l'
- go Nil = error "findMax Nil"
+insertWithKey' = S.insertWithKey
+{-# INLINE insertWithKey' #-}
+-- {-# DEPRECATED insertWithKey' "Use insertWithKey in Data.IntMap.Strict instead" #-}
--- | /O(log n)/. The maximal key of the map.
-findMax :: IntMap a -> (Key, a)
-findMax Nil = error $ "findMax: empty map has no maximal element"
-findMax (Tip k v) = (k,v)
-findMax (Bin _ m l r)
- | m < 0 = go l
- | otherwise = go r
- where go (Tip k v) = (k,v)
- go (Bin _ _ _ r') = go r'
- go Nil = error "findMax Nil"
-
--- | /O(log n)/. Delete the minimal key. An error is thrown if the IntMap is already empty.
--- Note, this is not the same behavior Map.
-deleteMin :: IntMap a -> IntMap a
-deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView
-
--- | /O(log n)/. Delete the maximal key. An error is thrown if the IntMap is already empty.
--- Note, this is not the same behavior Map.
-deleteMax :: IntMap a -> IntMap a
-deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView
-
-
-{--------------------------------------------------------------------
- Submap
---------------------------------------------------------------------}
--- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
--- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
-isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
-isProperSubmapOf m1 m2
- = isProperSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
- The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
- @m1@ and @m2@ are not equal,
- all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following
- expressions are all 'True':
-
- > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
- > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-
- But the following are all 'False':
-
- > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
- > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
- > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
--}
-isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
-isProperSubmapOfBy predicate t1 t2
- = case submapCmp predicate t1 t2 of
- LT -> True
- _ -> False
-
-submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
-submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- | shorter m1 m2 = GT
- | shorter m2 m1 = submapCmpLt
- | p1 == p2 = submapCmpEq
- | otherwise = GT -- disjoint
- where
- submapCmpLt | nomatch p1 p2 m2 = GT
- | zero p1 m2 = submapCmp predicate t1 l2
- | otherwise = submapCmp predicate t1 r2
- submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of
- (GT,_ ) -> GT
- (_ ,GT) -> GT
- (EQ,EQ) -> EQ
- _ -> LT
-
-submapCmp _ (Bin _ _ _ _) _ = GT
-submapCmp predicate (Tip kx x) (Tip ky y)
- | (kx == ky) && predicate x y = EQ
- | otherwise = GT -- disjoint
-submapCmp predicate (Tip k x) t
- = case lookup k t of
- Just y | predicate x y -> LT
- _ -> GT -- disjoint
-submapCmp _ Nil Nil = EQ
-submapCmp _ Nil _ = LT
-
--- | /O(n+m)/. Is this a submap?
--- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
-isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
-isSubmapOf m1 m2
- = isSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/.
- The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
- all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following
- expressions are all 'True':
-
- > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
- > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
- > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
-
- But the following are all 'False':
-
- > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
- > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
- > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
--}
-isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
-isSubmapOfBy predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- | shorter m1 m2 = False
- | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy predicate t1 l2
- else isSubmapOfBy predicate t1 r2)
- | otherwise = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2
-isSubmapOfBy _ (Bin _ _ _ _) _ = False
-isSubmapOfBy predicate (Tip k x) t = case lookup k t of
- Just y -> predicate x y
- Nothing -> False
-isSubmapOfBy _ Nil _ = True
-
-{--------------------------------------------------------------------
- Mapping
---------------------------------------------------------------------}
--- | /O(n)/. Map a function over all values in the map.
---
--- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
-
-map :: (a -> b) -> IntMap a -> IntMap b
-map f = mapWithKey (\_ x -> f x)
-
--- | /O(n)/. Map a function over all values in the map.
---
--- > let f key x = (show key) ++ ":" ++ x
--- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
-
-mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
-mapWithKey f t
- = case t of
- Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
- Tip k x -> Tip k (f k x)
- Nil -> Nil
-
--- | /O(n)/. The function @'mapAccum'@ threads an accumulating
--- argument through the map in ascending order of keys.
---
--- > let f a b = (a ++ b, b ++ "X")
--- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
-
-mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
-
--- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
--- argument through the map in ascending order of keys.
---
--- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
--- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
-
-mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumWithKey f a t
- = mapAccumL f a t
-
--- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumL f a t
- = case t of
- Bin p m l r -> let (a1,l') = mapAccumL f a l
- (a2,r') = mapAccumL f a1 r
- in (a2,Bin p m l' r')
- Tip k x -> let (a',x') = f a k x in (a',Tip k x')
- Nil -> (a,Nil)
-
--- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
--- argument through the map in descending order of keys.
-mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumRWithKey f a t
- = case t of
- Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
- (a2,l') = mapAccumRWithKey f a1 l
- in (a2,Bin p m l' r')
- Tip k x -> let (a',x') = f a k x in (a',Tip k x')
- Nil -> (a,Nil)
-
-{--------------------------------------------------------------------
- Filter
---------------------------------------------------------------------}
--- | /O(n)/. Filter all values that satisfy some predicate.
---
--- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
--- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
--- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
-
-filter :: (a -> Bool) -> IntMap a -> IntMap a
-filter p m
- = filterWithKey (\_ x -> p x) m
-
--- | /O(n)/. Filter all keys\/values that satisfy some predicate.
---
--- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-
-filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
-filterWithKey predicate t
- = case t of
- Bin p m l r
- -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
- Tip k x
- | predicate k x -> t
- | otherwise -> Nil
- Nil -> Nil
-
--- | /O(n)/. Partition the map according to some predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
---
--- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
--- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
--- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
-
-partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
-partition p m
- = partitionWithKey (\_ x -> p x) m
-
--- | /O(n)/. Partition the map according to some predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
---
--- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
--- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
--- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
-
-partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
-partitionWithKey predicate t
- = case t of
- Bin p m l r
- -> let (l1,l2) = partitionWithKey predicate l
- (r1,r2) = partitionWithKey predicate r
- in (bin p m l1 r1, bin p m l2 r2)
- Tip k x
- | predicate k x -> (t,Nil)
- | otherwise -> (Nil,t)
- Nil -> (Nil,Nil)
-
--- | /O(n)/. Map values and collect the 'Just' results.
---
--- > let f x = if x == "a" then Just "new a" else Nothing
--- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
-
-mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
-mapMaybe f = mapMaybeWithKey (\_ x -> f x)
-
--- | /O(n)/. Map keys\/values and collect the 'Just' results.
---
--- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
--- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
-
-mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
-mapMaybeWithKey f (Bin p m l r)
- = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
-mapMaybeWithKey f (Tip k x) = case f k x of
- Just y -> Tip k y
- Nothing -> Nil
-mapMaybeWithKey _ Nil = Nil
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
---
--- > let f a = if a < "c" then Left a else Right a
--- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
--- >
--- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-
-mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
-mapEither f m
- = mapEitherWithKey (\_ x -> f x) m
-
--- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
---
--- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
--- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
--- >
--- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
-
-mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
-mapEitherWithKey f (Bin p m l r)
- = (bin p m l1 r1, bin p m l2 r2)
- where
- (l1,l2) = mapEitherWithKey f l
- (r1,r2) = mapEitherWithKey f r
-mapEitherWithKey f (Tip k x) = case f k x of
- Left y -> (Tip k y, Nil)
- Right z -> (Nil, Tip k z)
-mapEitherWithKey _ Nil = (Nil, Nil)
-
--- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
--- where all keys in @map1@ are lower than @k@ and all keys in
--- @map2@ larger than @k at . Any key equal to @k@ is found in neither @map1@ nor @map2 at .
---
--- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
--- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
--- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
--- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
--- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
-
-split :: Key -> IntMap a -> (IntMap a,IntMap a)
-split k t
- = case t of
- Bin _ m l r
- | m < 0 -> (if k >= 0 -- handle negative numbers.
- then let (lt,gt) = split' k l in (union r lt, gt)
- else let (lt,gt) = split' k r in (lt, union gt l))
- | otherwise -> split' k t
- Tip ky _
- | k>ky -> (t,Nil)
- | k<ky -> (Nil,t)
- | otherwise -> (Nil,Nil)
- Nil -> (Nil,Nil)
-
-split' :: Key -> IntMap a -> (IntMap a,IntMap a)
-split' k t
- = case t of
- Bin p m l r
- | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
- | zero k m -> let (lt,gt) = split k l in (lt,union gt r)
- | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
- Tip ky _
- | k>ky -> (t,Nil)
- | k<ky -> (Nil,t)
- | otherwise -> (Nil,Nil)
- Nil -> (Nil,Nil)
-
--- | /O(log n)/. Performs a 'split' but also returns whether the pivot
--- key was found in the original map.
---
--- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
--- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
--- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
--- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
--- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
-
-splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
-splitLookup k t
- = case t of
- Bin _ m l r
- | m < 0 -> (if k >= 0 -- handle negative numbers.
- then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt)
- else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l))
- | otherwise -> splitLookup' k t
- Tip ky y
- | k>ky -> (t,Nothing,Nil)
- | k<ky -> (Nil,Nothing,t)
- | otherwise -> (Nil,Just y,Nil)
- Nil -> (Nil,Nothing,Nil)
-
-splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
-splitLookup' k t
- = case t of
- Bin p m l r
- | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
- | zero k m -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
- | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
- Tip ky y
- | k>ky -> (t,Nothing,Nil)
- | k<ky -> (Nil,Nothing,t)
- | otherwise -> (Nil,Just y,Nil)
- Nil -> (Nil,Nothing,Nil)
-
-{--------------------------------------------------------------------
- Fold
---------------------------------------------------------------------}
-- | /O(n)/. Fold the values in the map using the given right-associative
-- binary operator. This function is an equivalent of 'foldr' and is present
-- for compatibility only.
@@ -1411,72 +212,7 @@ splitLookup' k t
fold :: (a -> b -> b) -> b -> IntMap a -> b
fold = foldr
{-# INLINE fold #-}
-
--- | /O(n)/. Fold the values in the map using the given right-associative
--- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
---
--- For example,
---
--- > elems map = foldr (:) [] map
---
--- > let f a len = len + (length a)
--- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
-foldr :: (a -> b -> b) -> b -> IntMap a -> b
-foldr f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
- where
- go z' Nil = z'
- go z' (Tip _ x) = f x z'
- go z' (Bin _ _ l r) = go (go z' r) l
-{-# INLINE foldr #-}
-
--- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldr' :: (a -> b -> b) -> b -> IntMap a -> b
-foldr' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
- where
- STRICT_1_OF_2(go)
- go z' Nil = z'
- go z' (Tip _ x) = f x z'
- go z' (Bin _ _ l r) = go (go z' r) l
-{-# INLINE foldr' #-}
-
--- | /O(n)/. Fold the values in the map using the given left-associative
--- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
---
--- For example,
---
--- > elems = reverse . foldl (flip (:)) []
---
--- > let f len a = len + (length a)
--- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
-foldl :: (a -> b -> a) -> a -> IntMap b -> a
-foldl f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
- where
- go z' Nil = z'
- go z' (Tip _ x) = f z' x
- go z' (Bin _ _ l r) = go (go z' l) r
-{-# INLINE foldl #-}
-
--- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldl' :: (a -> b -> a) -> a -> IntMap b -> a
-foldl' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
- where
- STRICT_1_OF_2(go)
- go z' Nil = z'
- go z' (Tip _ x) = f z' x
- go z' (Bin _ _ l r) = go (go z' l) r
-{-# INLINE foldl' #-}
+-- {-# DEPRECATED fold "Use foldr instead." #-}
-- | /O(n)/. Fold the keys and values in the map using the given right-associative
-- binary operator. This function is an equivalent of 'foldrWithKey' and is present
@@ -1486,523 +222,4 @@ foldl' f z t =
foldWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
foldWithKey = foldrWithKey
{-# INLINE foldWithKey #-}
-
--- | /O(n)/. Fold the keys and values in the map using the given right-associative
--- binary operator, such that
--- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
---
--- For example,
---
--- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
---
--- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
--- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
-foldrWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
-foldrWithKey f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
- where
- go z' Nil = z'
- go z' (Tip kx x) = f kx x z'
- go z' (Bin _ _ l r) = go (go z' r) l
-{-# INLINE foldrWithKey #-}
-
--- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldrWithKey' :: (Int -> a -> b -> b) -> b -> IntMap a -> b
-foldrWithKey' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
- where
- STRICT_1_OF_2(go)
- go z' Nil = z'
- go z' (Tip kx x) = f kx x z'
- go z' (Bin _ _ l r) = go (go z' r) l
-{-# INLINE foldrWithKey' #-}
-
--- | /O(n)/. Fold the keys and values in the map using the given left-associative
--- binary operator, such that
--- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
---
--- For example,
---
--- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []
---
--- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
--- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
-foldlWithKey :: (a -> Int -> b -> a) -> a -> IntMap b -> a
-foldlWithKey f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
- where
- go z' Nil = z'
- go z' (Tip kx x) = f z' kx x
- go z' (Bin _ _ l r) = go (go z' l) r
-{-# INLINE foldlWithKey #-}
-
--- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldlWithKey' :: (a -> Int -> b -> a) -> a -> IntMap b -> a
-foldlWithKey' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
- where
- STRICT_1_OF_2(go)
- go z' Nil = z'
- go z' (Tip kx x) = f z' kx x
- go z' (Bin _ _ l r) = go (go z' l) r
-{-# INLINE foldlWithKey' #-}
-
-{--------------------------------------------------------------------
- List variations
---------------------------------------------------------------------}
--- | /O(n)/.
--- Return all elements of the map in the ascending order of their keys.
---
--- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
--- > elems empty == []
-
-elems :: IntMap a -> [a]
-elems
- = foldr (:) []
-
--- | /O(n)/. Return all keys of the map in ascending order.
---
--- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
--- > keys empty == []
-
-keys :: IntMap a -> [Key]
-keys
- = foldrWithKey (\k _ ks -> k:ks) []
-
--- | /O(n*min(n,W))/. The set of all keys of the map.
---
--- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5]
--- > keysSet empty == Data.IntSet.empty
-
-keysSet :: IntMap a -> IntSet.IntSet
-keysSet m = IntSet.fromDistinctAscList (keys m)
-
-
--- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
---
--- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
--- > assocs empty == []
-
-assocs :: IntMap a -> [(Key,a)]
-assocs m
- = toList m
-
-
-{--------------------------------------------------------------------
- Lists
---------------------------------------------------------------------}
--- | /O(n)/. Convert the map to a list of key\/value pairs.
---
--- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
--- > toList empty == []
-
-toList :: IntMap a -> [(Key,a)]
-toList
- = foldrWithKey (\k x xs -> (k,x):xs) []
-
--- | /O(n)/. Convert the map to a list of key\/value pairs where the
--- keys are in ascending order.
---
--- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
-
-toAscList :: IntMap a -> [(Key,a)]
-toAscList t
- = -- NOTE: the following algorithm only works for big-endian trees
- let (pos,neg) = span (\(k,_) -> k >=0) (foldrWithKey (\k x xs -> (k,x):xs) [] t) in neg ++ pos
-
--- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
---
--- > fromList [] == empty
--- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
--- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
-
-fromList :: [(Key,a)] -> IntMap a
-fromList xs
- = foldlStrict ins empty xs
- where
- ins t (k,x) = insert k x t
-
--- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
---
--- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
--- > fromListWith (++) [] == empty
-
-fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
-fromListWith f xs
- = fromListWithKey (\_ x y -> f x y) xs
-
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
---
--- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
--- > fromListWith (++) [] == empty
-
-fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
-fromListWithKey f xs
- = foldlStrict ins empty xs
- where
- ins t (k,x) = insertWithKey f k x t
-
--- | /O(n)/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order.
---
--- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
--- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
-
-fromAscList :: [(Key,a)] -> IntMap a
-fromAscList xs
- = fromAscListWithKey (\_ x _ -> x) xs
-
--- | /O(n)/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order, with a combining function on equal keys.
--- /The precondition (input list is ascending) is not checked./
---
--- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
-
-fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
-fromAscListWith f xs
- = fromAscListWithKey (\_ x y -> f x y) xs
-
--- | /O(n)/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order, with a combining function on equal keys.
--- /The precondition (input list is ascending) is not checked./
---
--- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
-
-fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
-fromAscListWithKey _ [] = Nil
-fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
- where
- -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
- combineEq z [] = [z]
- combineEq z@(kz,zz) (x@(kx,xx):xs)
- | kx==kz = let yy = f kx xx zz in combineEq (kx,yy) xs
- | otherwise = z:combineEq x xs
-
--- | /O(n)/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order and all distinct.
--- /The precondition (input list is strictly ascending) is not checked./
---
--- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
-
-#ifdef __GLASGOW_HASKELL__
-fromDistinctAscList :: forall a. [(Key,a)] -> IntMap a
-#else
-fromDistinctAscList :: [(Key,a)] -> IntMap a
-#endif
-fromDistinctAscList [] = Nil
-fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
- where
- work (kx,vx) [] stk = finish kx (Tip kx vx) stk
- work (kx,vx) (z@(kz,_):zs) stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
-
-#ifdef __GLASGOW_HASKELL__
- reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
-#endif
- reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
- reduce z zs m px tx stk@(Push py ty stk') =
- let mxy = branchMask px py
- pxy = mask px mxy
- in if shorter m mxy
- then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
- else work z zs (Push px tx stk)
-
- finish _ t Nada = t
- finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
- where m = branchMask px py
- p = mask px m
-
-data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
-
-
-{--------------------------------------------------------------------
- Eq
---------------------------------------------------------------------}
-instance Eq a => Eq (IntMap a) where
- t1 == t2 = equal t1 t2
- t1 /= t2 = nequal t1 t2
-
-equal :: Eq a => IntMap a -> IntMap a -> Bool
-equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
-equal (Tip kx x) (Tip ky y)
- = (kx == ky) && (x==y)
-equal Nil Nil = True
-equal _ _ = False
-
-nequal :: Eq a => IntMap a -> IntMap a -> Bool
-nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
-nequal (Tip kx x) (Tip ky y)
- = (kx /= ky) || (x/=y)
-nequal Nil Nil = False
-nequal _ _ = True
-
-{--------------------------------------------------------------------
- Ord
---------------------------------------------------------------------}
-
-instance Ord a => Ord (IntMap a) where
- compare m1 m2 = compare (toList m1) (toList m2)
-
-{--------------------------------------------------------------------
- Functor
---------------------------------------------------------------------}
-
-instance Functor IntMap where
- fmap = map
-
-{--------------------------------------------------------------------
- Show
---------------------------------------------------------------------}
-
-instance Show a => Show (IntMap a) where
- showsPrec d m = showParen (d > 10) $
- showString "fromList " . shows (toList m)
-
-{-
-XXX unused code
-
-showMap :: (Show a) => [(Key,a)] -> ShowS
-showMap []
- = showString "{}"
-showMap (x:xs)
- = showChar '{' . showElem x . showTail xs
- where
- showTail [] = showChar '}'
- showTail (x':xs') = showChar ',' . showElem x' . showTail xs'
-
- showElem (k,v) = shows k . showString ":=" . shows v
--}
-
-{--------------------------------------------------------------------
- Read
---------------------------------------------------------------------}
-instance (Read e) => Read (IntMap e) where
-#ifdef __GLASGOW_HASKELL__
- readPrec = parens $ prec 10 $ do
- Ident "fromList" <- lexP
- xs <- readPrec
- return (fromList xs)
-
- readListPrec = readListPrecDefault
-#else
- readsPrec p = readParen (p > 10) $ \ r -> do
- ("fromList",s) <- lex r
- (xs,t) <- reads s
- return (fromList xs,t)
-#endif
-
-{--------------------------------------------------------------------
- Typeable
---------------------------------------------------------------------}
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
-
-{--------------------------------------------------------------------
- Debugging
---------------------------------------------------------------------}
--- | /O(n)/. Show the tree that implements the map. The tree is shown
--- in a compressed, hanging format.
-showTree :: Show a => IntMap a -> String
-showTree s
- = showTreeWith True False s
-
-
-{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
- the tree that implements the map. If @hang@ is
- 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
- @wide@ is 'True', an extra wide version is shown.
--}
-showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
-showTreeWith hang wide t
- | hang = (showsTreeHang wide [] t) ""
- | otherwise = (showsTree wide [] [] t) ""
-
-showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
-showsTree wide lbars rbars t
- = case t of
- Bin p m l r
- -> showsTree wide (withBar rbars) (withEmpty rbars) r .
- showWide wide rbars .
- showsBars lbars . showString (showBin p m) . showString "\n" .
- showWide wide lbars .
- showsTree wide (withEmpty lbars) (withBar lbars) l
- Tip k x
- -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
- Nil -> showsBars lbars . showString "|\n"
-
-showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
-showsTreeHang wide bars t
- = case t of
- Bin p m l r
- -> showsBars bars . showString (showBin p m) . showString "\n" .
- showWide wide bars .
- showsTreeHang wide (withBar bars) l .
- showWide wide bars .
- showsTreeHang wide (withEmpty bars) r
- Tip k x
- -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
- Nil -> showsBars bars . showString "|\n"
-
-showBin :: Prefix -> Mask -> String
-showBin _ _
- = "*" -- ++ show (p,m)
-
-showWide :: Bool -> [String] -> String -> String
-showWide wide bars
- | wide = showString (concat (reverse bars)) . showString "|\n"
- | otherwise = id
-
-showsBars :: [String] -> ShowS
-showsBars bars
- = case bars of
- [] -> id
- _ -> showString (concat (reverse (tail bars))) . showString node
-
-node :: String
-node = "+--"
-
-withBar, withEmpty :: [String] -> [String]
-withBar bars = "| ":bars
-withEmpty bars = " ":bars
-
-
-{--------------------------------------------------------------------
- Helpers
---------------------------------------------------------------------}
-{--------------------------------------------------------------------
- Join
---------------------------------------------------------------------}
-join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
-join p1 t1 p2 t2
- | zero p1 m = Bin p m t1 t2
- | otherwise = Bin p m t2 t1
- where
- m = branchMask p1 p2
- p = mask p1 m
-{-# INLINE join #-}
-
-{--------------------------------------------------------------------
- @bin@ assures that we never have empty trees within a tree.
---------------------------------------------------------------------}
-bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
-bin _ _ l Nil = l
-bin _ _ Nil r = r
-bin p m l r = Bin p m l r
-{-# INLINE bin #-}
-
-
-{--------------------------------------------------------------------
- Endian independent bit twiddling
---------------------------------------------------------------------}
-zero :: Key -> Mask -> Bool
-zero i m
- = (natFromInt i) .&. (natFromInt m) == 0
-{-# INLINE zero #-}
-
-nomatch,match :: Key -> Prefix -> Mask -> Bool
-nomatch i p m
- = (mask i m) /= p
-{-# INLINE nomatch #-}
-
-match i p m
- = (mask i m) == p
-{-# INLINE match #-}
-
-mask :: Key -> Mask -> Prefix
-mask i m
- = maskW (natFromInt i) (natFromInt m)
-{-# INLINE mask #-}
-
-
-{--------------------------------------------------------------------
- Big endian operations
---------------------------------------------------------------------}
-maskW :: Nat -> Nat -> Prefix
-maskW i m
- = intFromNat (i .&. (complement (m-1) `xor` m))
-{-# INLINE maskW #-}
-
-shorter :: Mask -> Mask -> Bool
-shorter m1 m2
- = (natFromInt m1) > (natFromInt m2)
-{-# INLINE shorter #-}
-
-branchMask :: Prefix -> Prefix -> Mask
-branchMask p1 p2
- = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
-{-# INLINE branchMask #-}
-
-{----------------------------------------------------------------------
- Finding the highest bit (mask) in a word [x] can be done efficiently in
- three ways:
- * convert to a floating point value and the mantissa tells us the
- [log2(x)] that corresponds with the highest bit position. The mantissa
- is retrieved either via the standard C function [frexp] or by some bit
- twiddling on IEEE compatible numbers (float). Note that one needs to
- use at least [double] precision for an accurate mantissa of 32 bit
- numbers.
- * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
- * use processor specific assembler instruction (asm).
-
- The most portable way would be [bit], but is it efficient enough?
- I have measured the cycle counts of the different methods on an AMD
- Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
-
- highestBitMask: method cycles
- --------------
- frexp 200
- float 33
- bit 11
- asm 12
-
- highestBit: method cycles
- --------------
- frexp 195
- float 33
- bit 11
- asm 11
-
- Wow, the bit twiddling is on today's RISC like machines even faster
- than a single CISC instruction (BSR)!
-----------------------------------------------------------------------}
-
-{----------------------------------------------------------------------
- [highestBitMask] returns a word where only the highest bit is set.
- It is found by first setting all bits in lower positions than the
- highest bit and than taking an exclusive or with the original value.
- Allthough the function may look expensive, GHC compiles this into
- excellent C code that subsequently compiled into highly efficient
- machine code. The algorithm is derived from Jorg Arndt's FXT library.
-----------------------------------------------------------------------}
-highestBitMask :: Nat -> Nat
-highestBitMask x0
- = case (x0 .|. shiftRL x0 1) of
- x1 -> case (x1 .|. shiftRL x1 2) of
- x2 -> case (x2 .|. shiftRL x2 4) of
- x3 -> case (x3 .|. shiftRL x3 8) of
- x4 -> case (x4 .|. shiftRL x4 16) of
- x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms
- x6 -> (x6 `xor` (shiftRL x6 1))
-{-# INLINE highestBitMask #-}
-
-
-{--------------------------------------------------------------------
- Utilities
---------------------------------------------------------------------}
-
-foldlStrict :: (a -> b -> a) -> a -> [b] -> a
-foldlStrict f = go
- where
- go z [] = z
- go z (x:xs) = let z' = f z x in z' `seq` go z' xs
-{-# INLINE foldlStrict #-}
+-- {-# DEPRECATED foldWithKey "Use foldrWithKey instead." #-}
diff --git a/Data/IntMap/Common.hs b/Data/IntMap/Common.hs
new file mode 100644
index 0000000..a61dc51
--- /dev/null
+++ b/Data/IntMap/Common.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE CPP, NoBangPatterns, MagicHash, ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.IntMap.Common
+-- Copyright : (c) Daan Leijen 2002
+-- (c) Andriy Palamarchuk 2008
+-- License : BSD-style
+-- Maintainer : libraries at haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- An efficient implementation of maps from integer keys to values.
+--
+-- The implementation is based on /big-endian patricia trees/. This data
+-- structure performs especially well on binary operations like 'union'
+-- and 'intersection'. However, my benchmarks show that it is also
+-- (much) faster on insertions and deletions when compared to a generic
+-- size-balanced map implementation (see "Data.Map").
+--
+-- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
+-- Workshop on ML, September 1998, pages 77-86,
+-- <http://citeseer.ist.psu.edu/okasaki98fast.html>
+--
+-- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
+-- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
+-- October 1968, pages 514-534.
+--
+-- This defines the data structures and core (hidden) manipulations
+-- on representations.
+-----------------------------------------------------------------------------
+
+-- It is essential that the bit fiddling functions like mask, zero, branchMask
+-- etc are inlined. If they do not, the memory allocation skyrockets. The GHC
+-- usually gets it right, but it is disastrous if it does not. Therefore we
+-- explicitly mark these functions INLINE.
+
+module Data.IntMap.Common (
+ -- * Map type
+ IntMap(..), Key -- instance Eq,Show
+
+ -- * Internal types
+ , Mask, Prefix, Nat
+
+ -- * Utility
+ , natFromInt
+ , intFromNat
+ , shiftRL
+ , join
+ , bin
+ , zero
+ , nomatch
+ , match
+ , mask
+ , maskW
+ , shorter
+ , branchMask
+ , highestBitMask
+ , foldlStrict
+ ) where
+
+import Prelude hiding (lookup,map,filter,foldr,foldl,null)
+import Data.Bits
+
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts ( Word(..), Int(..), shiftRL# )
+#elif __GLASGOW_HASKELL__
+import Word
+import GlaExts ( Word(..), Int(..), shiftRL# )
+#else
+import Data.Word
+#endif
+
+-- A "Nat" is a natural machine word (an unsigned Int)
+type Nat = Word
+
+natFromInt :: Key -> Nat
+natFromInt = fromIntegral
+{-# INLINE natFromInt #-}
+
+intFromNat :: Nat -> Key
+intFromNat = fromIntegral
+{-# INLINE intFromNat #-}
+
+shiftRL :: Nat -> Key -> Nat
+#if __GLASGOW_HASKELL__
+{--------------------------------------------------------------------
+ GHC: use unboxing to get @shiftRL@ inlined.
+--------------------------------------------------------------------}
+shiftRL (W# x) (I# i)
+ = W# (shiftRL# x i)
+#else
+shiftRL x i = shiftR x i
+{-# INLINE shiftRL #-}
+#endif
+
+{--------------------------------------------------------------------
+ Types
+--------------------------------------------------------------------}
+
+-- The order of constructors of IntMap matters when considering performance.
+-- Currently in GHC 7.0, when type has 3 constructors, they are matched from
+-- the first to the last -- the best performance is achieved when the
+-- constructors are ordered by frequency.
+-- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil
+-- improves the containers_benchmark by 9.5% on x86 and by 8% on x86_64.
+
+-- | A map of integers to values @a at .
+data IntMap a = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a)
+ | Tip {-# UNPACK #-} !Key a
+ | Nil
+
+type Prefix = Int
+type Mask = Int
+type Key = Int
+
+{--------------------------------------------------------------------
+ Helpers
+--------------------------------------------------------------------}
+{--------------------------------------------------------------------
+ Join
+--------------------------------------------------------------------}
+join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
+join p1 t1 p2 t2
+ | zero p1 m = Bin p m t1 t2
+ | otherwise = Bin p m t2 t1
+ where
+ m = branchMask p1 p2
+ p = mask p1 m
+{-# INLINE join #-}
+
+{--------------------------------------------------------------------
+ @bin@ assures that we never have empty trees within a tree.
+--------------------------------------------------------------------}
+bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
+bin _ _ l Nil = l
+bin _ _ Nil r = r
+bin p m l r = Bin p m l r
+{-# INLINE bin #-}
+
+
+{--------------------------------------------------------------------
+ Endian independent bit twiddling
+--------------------------------------------------------------------}
+zero :: Key -> Mask -> Bool
+zero i m
+ = (natFromInt i) .&. (natFromInt m) == 0
+{-# INLINE zero #-}
+
+nomatch,match :: Key -> Prefix -> Mask -> Bool
+nomatch i p m
+ = (mask i m) /= p
+{-# INLINE nomatch #-}
+
+match i p m
+ = (mask i m) == p
+{-# INLINE match #-}
+
+mask :: Key -> Mask -> Prefix
+mask i m
+ = maskW (natFromInt i) (natFromInt m)
+{-# INLINE mask #-}
+
+
+{--------------------------------------------------------------------
+ Big endian operations
+--------------------------------------------------------------------}
+maskW :: Nat -> Nat -> Prefix
+maskW i m
+ = intFromNat (i .&. (complement (m-1) `xor` m))
+{-# INLINE maskW #-}
+
+shorter :: Mask -> Mask -> Bool
+shorter m1 m2
+ = (natFromInt m1) > (natFromInt m2)
+{-# INLINE shorter #-}
+
+branchMask :: Prefix -> Prefix -> Mask
+branchMask p1 p2
+ = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
+{-# INLINE branchMask #-}
+
+{----------------------------------------------------------------------
+ Finding the highest bit (mask) in a word [x] can be done efficiently in
+ three ways:
+ * convert to a floating point value and the mantissa tells us the
+ [log2(x)] that corresponds with the highest bit position. The mantissa
+ is retrieved either via the standard C function [frexp] or by some bit
+ twiddling on IEEE compatible numbers (float). Note that one needs to
+ use at least [double] precision for an accurate mantissa of 32 bit
+ numbers.
+ * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
+ * use processor specific assembler instruction (asm).
+
+ The most portable way would be [bit], but is it efficient enough?
+ I have measured the cycle counts of the different methods on an AMD
+ Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
+
+ highestBitMask: method cycles
+ --------------
+ frexp 200
+ float 33
+ bit 11
+ asm 12
+
+ highestBit: method cycles
+ --------------
+ frexp 195
+ float 33
+ bit 11
+ asm 11
+
+ Wow, the bit twiddling is on today's RISC like machines even faster
+ than a single CISC instruction (BSR)!
+----------------------------------------------------------------------}
+
+{----------------------------------------------------------------------
+ [highestBitMask] returns a word where only the highest bit is set.
+ It is found by first setting all bits in lower positions than the
+ highest bit and than taking an exclusive or with the original value.
+ Allthough the function may look expensive, GHC compiles this into
+ excellent C code that subsequently compiled into highly efficient
+ machine code. The algorithm is derived from Jorg Arndt's FXT library.
+----------------------------------------------------------------------}
+highestBitMask :: Nat -> Nat
+highestBitMask x0
+ = case (x0 .|. shiftRL x0 1) of
+ x1 -> case (x1 .|. shiftRL x1 2) of
+ x2 -> case (x2 .|. shiftRL x2 4) of
+ x3 -> case (x3 .|. shiftRL x3 8) of
+ x4 -> case (x4 .|. shiftRL x4 16) of
+ x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms
+ x6 -> (x6 `xor` (shiftRL x6 1))
+{-# INLINE highestBitMask #-}
+
+
+{--------------------------------------------------------------------
+ Utilities
+--------------------------------------------------------------------}
+
+foldlStrict :: (a -> b -> a) -> a -> [b] -> a
+foldlStrict f = go
+ where
+ go z [] = z
+ go z (x:xs) = let z' = f z x in z' `seq` go z' xs
+{-# INLINE foldlStrict #-}
diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs
new file mode 100644
index 0000000..efe6d8e
--- /dev/null
+++ b/Data/IntMap/Lazy.hs
@@ -0,0 +1,1783 @@
+{-# LANGUAGE CPP, NoBangPatterns, MagicHash, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.IntMap.Lazy
+-- Copyright : (c) Daan Leijen 2002
+-- (c) Andriy Palamarchuk 2008
+-- License : BSD-style
+-- Maintainer : libraries at haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- An efficient implementation of maps from integer keys to lazy values.
+--
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
+--
+-- > import Data.IntMap (IntMap)
+-- > import qualified Data.IntMap as IntMap
+--
+-- The implementation is based on /big-endian patricia trees/. This data
+-- structure performs especially well on binary operations like 'union'
+-- and 'intersection'. However, my benchmarks show that it is also
+-- (much) faster on insertions and deletions when compared to a generic
+-- size-balanced map implementation (see "Data.Map").
+--
+-- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
+-- Workshop on ML, September 1998, pages 77-86,
+-- <http://citeseer.ist.psu.edu/okasaki98fast.html>
+--
+-- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
+-- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
+-- October 1968, pages 514-534.
+--
+-- Operation comments contain the operation time complexity in
+-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.
+-- Many operations have a worst-case complexity of /O(min(n,W))/.
+-- This means that the operation can become linear in the number of
+-- elements with a maximum of /W/ -- the number of bits in an 'Int'
+-- (32 or 64).
+--
+-- If you need value-strict maps, try "Data.IntMap.Strict" instead.
+-----------------------------------------------------------------------------
+
+module Data.IntMap.Lazy (
+ -- * Map type
+#if !defined(TESTING)
+ IntMap, Key -- instance Eq,Show
+#else
+ IntMap(..), Key -- instance Eq,Show
+#endif
+
+ -- * Operators
+ , (!), (\\)
+
+ -- * Query
+ , null
+ , size
+ , member
+ , notMember
+ , lookup
+ , findWithDefault
+
+ -- * Construction
+ , empty
+ , singleton
+
+ -- ** Insertion
+ , insert
+ , insertWith
+ , insertWithKey
+ , insertLookupWithKey
+
+ -- ** Delete\/Update
+ , delete
+ , adjust
+ , adjustWithKey
+ , update
+ , updateWithKey
+ , updateLookupWithKey
+ , alter
+
+ -- * Combine
+
+ -- ** Union
+ , union
+ , unionWith
+ , unionWithKey
+ , unions
+ , unionsWith
+
+ -- ** Difference
+ , difference
+ , differenceWith
+ , differenceWithKey
+
+ -- ** Intersection
+ , intersection
+ , intersectionWith
+ , intersectionWithKey
+
+ -- * Traversal
+ -- ** Map
+ , map
+ , mapWithKey
+ , mapAccum
+ , mapAccumWithKey
+ , mapAccumRWithKey
+
+ -- * Folds
+ , foldr
+ , foldl
+ , foldrWithKey
+ , foldlWithKey
+ -- ** Strict folds
+ , foldr'
+ , foldl'
+ , foldrWithKey'
+ , foldlWithKey'
+
+ -- * Conversion
+ , elems
+ , keys
+ , keysSet
+ , assocs
+
+ -- ** Lists
+ , toList
+ , fromList
+ , fromListWith
+ , fromListWithKey
+
+ -- ** Ordered lists
+ , toAscList
+ , fromAscList
+ , fromAscListWith
+ , fromAscListWithKey
+ , fromDistinctAscList
+
+ -- * Filter
+ , filter
+ , filterWithKey
+ , partition
+ , partitionWithKey
+
+ , mapMaybe
+ , mapMaybeWithKey
+ , mapEither
+ , mapEitherWithKey
+
+ , split
+ , splitLookup
+
+ -- * Submap
+ , isSubmapOf, isSubmapOfBy
+ , isProperSubmapOf, isProperSubmapOfBy
+
+ -- * Min\/Max
+ , findMin
+ , findMax
+ , deleteMin
+ , deleteMax
+ , deleteFindMin
+ , deleteFindMax
+ , updateMin
+ , updateMax
+ , updateMinWithKey
+ , updateMaxWithKey
+ , minView
+ , maxView
+ , minViewWithKey
+ , maxViewWithKey
+
+ -- * Debugging
+ , showTree
+ , showTreeWith
+ ) where
+
+import Prelude hiding (lookup,map,filter,foldr,foldl,null)
+import qualified Data.IntSet as IntSet
+import Data.Monoid (Monoid(..))
+import Data.Maybe (fromMaybe)
+import Data.Typeable
+import qualified Data.Foldable as Foldable
+import Data.Traversable (Traversable(traverse))
+import Control.Applicative (Applicative(pure,(<*>)),(<$>))
+import Control.Monad ( liftM )
+import Control.DeepSeq (NFData(rnf))
+{-
+-- just for testing
+import qualified Prelude
+import Test.QuickCheck
+import List (nub,sort)
+import qualified List
+-}
+
+#if __GLASGOW_HASKELL__
+import Text.Read
+import Data.Data (Data(..), mkNoRepType)
+#endif
+
+import Data.IntMap.Common
+
+-- Use macros to define strictness of functions.
+-- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
+-- We do not use BangPatterns, because they are not in any standard and we
+-- want the compilers to be compiled by as many compilers as possible.
+#define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
+
+infixl 9 \\{-This comment teaches CPP correct behaviour -}
+
+{--------------------------------------------------------------------
+ Operators
+--------------------------------------------------------------------}
+
+-- | /O(min(n,W))/. Find the value at a key.
+-- Calls 'error' when the element can not be found.
+--
+-- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
+-- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
+
+(!) :: IntMap a -> Key -> a
+m ! k = find k m
+
+-- | Same as 'difference'.
+(\\) :: IntMap a -> IntMap b -> IntMap a
+m1 \\ m2 = difference m1 m2
+
+{--------------------------------------------------------------------
+ Types
+--------------------------------------------------------------------}
+
+instance Monoid (IntMap a) where
+ mempty = empty
+ mappend = union
+ mconcat = unions
+
+instance Foldable.Foldable IntMap where
+ fold Nil = mempty
+ fold (Tip _ v) = v
+ fold (Bin _ _ l r) = Foldable.fold l `mappend` Foldable.fold r
+ foldr = foldr
+ foldl = foldl
+ foldMap _ Nil = mempty
+ foldMap f (Tip _k v) = f v
+ foldMap f (Bin _ _ l r) = Foldable.foldMap f l `mappend` Foldable.foldMap f r
+
+instance Traversable IntMap where
+ traverse _ Nil = pure Nil
+ traverse f (Tip k v) = Tip k <$> f v
+ traverse f (Bin p m l r) = Bin p m <$> traverse f l <*> traverse f r
+
+instance NFData a => NFData (IntMap a) where
+ rnf Nil = ()
+ rnf (Tip _ v) = rnf v
+ rnf (Bin _ _ l r) = rnf l `seq` rnf r
+
+#if __GLASGOW_HASKELL__
+
+{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance Data a => Data (IntMap a) where
+ gfoldl f z im = z fromList `f` (toList im)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Data.IntMap.IntMap"
+ dataCast1 f = gcast1 f
+
+#endif
+
+{--------------------------------------------------------------------
+ Query
+--------------------------------------------------------------------}
+-- | /O(1)/. Is the map empty?
+--
+-- > Data.IntMap.null (empty) == True
+-- > Data.IntMap.null (singleton 1 'a') == False
+
+null :: IntMap a -> Bool
+null Nil = True
+null _ = False
+
+-- | /O(n)/. Number of elements in the map.
+--
+-- > size empty == 0
+-- > size (singleton 1 'a') == 1
+-- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3
+size :: IntMap a -> Int
+size t
+ = case t of
+ Bin _ _ l r -> size l + size r
+ Tip _ _ -> 1
+ Nil -> 0
+
+-- | /O(min(n,W))/. Is the key a member of the map?
+--
+-- > member 5 (fromList [(5,'a'), (3,'b')]) == True
+-- > member 1 (fromList [(5,'a'), (3,'b')]) == False
+
+member :: Key -> IntMap a -> Bool
+member k m
+ = case lookup k m of
+ Nothing -> False
+ Just _ -> True
+
+-- | /O(log n)/. Is the key not a member of the map?
+--
+-- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
+-- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
+
+notMember :: Key -> IntMap a -> Bool
+notMember k m = not $ member k m
+
+-- The 'go' function in the lookup causes 10% speedup, but also an increased
+-- memory allocation. It does not cause speedup with other methods like insert
+-- and delete, so it is present only in lookup.
+
+-- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.
+lookup :: Key -> IntMap a -> Maybe a
+lookup k = k `seq` go
+ where
+ go (Bin _ m l r)
+ | zero k m = go l
+ | otherwise = go r
+ go (Tip kx x)
+ | k == kx = Just x
+ | otherwise = Nothing
+ go Nil = Nothing
+
+
+find :: Key -> IntMap a -> a
+find k m
+ = case lookup k m of
+ Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
+ Just x -> x
+
+-- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
+-- returns the value at key @k@ or returns @def@ when the key is not an
+-- element of the map.
+--
+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
+
+findWithDefault :: a -> Key -> IntMap a -> a
+findWithDefault def k m
+ = case lookup k m of
+ Nothing -> def
+ Just x -> x
+
+{--------------------------------------------------------------------
+ Construction
+--------------------------------------------------------------------}
+-- | /O(1)/. The empty map.
+--
+-- > empty == fromList []
+-- > size empty == 0
+
+empty :: IntMap a
+empty
+ = Nil
+
+-- | /O(1)/. A map of one element.
+--
+-- > singleton 1 'a' == fromList [(1, 'a')]
+-- > size (singleton 1 'a') == 1
+
+singleton :: Key -> a -> IntMap a
+singleton k x
+ = Tip k x
+
+{--------------------------------------------------------------------
+ Insert
+--------------------------------------------------------------------}
+-- | /O(min(n,W))/. Insert a new key\/value pair in the map.
+-- If the key is already present in the map, the associated value is
+-- replaced with the supplied value, i.e. 'insert' is equivalent to
+-- @'insertWith' 'const'@.
+--
+-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
+-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
+-- > insert 5 'x' empty == singleton 5 'x'
+
+insert :: Key -> a -> IntMap a -> IntMap a
+insert k x t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> join k (Tip k x) p t
+ | zero k m -> Bin p m (insert k x l) r
+ | otherwise -> Bin p m l (insert k x r)
+ Tip ky _
+ | k==ky -> Tip k x
+ | otherwise -> join k (Tip k x) ky t
+ Nil -> Tip k x
+
+-- right-biased insertion, used by 'union'
+-- | /O(min(n,W))/. Insert with a combining function.
+-- @'insertWith' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert @f new_value old_value at .
+--
+-- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
+-- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
+
+insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+insertWith f k x t
+ = insertWithKey (\_ x' y' -> f x' y') k x t
+
+-- | /O(min(n,W))/. Insert with a combining function.
+-- @'insertWithKey' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert @f key new_value old_value at .
+--
+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
+-- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
+
+insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+insertWithKey f k x t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> join k (Tip k x) p t
+ | zero k m -> Bin p m (insertWithKey f k x l) r
+ | otherwise -> Bin p m l (insertWithKey f k x r)
+ Tip ky y
+ | k==ky -> Tip k (f k x y)
+ | otherwise -> join k (Tip k x) ky t
+ Nil -> Tip k x
+
+-- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
+-- is a pair where the first element is equal to (@'lookup' k map@)
+-- and the second element equal to (@'insertWithKey' f k x map@).
+--
+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+-- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+-- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
+--
+-- This is how to define @insertLookup@ using @insertLookupWithKey@:
+--
+-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
+-- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
+-- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
+
+insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
+insertLookupWithKey f k x t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> (Nothing,join k (Tip k x) p t)
+ | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
+ | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
+ Tip ky y
+ | k==ky -> (Just y,Tip k (f k x y))
+ | otherwise -> (Nothing,join k (Tip k x) ky t)
+ Nil -> (Nothing,Tip k x)
+
+
+{--------------------------------------------------------------------
+ Deletion
+ [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
+--------------------------------------------------------------------}
+-- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
+-- a member of the map, the original map is returned.
+--
+-- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+-- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > delete 5 empty == empty
+
+delete :: Key -> IntMap a -> IntMap a
+delete k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> t
+ | zero k m -> bin p m (delete k l) r
+ | otherwise -> bin p m l (delete k r)
+ Tip ky _
+ | k==ky -> Nil
+ | otherwise -> t
+ Nil -> Nil
+
+-- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
+-- a member of the map, the original map is returned.
+--
+-- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
+-- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > adjust ("new " ++) 7 empty == empty
+
+adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
+adjust f k m
+ = adjustWithKey (\_ x -> f x) k m
+
+-- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
+-- a member of the map, the original map is returned.
+--
+-- > let f key x = (show key) ++ ":new " ++ x
+-- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
+-- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > adjustWithKey f 7 empty == empty
+
+adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
+adjustWithKey f
+ = updateWithKey (\k' x -> Just (f k' x))
+
+-- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
+-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
+--
+-- > let f x = if x == "a" then Just "new a" else Nothing
+-- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
+-- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
+update f
+ = updateWithKey (\_ x -> f x)
+
+-- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
+-- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
+--
+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+-- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
+-- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
+updateWithKey f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> t
+ | zero k m -> bin p m (updateWithKey f k l) r
+ | otherwise -> bin p m l (updateWithKey f k r)
+ Tip ky y
+ | k==ky -> case (f k y) of
+ Just y' -> Tip ky y'
+ Nothing -> Nil
+ | otherwise -> t
+ Nil -> Nil
+
+-- | /O(min(n,W))/. Lookup and update.
+-- The function returns original value, if it is updated.
+-- This is different behavior than 'Data.Map.updateLookupWithKey'.
+-- Returns the original key value if the map entry is deleted.
+--
+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+-- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])
+-- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
+-- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
+
+updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
+updateLookupWithKey f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> (Nothing,t)
+ | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
+ | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
+ Tip ky y
+ | k==ky -> case (f k y) of
+ Just y' -> (Just y,Tip ky y')
+ Nothing -> (Just y,Nil)
+ | otherwise -> (Nothing,t)
+ Nil -> (Nothing,Nil)
+
+
+
+-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
+alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
+alter f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> case f Nothing of
+ Nothing -> t
+ Just x -> join k (Tip k x) p t
+ | zero k m -> bin p m (alter f k l) r
+ | otherwise -> bin p m l (alter f k r)
+ Tip ky y
+ | k==ky -> case f (Just y) of
+ Just x -> Tip ky x
+ Nothing -> Nil
+ | otherwise -> case f Nothing of
+ Just x -> join k (Tip k x) ky t
+ Nothing -> Tip ky y
+ Nil -> case f Nothing of
+ Just x -> Tip k x
+ Nothing -> Nil
+
+
+{--------------------------------------------------------------------
+ Union
+--------------------------------------------------------------------}
+-- | The union of a list of maps.
+--
+-- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+-- > == fromList [(3, "b"), (5, "a"), (7, "C")]
+-- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
+-- > == fromList [(3, "B3"), (5, "A3"), (7, "C")]
+
+unions :: [IntMap a] -> IntMap a
+unions xs
+ = foldlStrict union empty xs
+
+-- | The union of a list of maps, with a combining operation.
+--
+-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+-- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
+
+unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
+unionsWith f ts
+ = foldlStrict (unionWith f) empty ts
+
+-- | /O(n+m)/. The (left-biased) union of two maps.
+-- It prefers the first map when duplicate keys are encountered,
+-- i.e. (@'union' == 'unionWith' 'const'@).
+--
+-- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]
+
+union :: IntMap a -> IntMap a -> IntMap a
+union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = union1
+ | shorter m2 m1 = union2
+ | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
+ | otherwise = join p1 t1 p2 t2
+ where
+ union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
+ | zero p2 m1 = Bin p1 m1 (union l1 t2) r1
+ | otherwise = Bin p1 m1 l1 (union r1 t2)
+
+ union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
+ | zero p1 m2 = Bin p2 m2 (union t1 l2) r2
+ | otherwise = Bin p2 m2 l2 (union t1 r2)
+
+union (Tip k x) t = insert k x t
+union t (Tip k x) = insertWith (\_ y -> y) k x t -- right bias
+union Nil t = t
+union t Nil = t
+
+-- | /O(n+m)/. The union with a combining function.
+--
+-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
+
+unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
+unionWith f m1 m2
+ = unionWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. The union with a combining function.
+--
+-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
+-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
+
+unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
+unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = union1
+ | shorter m2 m1 = union2
+ | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
+ | otherwise = join p1 t1 p2 t2
+ where
+ union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
+ | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
+ | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
+
+ union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
+ | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
+ | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
+
+unionWithKey f (Tip k x) t = insertWithKey f k x t
+unionWithKey f t (Tip k x) = insertWithKey (\k' x' y' -> f k' y' x') k x t -- right bias
+unionWithKey _ Nil t = t
+unionWithKey _ t Nil = t
+
+{--------------------------------------------------------------------
+ Difference
+--------------------------------------------------------------------}
+-- | /O(n+m)/. Difference between two maps (based on keys).
+--
+-- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"
+
+difference :: IntMap a -> IntMap b -> IntMap a
+difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = difference1
+ | shorter m2 m1 = difference2
+ | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
+ | otherwise = t1
+ where
+ difference1 | nomatch p2 p1 m1 = t1
+ | zero p2 m1 = bin p1 m1 (difference l1 t2) r1
+ | otherwise = bin p1 m1 l1 (difference r1 t2)
+
+ difference2 | nomatch p1 p2 m2 = t1
+ | zero p1 m2 = difference t1 l2
+ | otherwise = difference t1 r2
+
+difference t1@(Tip k _) t2
+ | member k t2 = Nil
+ | otherwise = t1
+
+difference Nil _ = Nil
+difference t (Tip k _) = delete k t
+difference t Nil = t
+
+-- | /O(n+m)/. Difference with a combining function.
+--
+-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
+-- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
+-- > == singleton 3 "b:B"
+
+differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
+differenceWith f m1 m2
+ = differenceWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. Difference with a combining function. When two equal keys are
+-- encountered, the combining function is applied to the key and both values.
+-- If it returns 'Nothing', the element is discarded (proper set difference).
+-- If it returns (@'Just' y@), the element is updated with a new value @y at .
+--
+-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
+-- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
+-- > == singleton 3 "3:b|B"
+
+differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
+differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = difference1
+ | shorter m2 m1 = difference2
+ | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
+ | otherwise = t1
+ where
+ difference1 | nomatch p2 p1 m1 = t1
+ | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
+ | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
+
+ difference2 | nomatch p1 p2 m2 = t1
+ | zero p1 m2 = differenceWithKey f t1 l2
+ | otherwise = differenceWithKey f t1 r2
+
+differenceWithKey f t1@(Tip k x) t2
+ = case lookup k t2 of
+ Just y -> case f k x y of
+ Just y' -> Tip k y'
+ Nothing -> Nil
+ Nothing -> t1
+
+differenceWithKey _ Nil _ = Nil
+differenceWithKey f t (Tip k y) = updateWithKey (\k' x -> f k' x y) k t
+differenceWithKey _ t Nil = t
+
+
+{--------------------------------------------------------------------
+ Intersection
+--------------------------------------------------------------------}
+-- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
+--
+-- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
+
+intersection :: IntMap a -> IntMap b -> IntMap a
+intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = intersection1
+ | shorter m2 m1 = intersection2
+ | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
+ | otherwise = Nil
+ where
+ intersection1 | nomatch p2 p1 m1 = Nil
+ | zero p2 m1 = intersection l1 t2
+ | otherwise = intersection r1 t2
+
+ intersection2 | nomatch p1 p2 m2 = Nil
+ | zero p1 m2 = intersection t1 l2
+ | otherwise = intersection t1 r2
+
+intersection t1@(Tip k _) t2
+ | member k t2 = t1
+ | otherwise = Nil
+intersection t (Tip k _)
+ = case lookup k t of
+ Just y -> Tip k y
+ Nothing -> Nil
+intersection Nil _ = Nil
+intersection _ Nil = Nil
+
+-- | /O(n+m)/. The intersection with a combining function.
+--
+-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
+
+intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
+intersectionWith f m1 m2
+ = intersectionWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. The intersection with a combining function.
+--
+-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
+-- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
+
+intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
+intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = intersection1
+ | shorter m2 m1 = intersection2
+ | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
+ | otherwise = Nil
+ where
+ intersection1 | nomatch p2 p1 m1 = Nil
+ | zero p2 m1 = intersectionWithKey f l1 t2
+ | otherwise = intersectionWithKey f r1 t2
+
+ intersection2 | nomatch p1 p2 m2 = Nil
+ | zero p1 m2 = intersectionWithKey f t1 l2
+ | otherwise = intersectionWithKey f t1 r2
+
+intersectionWithKey f (Tip k x) t2
+ = case lookup k t2 of
+ Just y -> Tip k (f k x y)
+ Nothing -> Nil
+intersectionWithKey f t1 (Tip k y)
+ = case lookup k t1 of
+ Just x -> Tip k (f k x y)
+ Nothing -> Nil
+intersectionWithKey _ Nil _ = Nil
+intersectionWithKey _ _ Nil = Nil
+
+
+{--------------------------------------------------------------------
+ Min\/Max
+--------------------------------------------------------------------}
+
+-- | /O(log n)/. Update the value at the minimal key.
+--
+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKey f t
+ = case t of
+ Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
+ Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
+ Tip k y -> Tip k (f k y)
+ Nil -> error "maxView: empty map has no maximal element"
+
+updateMinWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKeyUnsigned f t
+ = case t of
+ Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
+ Tip k y -> Tip k (f k y)
+ Nil -> error "updateMinWithKeyUnsigned Nil"
+
+-- | /O(log n)/. Update the value at the maximal key.
+--
+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+
+updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKey f t
+ = case t of
+ Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
+ Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
+ Tip k y -> Tip k (f k y)
+ Nil -> error "maxView: empty map has no maximal element"
+
+updateMaxWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKeyUnsigned f t
+ = case t of
+ Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
+ Tip k y -> Tip k (f k y)
+ Nil -> error "updateMaxWithKeyUnsigned Nil"
+
+
+-- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
+-- the map stripped of that element, or 'Nothing' if passed an empty map.
+--
+-- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
+-- > maxViewWithKey empty == Nothing
+
+maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
+maxViewWithKey t
+ = case t of
+ Bin p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in Just (result, bin p m t' r)
+ Bin p m l r -> let (result, t') = maxViewUnsigned r in Just (result, bin p m l t')
+ Tip k y -> Just ((k,y), Nil)
+ Nil -> Nothing
+
+maxViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
+maxViewUnsigned t
+ = case t of
+ Bin p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
+ Tip k y -> ((k,y), Nil)
+ Nil -> error "maxViewUnsigned Nil"
+
+-- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and
+-- the map stripped of that element, or 'Nothing' if passed an empty map.
+--
+-- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
+-- > minViewWithKey empty == Nothing
+
+minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
+minViewWithKey t
+ = case t of
+ Bin p m l r | m < 0 -> let (result, t') = minViewUnsigned r in Just (result, bin p m l t')
+ Bin p m l r -> let (result, t') = minViewUnsigned l in Just (result, bin p m t' r)
+ Tip k y -> Just ((k,y),Nil)
+ Nil -> Nothing
+
+minViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
+minViewUnsigned t
+ = case t of
+ Bin p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
+ Tip k y -> ((k,y),Nil)
+ Nil -> error "minViewUnsigned Nil"
+
+
+-- | /O(log n)/. Update the value at the maximal key.
+--
+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+
+updateMax :: (a -> a) -> IntMap a -> IntMap a
+updateMax f = updateMaxWithKey (const f)
+
+-- | /O(log n)/. Update the value at the minimal key.
+--
+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateMin :: (a -> a) -> IntMap a -> IntMap a
+updateMin f = updateMinWithKey (const f)
+
+-- Similar to the Arrow instance.
+first :: (a -> c) -> (a, b) -> (c, b)
+first f (x,y) = (f x,y)
+
+-- | /O(log n)/. Retrieves the maximal key of the map, and the map
+-- stripped of that element, or 'Nothing' if passed an empty map.
+maxView :: IntMap a -> Maybe (a, IntMap a)
+maxView t = liftM (first snd) (maxViewWithKey t)
+
+-- | /O(log n)/. Retrieves the minimal key of the map, and the map
+-- stripped of that element, or 'Nothing' if passed an empty map.
+minView :: IntMap a -> Maybe (a, IntMap a)
+minView t = liftM (first snd) (minViewWithKey t)
+
+-- | /O(log n)/. Delete and find the maximal element.
+deleteFindMax :: IntMap a -> (a, IntMap a)
+deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxView
+
+-- | /O(log n)/. Delete and find the minimal element.
+deleteFindMin :: IntMap a -> (a, IntMap a)
+deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minView
+
+-- | /O(log n)/. The minimal key of the map.
+findMin :: IntMap a -> (Key, a)
+findMin Nil = error $ "findMin: empty map has no minimal element"
+findMin (Tip k v) = (k,v)
+findMin (Bin _ m l r)
+ | m < 0 = go r
+ | otherwise = go l
+ where go (Tip k v) = (k,v)
+ go (Bin _ _ l' _) = go l'
+ go Nil = error "findMax Nil"
+
+-- | /O(log n)/. The maximal key of the map.
+findMax :: IntMap a -> (Key, a)
+findMax Nil = error $ "findMax: empty map has no maximal element"
+findMax (Tip k v) = (k,v)
+findMax (Bin _ m l r)
+ | m < 0 = go l
+ | otherwise = go r
+ where go (Tip k v) = (k,v)
+ go (Bin _ _ _ r') = go r'
+ go Nil = error "findMax Nil"
+
+-- | /O(log n)/. Delete the minimal key. An error is thrown if the IntMap is already empty.
+-- Note, this is not the same behavior Map.
+deleteMin :: IntMap a -> IntMap a
+deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView
+
+-- | /O(log n)/. Delete the maximal key. An error is thrown if the IntMap is already empty.
+-- Note, this is not the same behavior Map.
+deleteMax :: IntMap a -> IntMap a
+deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView
+
+
+{--------------------------------------------------------------------
+ Submap
+--------------------------------------------------------------------}
+-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
+-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
+isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
+isProperSubmapOf m1 m2
+ = isProperSubmapOfBy (==) m1 m2
+
+{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
+ The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
+ @m1@ and @m2@ are not equal,
+ all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
+ applied to their respective values. For example, the following
+ expressions are all 'True':
+
+ > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+ > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+
+ But the following are all 'False':
+
+ > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
+ > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
+ > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+-}
+isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
+isProperSubmapOfBy predicate t1 t2
+ = case submapCmp predicate t1 t2 of
+ LT -> True
+ _ -> False
+
+submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
+submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ | shorter m1 m2 = GT
+ | shorter m2 m1 = submapCmpLt
+ | p1 == p2 = submapCmpEq
+ | otherwise = GT -- disjoint
+ where
+ submapCmpLt | nomatch p1 p2 m2 = GT
+ | zero p1 m2 = submapCmp predicate t1 l2
+ | otherwise = submapCmp predicate t1 r2
+ submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of
+ (GT,_ ) -> GT
+ (_ ,GT) -> GT
+ (EQ,EQ) -> EQ
+ _ -> LT
+
+submapCmp _ (Bin _ _ _ _) _ = GT
+submapCmp predicate (Tip kx x) (Tip ky y)
+ | (kx == ky) && predicate x y = EQ
+ | otherwise = GT -- disjoint
+submapCmp predicate (Tip k x) t
+ = case lookup k t of
+ Just y | predicate x y -> LT
+ _ -> GT -- disjoint
+submapCmp _ Nil Nil = EQ
+submapCmp _ Nil _ = LT
+
+-- | /O(n+m)/. Is this a submap?
+-- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
+isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
+isSubmapOf m1 m2
+ = isSubmapOfBy (==) m1 m2
+
+{- | /O(n+m)/.
+ The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
+ all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
+ applied to their respective values. For example, the following
+ expressions are all 'True':
+
+ > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+ > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+ > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
+
+ But the following are all 'False':
+
+ > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
+ > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
+ > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
+-}
+isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
+isSubmapOfBy predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ | shorter m1 m2 = False
+ | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy predicate t1 l2
+ else isSubmapOfBy predicate t1 r2)
+ | otherwise = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2
+isSubmapOfBy _ (Bin _ _ _ _) _ = False
+isSubmapOfBy predicate (Tip k x) t = case lookup k t of
+ Just y -> predicate x y
+ Nothing -> False
+isSubmapOfBy _ Nil _ = True
+
+{--------------------------------------------------------------------
+ Mapping
+--------------------------------------------------------------------}
+-- | /O(n)/. Map a function over all values in the map.
+--
+-- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
+
+map :: (a -> b) -> IntMap a -> IntMap b
+map f = mapWithKey (\_ x -> f x)
+
+-- | /O(n)/. Map a function over all values in the map.
+--
+-- > let f key x = (show key) ++ ":" ++ x
+-- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
+
+mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
+mapWithKey f t
+ = case t of
+ Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
+ Tip k x -> Tip k (f k x)
+ Nil -> Nil
+
+-- | /O(n)/. The function @'mapAccum'@ threads an accumulating
+-- argument through the map in ascending order of keys.
+--
+-- > let f a b = (a ++ b, b ++ "X")
+-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
+
+mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
+
+-- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
+-- argument through the map in ascending order of keys.
+--
+-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
+
+mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumWithKey f a t
+ = mapAccumL f a t
+
+-- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
+-- argument through the map in ascending order of keys.
+mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumL f a t
+ = case t of
+ Bin p m l r -> let (a1,l') = mapAccumL f a l
+ (a2,r') = mapAccumL f a1 r
+ in (a2,Bin p m l' r')
+ Tip k x -> let (a',x') = f a k x in (a',Tip k x')
+ Nil -> (a,Nil)
+
+-- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
+-- argument through the map in descending order of keys.
+mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumRWithKey f a t
+ = case t of
+ Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
+ (a2,l') = mapAccumRWithKey f a1 l
+ in (a2,Bin p m l' r')
+ Tip k x -> let (a',x') = f a k x in (a',Tip k x')
+ Nil -> (a,Nil)
+
+{--------------------------------------------------------------------
+ Filter
+--------------------------------------------------------------------}
+-- | /O(n)/. Filter all values that satisfy some predicate.
+--
+-- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+-- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
+-- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
+
+filter :: (a -> Bool) -> IntMap a -> IntMap a
+filter p m
+ = filterWithKey (\_ x -> p x) m
+
+-- | /O(n)/. Filter all keys\/values that satisfy some predicate.
+--
+-- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
+filterWithKey predicate t
+ = case t of
+ Bin p m l r
+ -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
+ Tip k x
+ | predicate k x -> t
+ | otherwise -> Nil
+ Nil -> Nil
+
+-- | /O(n)/. Partition the map according to some predicate. The first
+-- map contains all elements that satisfy the predicate, the second all
+-- elements that fail the predicate. See also 'split'.
+--
+-- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
+-- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
+-- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
+
+partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
+partition p m
+ = partitionWithKey (\_ x -> p x) m
+
+-- | /O(n)/. Partition the map according to some predicate. The first
+-- map contains all elements that satisfy the predicate, the second all
+-- elements that fail the predicate. See also 'split'.
+--
+-- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
+-- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
+-- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
+
+partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
+partitionWithKey predicate t
+ = case t of
+ Bin p m l r
+ -> let (l1,l2) = partitionWithKey predicate l
+ (r1,r2) = partitionWithKey predicate r
+ in (bin p m l1 r1, bin p m l2 r2)
+ Tip k x
+ | predicate k x -> (t,Nil)
+ | otherwise -> (Nil,t)
+ Nil -> (Nil,Nil)
+
+-- | /O(n)/. Map values and collect the 'Just' results.
+--
+-- > let f x = if x == "a" then Just "new a" else Nothing
+-- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
+
+mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
+mapMaybe f = mapMaybeWithKey (\_ x -> f x)
+
+-- | /O(n)/. Map keys\/values and collect the 'Just' results.
+--
+-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
+-- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
+
+mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
+mapMaybeWithKey f (Bin p m l r)
+ = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+mapMaybeWithKey f (Tip k x) = case f k x of
+ Just y -> Tip k y
+ Nothing -> Nil
+mapMaybeWithKey _ Nil = Nil
+
+-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
+--
+-- > let f a = if a < "c" then Left a else Right a
+-- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
+-- >
+-- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+
+mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
+mapEither f m
+ = mapEitherWithKey (\_ x -> f x) m
+
+-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
+--
+-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
+-- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
+-- >
+-- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
+
+mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
+mapEitherWithKey f (Bin p m l r)
+ = (bin p m l1 r1, bin p m l2 r2)
+ where
+ (l1,l2) = mapEitherWithKey f l
+ (r1,r2) = mapEitherWithKey f r
+mapEitherWithKey f (Tip k x) = case f k x of
+ Left y -> (Tip k y, Nil)
+ Right z -> (Nil, Tip k z)
+mapEitherWithKey _ Nil = (Nil, Nil)
+
+-- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
+-- where all keys in @map1@ are lower than @k@ and all keys in
+-- @map2@ larger than @k at . Any key equal to @k@ is found in neither @map1@ nor @map2 at .
+--
+-- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
+-- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
+-- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
+-- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
+-- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
+
+split :: Key -> IntMap a -> (IntMap a,IntMap a)
+split k t
+ = case t of
+ Bin _ m l r
+ | m < 0 -> (if k >= 0 -- handle negative numbers.
+ then let (lt,gt) = split' k l in (union r lt, gt)
+ else let (lt,gt) = split' k r in (lt, union gt l))
+ | otherwise -> split' k t
+ Tip ky _
+ | k>ky -> (t,Nil)
+ | k<ky -> (Nil,t)
+ | otherwise -> (Nil,Nil)
+ Nil -> (Nil,Nil)
+
+split' :: Key -> IntMap a -> (IntMap a,IntMap a)
+split' k t
+ = case t of
+ Bin p m l r
+ | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
+ | zero k m -> let (lt,gt) = split k l in (lt,union gt r)
+ | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
+ Tip ky _
+ | k>ky -> (t,Nil)
+ | k<ky -> (Nil,t)
+ | otherwise -> (Nil,Nil)
+ Nil -> (Nil,Nil)
+
+-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
+-- key was found in the original map.
+--
+-- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
+-- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
+-- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
+-- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
+-- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
+
+splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
+splitLookup k t
+ = case t of
+ Bin _ m l r
+ | m < 0 -> (if k >= 0 -- handle negative numbers.
+ then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt)
+ else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l))
+ | otherwise -> splitLookup' k t
+ Tip ky y
+ | k>ky -> (t,Nothing,Nil)
+ | k<ky -> (Nil,Nothing,t)
+ | otherwise -> (Nil,Just y,Nil)
+ Nil -> (Nil,Nothing,Nil)
+
+splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
+splitLookup' k t
+ = case t of
+ Bin p m l r
+ | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
+ | zero k m -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
+ | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
+ Tip ky y
+ | k>ky -> (t,Nothing,Nil)
+ | k<ky -> (Nil,Nothing,t)
+ | otherwise -> (Nil,Just y,Nil)
+ Nil -> (Nil,Nothing,Nil)
+
+{--------------------------------------------------------------------
+ Fold
+--------------------------------------------------------------------}
+-- | /O(n)/. Fold the values in the map using the given right-associative
+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
+--
+-- For example,
+--
+-- > elems map = foldr (:) [] map
+--
+-- > let f a len = len + (length a)
+-- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
+foldr :: (a -> b -> b) -> b -> IntMap a -> b
+foldr f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ _ -> go z t
+ where
+ go z' Nil = z'
+ go z' (Tip _ x) = f x z'
+ go z' (Bin _ _ l r) = go (go z' r) l
+{-# INLINE foldr #-}
+
+-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
+-- evaluated before using the result in the next application. This
+-- function is strict in the starting value.
+foldr' :: (a -> b -> b) -> b -> IntMap a -> b
+foldr' f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ _ -> go z t
+ where
+ STRICT_1_OF_2(go)
+ go z' Nil = z'
+ go z' (Tip _ x) = f x z'
+ go z' (Bin _ _ l r) = go (go z' r) l
+{-# INLINE foldr' #-}
+
+-- | /O(n)/. Fold the values in the map using the given left-associative
+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
+--
+-- For example,
+--
+-- > elems = reverse . foldl (flip (:)) []
+--
+-- > let f len a = len + (length a)
+-- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
+foldl :: (a -> b -> a) -> a -> IntMap b -> a
+foldl f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ _ -> go z t
+ where
+ go z' Nil = z'
+ go z' (Tip _ x) = f z' x
+ go z' (Bin _ _ l r) = go (go z' l) r
+{-# INLINE foldl #-}
+
+-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
+-- evaluated before using the result in the next application. This
+-- function is strict in the starting value.
+foldl' :: (a -> b -> a) -> a -> IntMap b -> a
+foldl' f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ _ -> go z t
+ where
+ STRICT_1_OF_2(go)
+ go z' Nil = z'
+ go z' (Tip _ x) = f z' x
+ go z' (Bin _ _ l r) = go (go z' l) r
+{-# INLINE foldl' #-}
+
+-- | /O(n)/. Fold the keys and values in the map using the given right-associative
+-- binary operator, such that
+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
+--
+-- For example,
+--
+-- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
+--
+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
+-- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
+foldrWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
+foldrWithKey f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ _ -> go z t
+ where
+ go z' Nil = z'
+ go z' (Tip kx x) = f kx x z'
+ go z' (Bin _ _ l r) = go (go z' r) l
+{-# INLINE foldrWithKey #-}
+
+-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
+-- evaluated before using the result in the next application. This
+-- function is strict in the starting value.
+foldrWithKey' :: (Int -> a -> b -> b) -> b -> IntMap a -> b
+foldrWithKey' f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ _ -> go z t
+ where
+ STRICT_1_OF_2(go)
+ go z' Nil = z'
+ go z' (Tip kx x) = f kx x z'
+ go z' (Bin _ _ l r) = go (go z' r) l
+{-# INLINE foldrWithKey' #-}
+
+-- | /O(n)/. Fold the keys and values in the map using the given left-associative
+-- binary operator, such that
+-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
+--
+-- For example,
+--
+-- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []
+--
+-- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
+-- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
+foldlWithKey :: (a -> Int -> b -> a) -> a -> IntMap b -> a
+foldlWithKey f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ _ -> go z t
+ where
+ go z' Nil = z'
+ go z' (Tip kx x) = f z' kx x
+ go z' (Bin _ _ l r) = go (go z' l) r
+{-# INLINE foldlWithKey #-}
+
+-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
+-- evaluated before using the result in the next application. This
+-- function is strict in the starting value.
+foldlWithKey' :: (a -> Int -> b -> a) -> a -> IntMap b -> a
+foldlWithKey' f z t =
+ case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ _ -> go z t
+ where
+ STRICT_1_OF_2(go)
+ go z' Nil = z'
+ go z' (Tip kx x) = f z' kx x
+ go z' (Bin _ _ l r) = go (go z' l) r
+{-# INLINE foldlWithKey' #-}
+
+{--------------------------------------------------------------------
+ List variations
+--------------------------------------------------------------------}
+-- | /O(n)/.
+-- Return all elements of the map in the ascending order of their keys.
+--
+-- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
+-- > elems empty == []
+
+elems :: IntMap a -> [a]
+elems
+ = foldr (:) []
+
+-- | /O(n)/. Return all keys of the map in ascending order.
+--
+-- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
+-- > keys empty == []
+
+keys :: IntMap a -> [Key]
+keys
+ = foldrWithKey (\k _ ks -> k:ks) []
+
+-- | /O(n*min(n,W))/. The set of all keys of the map.
+--
+-- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5]
+-- > keysSet empty == Data.IntSet.empty
+
+keysSet :: IntMap a -> IntSet.IntSet
+keysSet m = IntSet.fromDistinctAscList (keys m)
+
+
+-- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
+--
+-- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
+-- > assocs empty == []
+
+assocs :: IntMap a -> [(Key,a)]
+assocs m
+ = toList m
+
+
+{--------------------------------------------------------------------
+ Lists
+--------------------------------------------------------------------}
+-- | /O(n)/. Convert the map to a list of key\/value pairs.
+--
+-- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
+-- > toList empty == []
+
+toList :: IntMap a -> [(Key,a)]
+toList
+ = foldrWithKey (\k x xs -> (k,x):xs) []
+
+-- | /O(n)/. Convert the map to a list of key\/value pairs where the
+-- keys are in ascending order.
+--
+-- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
+
+toAscList :: IntMap a -> [(Key,a)]
+toAscList t
+ = -- NOTE: the following algorithm only works for big-endian trees
+ let (pos,neg) = span (\(k,_) -> k >=0) (foldrWithKey (\k x xs -> (k,x):xs) [] t) in neg ++ pos
+
+-- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
+--
+-- > fromList [] == empty
+-- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
+-- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
+
+fromList :: [(Key,a)] -> IntMap a
+fromList xs
+ = foldlStrict ins empty xs
+ where
+ ins t (k,x) = insert k x t
+
+-- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
+--
+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
+-- > fromListWith (++) [] == empty
+
+fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
+fromListWith f xs
+ = fromListWithKey (\_ x y -> f x y) xs
+
+-- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
+--
+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
+-- > fromListWith (++) [] == empty
+
+fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
+fromListWithKey f xs
+ = foldlStrict ins empty xs
+ where
+ ins t (k,x) = insertWithKey f k x t
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order.
+--
+-- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
+-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
+
+fromAscList :: [(Key,a)] -> IntMap a
+fromAscList xs
+ = fromAscListWithKey (\_ x _ -> x) xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
+--
+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
+
+fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
+fromAscListWith f xs
+ = fromAscListWithKey (\_ x y -> f x y) xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
+--
+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
+
+fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
+fromAscListWithKey _ [] = Nil
+fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
+ where
+ -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
+ combineEq z [] = [z]
+ combineEq z@(kz,zz) (x@(kx,xx):xs)
+ | kx==kz = let yy = f kx xx zz in combineEq (kx,yy) xs
+ | otherwise = z:combineEq x xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order and all distinct.
+-- /The precondition (input list is strictly ascending) is not checked./
+--
+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
+
+#ifdef __GLASGOW_HASKELL__
+fromDistinctAscList :: forall a. [(Key,a)] -> IntMap a
+#else
+fromDistinctAscList :: [(Key,a)] -> IntMap a
+#endif
+fromDistinctAscList [] = Nil
+fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
+ where
+ work (kx,vx) [] stk = finish kx (Tip kx vx) stk
+ work (kx,vx) (z@(kz,_):zs) stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
+
+#ifdef __GLASGOW_HASKELL__
+ reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
+#endif
+ reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
+ reduce z zs m px tx stk@(Push py ty stk') =
+ let mxy = branchMask px py
+ pxy = mask px mxy
+ in if shorter m mxy
+ then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
+ else work z zs (Push px tx stk)
+
+ finish _ t Nada = t
+ finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+ where m = branchMask px py
+ p = mask px m
+
+data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
+
+
+{--------------------------------------------------------------------
+ Eq
+--------------------------------------------------------------------}
+instance Eq a => Eq (IntMap a) where
+ t1 == t2 = equal t1 t2
+ t1 /= t2 = nequal t1 t2
+
+equal :: Eq a => IntMap a -> IntMap a -> Bool
+equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
+equal (Tip kx x) (Tip ky y)
+ = (kx == ky) && (x==y)
+equal Nil Nil = True
+equal _ _ = False
+
+nequal :: Eq a => IntMap a -> IntMap a -> Bool
+nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
+nequal (Tip kx x) (Tip ky y)
+ = (kx /= ky) || (x/=y)
+nequal Nil Nil = False
+nequal _ _ = True
+
+{--------------------------------------------------------------------
+ Ord
+--------------------------------------------------------------------}
+
+instance Ord a => Ord (IntMap a) where
+ compare m1 m2 = compare (toList m1) (toList m2)
+
+{--------------------------------------------------------------------
+ Functor
+--------------------------------------------------------------------}
+
+instance Functor IntMap where
+ fmap = map
+
+{--------------------------------------------------------------------
+ Show
+--------------------------------------------------------------------}
+
+instance Show a => Show (IntMap a) where
+ showsPrec d m = showParen (d > 10) $
+ showString "fromList " . shows (toList m)
+
+{-
+XXX unused code
+
+showMap :: (Show a) => [(Key,a)] -> ShowS
+showMap []
+ = showString "{}"
+showMap (x:xs)
+ = showChar '{' . showElem x . showTail xs
+ where
+ showTail [] = showChar '}'
+ showTail (x':xs') = showChar ',' . showElem x' . showTail xs'
+
+ showElem (k,v) = shows k . showString ":=" . shows v
+-}
+
+{--------------------------------------------------------------------
+ Read
+--------------------------------------------------------------------}
+instance (Read e) => Read (IntMap e) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromList" <- lexP
+ xs <- readPrec
+ return (fromList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r -> do
+ ("fromList",s) <- lex r
+ (xs,t) <- reads s
+ return (fromList xs,t)
+#endif
+
+{--------------------------------------------------------------------
+ Typeable
+--------------------------------------------------------------------}
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
+
+{--------------------------------------------------------------------
+ Debugging
+--------------------------------------------------------------------}
+-- | /O(n)/. Show the tree that implements the map. The tree is shown
+-- in a compressed, hanging format.
+showTree :: Show a => IntMap a -> String
+showTree s
+ = showTreeWith True False s
+
+
+{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
+ the tree that implements the map. If @hang@ is
+ 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
+ @wide@ is 'True', an extra wide version is shown.
+-}
+showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
+showTreeWith hang wide t
+ | hang = (showsTreeHang wide [] t) ""
+ | otherwise = (showsTree wide [] [] t) ""
+
+showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
+showsTree wide lbars rbars t
+ = case t of
+ Bin p m l r
+ -> showsTree wide (withBar rbars) (withEmpty rbars) r .
+ showWide wide rbars .
+ showsBars lbars . showString (showBin p m) . showString "\n" .
+ showWide wide lbars .
+ showsTree wide (withEmpty lbars) (withBar lbars) l
+ Tip k x
+ -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
+ Nil -> showsBars lbars . showString "|\n"
+
+showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
+showsTreeHang wide bars t
+ = case t of
+ Bin p m l r
+ -> showsBars bars . showString (showBin p m) . showString "\n" .
+ showWide wide bars .
+ showsTreeHang wide (withBar bars) l .
+ showWide wide bars .
+ showsTreeHang wide (withEmpty bars) r
+ Tip k x
+ -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
+ Nil -> showsBars bars . showString "|\n"
+
+showBin :: Prefix -> Mask -> String
+showBin _ _
+ = "*" -- ++ show (p,m)
+
+showWide :: Bool -> [String] -> String -> String
+showWide wide bars
+ | wide = showString (concat (reverse bars)) . showString "|\n"
+ | otherwise = id
+
+showsBars :: [String] -> ShowS
+showsBars bars
+ = case bars of
+ [] -> id
+ _ -> showString (concat (reverse (tail bars))) . showString node
+
+node :: String
+node = "+--"
+
+withBar, withEmpty :: [String] -> [String]
+withBar bars = "| ":bars
+withEmpty bars = " ":bars
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
new file mode 100644
index 0000000..4946319
--- /dev/null
+++ b/Data/IntMap/Strict.hs
@@ -0,0 +1,883 @@
+{-# LANGUAGE CPP, NoBangPatterns, MagicHash, ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.IntMap.Strict
+-- Copyright : (c) Daan Leijen 2002
+-- (c) Andriy Palamarchuk 2008
+-- License : BSD-style
+-- Maintainer : libraries at haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- An efficient implementation of maps from integer keys to strict
+-- values.
+--
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
+--
+-- > import Data.IntMap (IntMap)
+-- > import qualified Data.IntMap as IntMap
+--
+-- The implementation is based on /big-endian patricia trees/. This data
+-- structure performs especially well on binary operations like 'union'
+-- and 'intersection'. However, my benchmarks show that it is also
+-- (much) faster on insertions and deletions when compared to a generic
+-- size-balanced map implementation (see "Data.Map").
+--
+-- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
+-- Workshop on ML, September 1998, pages 77-86,
+-- <http://citeseer.ist.psu.edu/okasaki98fast.html>
+--
+-- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
+-- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
+-- October 1968, pages 514-534.
+--
+-- Operation comments contain the operation time complexity in
+-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.
+-- Many operations have a worst-case complexity of /O(min(n,W))/.
+-- This means that the operation can become linear in the number of
+-- elements with a maximum of /W/ -- the number of bits in an 'Int'
+-- (32 or 64).
+--
+-- Valid instances that work properly on strict maps are 'Foldable',
+-- 'Monoid', 'Data', 'Eq', 'Ord', 'Show', 'Read' and 'Typeable'.
+-- Notably, you cannot define strict versions of 'Functor' and
+-- 'Traversable', so if they are used on strict maps, the resulting
+-- maps will be lazy.
+-----------------------------------------------------------------------------
+
+module Data.IntMap.Strict (
+ -- * Map type
+#if !defined(TESTING)
+ IntMap, Key -- instance Eq,Show
+#else
+ IntMap(..), Key -- instance Eq,Show
+#endif
+
+ -- * Operators
+ , (!), (\\)
+
+ -- * Query
+ , null
+ , size
+ , member
+ , notMember
+ , lookup
+ , findWithDefault
+
+ -- * Construction
+ , empty
+ , singleton
+
+ -- ** Insertion
+ , insert
+ , insertWith
+ , insertWithKey
+ , insertLookupWithKey
+
+ -- ** Delete\/Update
+ , delete
+ , adjust
+ , adjustWithKey
+ , update
+ , updateWithKey
+ , updateLookupWithKey
+ , alter
+
+ -- * Combine
+
+ -- ** Union
+ , union
+ , unionWith
+ , unionWithKey
+ , unions
+ , unionsWith
+
+ -- ** Difference
+ , difference
+ , differenceWith
+ , differenceWithKey
+
+ -- ** Intersection
+ , intersection
+ , intersectionWith
+ , intersectionWithKey
+
+ -- * Traversal
+ -- ** Map
+ , map
+ , mapWithKey
+ , mapAccum
+ , mapAccumWithKey
+ , mapAccumRWithKey
+
+ -- * Folds
+ , foldr
+ , foldl
+ , foldrWithKey
+ , foldlWithKey
+ -- ** Strict folds
+ , foldr'
+ , foldl'
+ , foldrWithKey'
+ , foldlWithKey'
+
+ -- * Conversion
+ , elems
+ , keys
+ , keysSet
+ , assocs
+
+ -- ** Lists
+ , toList
+ , fromList
+ , fromListWith
+ , fromListWithKey
+
+ -- ** Ordered lists
+ , toAscList
+ , fromAscList
+ , fromAscListWith
+ , fromAscListWithKey
+ , fromDistinctAscList
+
+ -- * Filter
+ , filter
+ , filterWithKey
+ , partition
+ , partitionWithKey
+
+ , mapMaybe
+ , mapMaybeWithKey
+ , mapEither
+ , mapEitherWithKey
+
+ , split
+ , splitLookup
+
+ -- * Submap
+ , isSubmapOf, isSubmapOfBy
+ , isProperSubmapOf, isProperSubmapOfBy
+
+ -- * Min\/Max
+ , findMin
+ , findMax
+ , deleteMin
+ , deleteMax
+ , deleteFindMin
+ , deleteFindMax
+ , updateMin
+ , updateMax
+ , updateMinWithKey
+ , updateMaxWithKey
+ , minView
+ , maxView
+ , minViewWithKey
+ , maxViewWithKey
+
+ -- * Debugging
+ , showTree
+ , showTreeWith
+ ) where
+
+import Prelude hiding (lookup,map,filter,foldr,foldl,null)
+
+import Data.IntMap.Common
+import Data.IntMap.Lazy hiding
+ ( singleton
+ , insert
+ , insertWith
+ , insertWithKey
+ , insertLookupWithKey
+ , adjust
+ , adjustWithKey
+ , update
+ , updateWithKey
+ , updateLookupWithKey
+ , alter
+ , unionsWith
+ , unionWith
+ , unionWithKey
+ , differenceWith
+ , differenceWithKey
+ , intersectionWith
+ , intersectionWithKey
+ , updateMinWithKey
+ , updateMaxWithKey
+ , updateMax
+ , updateMin
+ , map
+ , mapWithKey
+ , mapAccum
+ , mapAccumWithKey
+ , mapAccumRWithKey
+ , mapMaybe
+ , mapMaybeWithKey
+ , mapEither
+ , mapEitherWithKey
+ , fromList
+ , fromListWith
+ , fromListWithKey
+ , fromAscList
+ , fromAscListWith
+ , fromAscListWithKey
+ , fromDistinctAscList
+ )
+
+
+{--------------------------------------------------------------------
+ Construction
+--------------------------------------------------------------------}
+-- | /O(1)/. A map of one element.
+--
+-- > singleton 1 'a' == fromList [(1, 'a')]
+-- > size (singleton 1 'a') == 1
+
+singleton :: Key -> a -> IntMap a
+singleton k x
+ = x `seq` Tip k x
+
+{--------------------------------------------------------------------
+ Insert
+--------------------------------------------------------------------}
+-- | /O(min(n,W))/. Insert a new key\/value pair in the map.
+-- If the key is already present in the map, the associated value is
+-- replaced with the supplied value, i.e. 'insert' is equivalent to
+-- @'insertWith' 'const'@.
+--
+-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
+-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
+-- > insert 5 'x' empty == singleton 5 'x'
+
+insert :: Key -> a -> IntMap a -> IntMap a
+insert k x t = k `seq` x `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> join k (Tip k x) p t
+ | zero k m -> Bin p m (insert k x l) r
+ | otherwise -> Bin p m l (insert k x r)
+ Tip ky _
+ | k==ky -> Tip k x
+ | otherwise -> join k (Tip k x) ky t
+ Nil -> Tip k x
+
+-- right-biased insertion, used by 'union'
+-- | /O(min(n,W))/. Insert with a combining function.
+-- @'insertWith' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert @f new_value old_value at .
+--
+-- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
+-- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
+
+insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+insertWith f k x t
+ = insertWithKey (\_ x' y' -> f x' y') k x t
+
+-- | /O(min(n,W))/. Insert with a combining function.
+-- @'insertWithKey' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert @f key new_value old_value at .
+--
+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
+-- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
+-- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
+--
+-- If the key exists in the map, this function is lazy in @x@ but strict
+-- in the result of @f at .
+
+insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+insertWithKey f k x t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> x `seq` join k (Tip k x) p t
+ | zero k m -> Bin p m (insertWithKey f k x l) r
+ | otherwise -> Bin p m l (insertWithKey f k x r)
+ Tip ky y
+ | k==ky -> Tip k $! f k x y
+ | otherwise -> x `seq` join k (Tip k x) ky t
+ Nil -> x `seq` Tip k x
+
+-- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
+-- is a pair where the first element is equal to (@'lookup' k map@)
+-- and the second element equal to (@'insertWithKey' f k x map@).
+--
+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
+-- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
+-- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
+-- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
+--
+-- This is how to define @insertLookup@ using @insertLookupWithKey@:
+--
+-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
+-- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
+-- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
+
+insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
+insertLookupWithKey f k x t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> x `seq` (Nothing `strictPair` join k (Tip k x) p t)
+ | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found `strictPair` Bin p m l' r)
+ | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found `strictPair` Bin p m l r')
+ Tip ky y
+ | k==ky -> (Just y `strictPair` (Tip k $! f k x y))
+ | otherwise -> x `seq` (Nothing `strictPair` join k (Tip k x) ky t)
+ Nil -> x `seq` (Nothing `strictPair` Tip k x)
+
+
+{--------------------------------------------------------------------
+ Deletion
+ [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
+--------------------------------------------------------------------}
+-- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
+-- a member of the map, the original map is returned.
+--
+-- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
+-- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > adjust ("new " ++) 7 empty == empty
+
+adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
+adjust f k m
+ = adjustWithKey (\_ x -> f x) k m
+
+-- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
+-- a member of the map, the original map is returned.
+--
+-- > let f key x = (show key) ++ ":new " ++ x
+-- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
+-- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > adjustWithKey f 7 empty == empty
+
+adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
+adjustWithKey f
+ = updateWithKey (\k' x -> Just (f k' x))
+
+-- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
+-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
+--
+-- > let f x = if x == "a" then Just "new a" else Nothing
+-- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
+-- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
+update f
+ = updateWithKey (\_ x -> f x)
+
+-- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
+-- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y at .
+--
+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+-- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
+-- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
+-- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
+updateWithKey f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> t
+ | zero k m -> bin p m (updateWithKey f k l) r
+ | otherwise -> bin p m l (updateWithKey f k r)
+ Tip ky y
+ | k==ky -> case (f k y) of
+ Just y' -> y' `seq` Tip ky y'
+ Nothing -> Nil
+ | otherwise -> t
+ Nil -> Nil
+
+-- | /O(min(n,W))/. Lookup and update.
+-- The function returns original value, if it is updated.
+-- This is different behavior than 'Data.Map.updateLookupWithKey'.
+-- Returns the original key value if the map entry is deleted.
+--
+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
+-- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])
+-- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
+-- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
+
+updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
+updateLookupWithKey f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> (Nothing, t)
+ | zero k m -> let (found,l') = updateLookupWithKey f k l in (found `strictPair` bin p m l' r)
+ | otherwise -> let (found,r') = updateLookupWithKey f k r in (found `strictPair` bin p m l r')
+ Tip ky y
+ | k==ky -> case (f k y) of
+ Just y' -> y' `seq` (Just y `strictPair` Tip ky y')
+ Nothing -> (Just y, Nil)
+ | otherwise -> (Nothing,t)
+ Nil -> (Nothing,Nil)
+
+
+
+-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
+alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
+alter f k t = k `seq`
+ case t of
+ Bin p m l r
+ | nomatch k p m -> case f Nothing of
+ Nothing -> t
+ Just x -> x `seq` join k (Tip k x) p t
+ | zero k m -> bin p m (alter f k l) r
+ | otherwise -> bin p m l (alter f k r)
+ Tip ky y
+ | k==ky -> case f (Just y) of
+ Just x -> x `seq` Tip ky x
+ Nothing -> Nil
+ | otherwise -> case f Nothing of
+ Just x -> x `seq` join k (Tip k x) ky t
+ Nothing -> t
+ Nil -> case f Nothing of
+ Just x -> x `seq` Tip k x
+ Nothing -> Nil
+
+
+{--------------------------------------------------------------------
+ Union
+--------------------------------------------------------------------}
+-- | The union of a list of maps, with a combining operation.
+--
+-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
+-- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
+
+unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
+unionsWith f ts
+ = foldlStrict (unionWith f) empty ts
+
+-- | /O(n+m)/. The union with a combining function.
+--
+-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
+
+unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
+unionWith f m1 m2
+ = unionWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. The union with a combining function.
+--
+-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
+-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
+
+unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
+unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = union1
+ | shorter m2 m1 = union2
+ | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
+ | otherwise = join p1 t1 p2 t2
+ where
+ union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
+ | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
+ | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
+
+ union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
+ | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
+ | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
+
+unionWithKey f (Tip k x) t = insertWithKey f k x t
+unionWithKey f t (Tip k x) = insertWithKey (\k' x' y' -> f k' y' x') k x t -- right bias
+unionWithKey _ Nil t = t
+unionWithKey _ t Nil = t
+
+{--------------------------------------------------------------------
+ Difference
+--------------------------------------------------------------------}
+
+-- | /O(n+m)/. Difference with a combining function.
+--
+-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
+-- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
+-- > == singleton 3 "b:B"
+
+differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
+differenceWith f m1 m2
+ = differenceWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. Difference with a combining function. When two equal keys are
+-- encountered, the combining function is applied to the key and both values.
+-- If it returns 'Nothing', the element is discarded (proper set difference).
+-- If it returns (@'Just' y@), the element is updated with a new value @y at .
+--
+-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
+-- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
+-- > == singleton 3 "3:b|B"
+
+differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
+differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = difference1
+ | shorter m2 m1 = difference2
+ | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
+ | otherwise = t1
+ where
+ difference1 | nomatch p2 p1 m1 = t1
+ | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
+ | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
+
+ difference2 | nomatch p1 p2 m2 = t1
+ | zero p1 m2 = differenceWithKey f t1 l2
+ | otherwise = differenceWithKey f t1 r2
+
+differenceWithKey f t1@(Tip k x) t2
+ = case lookup k t2 of
+ Just y -> case f k x y of
+ Just y' -> y' `seq` Tip k y'
+ Nothing -> Nil
+ Nothing -> t1
+
+differenceWithKey _ Nil _ = Nil
+differenceWithKey f t (Tip k y) = updateWithKey (\k' x -> f k' x y) k t
+differenceWithKey _ t Nil = t
+
+
+{--------------------------------------------------------------------
+ Intersection
+--------------------------------------------------------------------}
+
+-- | /O(n+m)/. The intersection with a combining function.
+--
+-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
+
+intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
+intersectionWith f m1 m2
+ = intersectionWithKey (\_ x y -> f x y) m1 m2
+
+-- | /O(n+m)/. The intersection with a combining function.
+--
+-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
+-- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
+
+intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
+intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = intersection1
+ | shorter m2 m1 = intersection2
+ | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
+ | otherwise = Nil
+ where
+ intersection1 | nomatch p2 p1 m1 = Nil
+ | zero p2 m1 = intersectionWithKey f l1 t2
+ | otherwise = intersectionWithKey f r1 t2
+
+ intersection2 | nomatch p1 p2 m2 = Nil
+ | zero p1 m2 = intersectionWithKey f t1 l2
+ | otherwise = intersectionWithKey f t1 r2
+
+intersectionWithKey f (Tip k x) t2
+ = case lookup k t2 of
+ Just y -> Tip k $! f k x y
+ Nothing -> Nil
+intersectionWithKey f t1 (Tip k y)
+ = case lookup k t1 of
+ Just x -> Tip k $! f k x y
+ Nothing -> Nil
+intersectionWithKey _ Nil _ = Nil
+intersectionWithKey _ _ Nil = Nil
+
+
+{--------------------------------------------------------------------
+ Min\/Max
+--------------------------------------------------------------------}
+
+-- | /O(log n)/. Update the value at the minimal key.
+--
+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKey f t
+ = case t of
+ Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
+ Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
+ Tip k y -> Tip k $! f k y
+ Nil -> error "maxView: empty map has no maximal element"
+
+updateMinWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKeyUnsigned f t
+ = case t of
+ Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
+ Tip k y -> Tip k $! f k y
+ Nil -> error "updateMinWithKeyUnsigned Nil"
+
+-- | /O(log n)/. Update the value at the maximal key.
+--
+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+
+updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKey f t
+ = case t of
+ Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
+ Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
+ Tip k y -> Tip k $! f k y
+ Nil -> error "maxView: empty map has no maximal element"
+
+updateMaxWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKeyUnsigned f t
+ = case t of
+ Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
+ Tip k y -> Tip k $! f k y
+ Nil -> error "updateMaxWithKeyUnsigned Nil"
+
+
+-- | /O(log n)/. Update the value at the maximal key.
+--
+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
+
+updateMax :: (a -> a) -> IntMap a -> IntMap a
+updateMax f = updateMaxWithKey (const f)
+
+-- | /O(log n)/. Update the value at the minimal key.
+--
+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
+
+updateMin :: (a -> a) -> IntMap a -> IntMap a
+updateMin f = updateMinWithKey (const f)
+
+
+{--------------------------------------------------------------------
+ Mapping
+--------------------------------------------------------------------}
+-- | /O(n)/. Map a function over all values in the map.
+--
+-- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
+
+map :: (a -> b) -> IntMap a -> IntMap b
+map f = mapWithKey (\_ x -> f x)
+
+-- | /O(n)/. Map a function over all values in the map.
+--
+-- > let f key x = (show key) ++ ":" ++ x
+-- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
+
+mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
+mapWithKey f t
+ = case t of
+ Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
+ Tip k x -> Tip k $! f k x
+ Nil -> Nil
+
+-- | /O(n)/. The function @'mapAccum'@ threads an accumulating
+-- argument through the map in ascending order of keys.
+--
+-- > let f a b = (a ++ b, b ++ "X")
+-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
+
+mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)
+
+-- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
+-- argument through the map in ascending order of keys.
+--
+-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
+
+mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumWithKey f a t
+ = mapAccumL f a t
+
+-- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
+-- argument through the map in ascending order of keys. Strict in
+-- the accumulating argument and the both elements of the
+-- result of the function.
+mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumL f a t
+ = case t of
+ Bin p m l r -> let (a1,l') = mapAccumL f a l
+ (a2,r') = mapAccumL f a1 r
+ in (a2 `strictPair` Bin p m l' r')
+ Tip k x -> let (a',x') = f a k x in x' `seq` (a' `strictPair` Tip k x')
+ Nil -> (a `strictPair` Nil)
+
+-- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
+-- argument through the map in descending order of keys.
+mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumRWithKey f a t
+ = case t of
+ Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
+ (a2,l') = mapAccumRWithKey f a1 l
+ in (a2 `strictPair` Bin p m l' r')
+ Tip k x -> let (a',x') = f a k x in x' `seq` (a' `strictPair` Tip k x')
+ Nil -> (a `strictPair` Nil)
+
+{--------------------------------------------------------------------
+ Filter
+--------------------------------------------------------------------}
+-- | /O(n)/. Map values and collect the 'Just' results.
+--
+-- > let f x = if x == "a" then Just "new a" else Nothing
+-- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
+
+mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
+mapMaybe f = mapMaybeWithKey (\_ x -> f x)
+
+-- | /O(n)/. Map keys\/values and collect the 'Just' results.
+--
+-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
+-- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
+
+mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
+mapMaybeWithKey f (Bin p m l r)
+ = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+mapMaybeWithKey f (Tip k x) = case f k x of
+ Just y -> y `seq` Tip k y
+ Nothing -> Nil
+mapMaybeWithKey _ Nil = Nil
+
+-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
+--
+-- > let f a = if a < "c" then Left a else Right a
+-- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
+-- >
+-- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+
+mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
+mapEither f m
+ = mapEitherWithKey (\_ x -> f x) m
+
+-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
+--
+-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
+-- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
+-- >
+-- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
+-- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
+
+mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
+mapEitherWithKey f (Bin p m l r)
+ = (bin p m l1 r1, bin p m l2 r2)
+ where
+ (l1,l2) = mapEitherWithKey f l
+ (r1,r2) = mapEitherWithKey f r
+mapEitherWithKey f (Tip k x) = case f k x of
+ Left y -> y `seq` (Tip k y, Nil)
+ Right z -> z `seq` (Nil, Tip k z)
+mapEitherWithKey _ Nil = (Nil, Nil)
+
+
+{--------------------------------------------------------------------
+ Lists
+--------------------------------------------------------------------}
+-- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
+--
+-- > fromList [] == empty
+-- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
+-- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
+
+fromList :: [(Key,a)] -> IntMap a
+fromList xs
+ = foldlStrict ins empty xs
+ where
+ ins t (k,x) = insert k x t
+
+-- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
+--
+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
+-- > fromListWith (++) [] == empty
+
+fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
+fromListWith f xs
+ = fromListWithKey (\_ x y -> f x y) xs
+
+-- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
+--
+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
+-- > fromListWith (++) [] == empty
+
+fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
+fromListWithKey f xs
+ = foldlStrict ins empty xs
+ where
+ ins t (k,x) = insertWithKey f k x t
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order.
+--
+-- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
+-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
+
+fromAscList :: [(Key,a)] -> IntMap a
+fromAscList xs
+ = fromAscListWithKey (\_ x _ -> x) xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
+--
+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
+
+fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
+fromAscListWith f xs
+ = fromAscListWithKey (\_ x y -> f x y) xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
+--
+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
+
+fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
+fromAscListWithKey _ [] = Nil
+fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
+ where
+ -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
+ combineEq z [] = [z]
+ combineEq z@(kz,zz) (x@(kx,xx):xs)
+ | kx==kz = let yy = f kx xx zz in yy `seq` combineEq (kx,yy) xs
+ | otherwise = z:combineEq x xs
+
+-- | /O(n)/. Build a map from a list of key\/value pairs where
+-- the keys are in ascending order and all distinct.
+-- /The precondition (input list is strictly ascending) is not checked./
+--
+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
+
+#ifdef __GLASGOW_HASKELL__
+fromDistinctAscList :: forall a. [(Key,a)] -> IntMap a
+#else
+fromDistinctAscList :: [(Key,a)] -> IntMap a
+#endif
+fromDistinctAscList [] = Nil
+fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
+ where
+ work (kx,vx) [] stk = vx `seq` finish kx (Tip kx vx) stk
+ work (kx,vx) (z@(kz,_):zs) stk = vx `seq` reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
+
+#ifdef __GLASGOW_HASKELL__
+ reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
+#endif
+ reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
+ reduce z zs m px tx stk@(Push py ty stk') =
+ let mxy = branchMask px py
+ pxy = mask px mxy
+ in if shorter m mxy
+ then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
+ else work z zs (Push px tx stk)
+
+ finish _ t Nada = t
+ finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+ where m = branchMask px py
+ p = mask px m
+
+data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
+
+
+{--------------------------------------------------------------------
+ Utility
+--------------------------------------------------------------------}
+
+strictPair :: a -> b -> (a, b)
+strictPair x y = x `seq` y `seq` (x, y)
+{-# INLINE strictPair #-}
diff --git a/containers.cabal b/containers.cabal
index ed339ba..a8a1cb7 100644
--- a/containers.cabal
+++ b/containers.cabal
@@ -24,8 +24,12 @@ Library {
ghc-options: -O2
if impl(ghc>6.10)
Ghc-Options: -fregs-graph
+ other-modules:
+ Data.IntMap.Common
exposed-modules:
Data.IntMap
+ Data.IntMap.Strict
+ Data.IntMap.Lazy
Data.IntSet
Data.Map
Data.Set
--
1.7.6
More information about the Libraries
mailing list