containers 0.1.0.1 → 0.2.0.0

raw patch · 9 files changed

+1524/−573 lines, 9 filesdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Graph.hs +11/−6
• Data/IntMap.hs +491/−169
• Data/IntSet.hs +83/−81
• Data/Map.hs +701/−201
• Data/Sequence.hs +35/−18
• Data/Set.hs +116/−86
• Data/Tree.hs +3/−4
• containers.cabal +15/−8
• include/Typeable.h +69/−0

@@ -374,9 +374,13 @@ -- Algorithm 5: Classifying edges ------------------------------------------------------------ +{-+XXX unused code+ tree              :: Bounds -> Forest Vertex -> Graph tree bnds ts       = buildG bnds (concat (map flat ts))- where flat (Node v ts) = [ (v, w) | Node w _us <- ts ] ++ concat (map flat ts)+ where flat (Node v ts') = [ (v, w) | Node w _us <- ts' ]+                        ++ concat (map flat ts')  back              :: Graph -> Table Int -> Graph back g post        = mapT select g@@ -387,8 +391,9 @@  where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]  forward           :: Graph -> Graph -> Table Int -> Graph-forward g tree pre = mapT select g- where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v+forward g tree' pre = mapT select g+ where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree' ! v+-}  ------------------------------------------------------------ -- Algorithm 6: Finding reachable vertices@@ -418,15 +423,15 @@ do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us  where us = map (do_label g dnum) ts        lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]-                     ++ [lu | Node (u,du,lu) xs <- us])+                     ++ [lu | Node (_,_,lu) _ <- us])  bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex] bicomps (Node (v,_,_) ts)-      = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]+      = [ Node (v:vs) us | (_,Node vs us) <- map collect ts]  collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex]) collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)  where collected = map collect ts-       vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]+       vs = concat [ ws | (lw, Node ws _) <- collected, lw<dv]        cs = concat [ if lw<dv then us else [Node (v:ws) us]                         | (lw, Node ws us) <- collected ]

@@ -1,8 +1,9 @@-{-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-} +{-# OPTIONS_GHC -cpp -XNoBangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.IntMap -- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008 -- License     :  BSD-style -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional@@ -30,6 +31,8 @@ --      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'@@ -162,10 +165,10 @@ import Data.Bits  import qualified Data.IntSet as IntSet import Data.Monoid (Monoid(..))+import Data.Maybe (fromMaybe) import Data.Typeable import Data.Foldable (Foldable(foldMap)) import Control.Monad ( liftM )-import Control.Arrow (ArrowZero) {- -- just for testing import qualified Prelude@@ -176,8 +179,7 @@  #if __GLASGOW_HASKELL__ import Text.Read-import Data.Generics.Basics (Data(..), mkNorepType)-import Data.Generics.Instances ()+import Data.Data (Data(..), mkNorepType) #endif  #if __GLASGOW_HASKELL__ >= 503@@ -217,11 +219,14 @@  -- | /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 --- | /O(n+m)/. See 'difference'.+-- | Same as 'difference'. (\\) :: IntMap a -> IntMap b -> IntMap a m1 \\ m2 = difference m1 m2 @@ -243,7 +248,7 @@     mconcat = unions  instance Foldable IntMap where-    foldMap f Nil = mempty+    foldMap _ Nil = mempty     foldMap f (Tip _k v) = f v     foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r @@ -269,43 +274,54 @@   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 other = False+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 p m l r -> size l + size r-      Tip k x -> 1+      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 x  -> True-    +      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 --- | /O(min(n,W))/. Lookup the value at a key in the map.-lookup :: (Monad m) => Key -> IntMap a -> m a-lookup k t = case lookup' k t of-    Just x -> return x-    Nothing -> fail "Data.IntMap.lookup: Key not found"--lookup' :: Key -> IntMap a -> Maybe a-lookup' k t+-- | /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 t   = let nk = natFromInt k  in seq nk (lookupN nk t)  lookupN :: Nat -> IntMap a -> Maybe a lookupN k t   = case t of-      Bin p m l r +      Bin _ m l r          | zeroN k (natFromInt m) -> lookupN k l         | otherwise              -> lookupN k r       Tip kx x @@ -323,6 +339,10 @@ -- | /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@@ -333,11 +353,19 @@   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@@ -349,6 +377,11 @@ -- 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   = case t of@@ -356,7 +389,7 @@         | 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 y +      Tip ky _         | k==ky         -> Tip k x         | otherwise     -> join k (Tip k x) ky t       Nil -> Tip k x@@ -367,15 +400,26 @@ -- 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@.+--+-- > 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 (\k x y -> f x y) 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@.+--+-- > 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   = case t of@@ -392,6 +436,18 @@ -- | /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   = case t of@@ -411,6 +467,11 @@ --------------------------------------------------------------------} -- | /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   = case t of@@ -418,33 +479,56 @@         | 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 y +      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 (\k x -> f x) 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 k m-  = updateWithKey (\k x -> Just (f k x)) k m+  = updateWithKey (\k' x -> Just (f k' x)) k m  -- | /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@.+--+-- > 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 k m-  = updateWithKey (\k x -> f x) k m+  = updateWithKey (\_ x -> f x) k m  -- | /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@.+--+-- > 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   = case t of@@ -460,6 +544,15 @@       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   = case t of@@ -477,8 +570,9 @@   -- | /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 a 'Map'.--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@+-- '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) -> Int -> IntMap a -> IntMap a alter f k t   = case t of       Bin p m l r @@ -503,18 +597,31 @@   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+-- | 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. +-- | /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@@ -531,16 +638,23 @@             | otherwise         = Bin p2 m2 l2 (union t1 r2)  union (Tip k x) t = insert k x t-union t (Tip k x) = insertWith (\x y -> y) k x t  -- right bias+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. +-- | /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 (\k x y -> f x y) m1 m2+  = unionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The union with a combining function. +-- | /O(n+m)/. The union with a combining function.+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_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@@ -557,14 +671,17 @@             | 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 f Nil t  = t-unionWithKey f t Nil  = 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). +-- | /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@@ -580,23 +697,33 @@                 | zero p1 m2        = difference t1 l2                 | otherwise         = difference t1 r2 -difference t1@(Tip k x) t2 +difference t1@(Tip k _) t2   | member k t2  = Nil   | otherwise    = t1 -difference Nil t       = Nil-difference t (Tip k x) = delete k t+difference Nil _       = Nil+difference t (Tip k _) = delete k t difference t Nil       = t --- | /O(n+m)/. Difference with a combining function. +-- | /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 (\k x y -> f x y) 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@. +--+-- > 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@@ -619,15 +746,18 @@                    Nothing -> Nil       Nothing -> t1 -differenceWithKey f Nil t       = Nil-differenceWithKey f t (Tip k y) = updateWithKey (\k x -> f k x y) k t-differenceWithKey f t Nil       = t+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). +-- | /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@@ -643,22 +773,29 @@                   | zero p1 m2        = intersection t1 l2                   | otherwise         = intersection t1 r2 -intersection t1@(Tip k x) t2 +intersection t1@(Tip k _) t2   | member k t2  = t1   | otherwise    = Nil-intersection t (Tip k x) +intersection t (Tip k _)   = case lookup k t of       Just y  -> Tip k y       Nothing -> Nil-intersection Nil t = Nil-intersection t Nil = Nil+intersection Nil _ = Nil+intersection _ Nil = Nil --- | /O(n+m)/. The intersection with a combining function. +-- | /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 -> a) -> IntMap a -> IntMap b -> IntMap a intersectionWith f m1 m2-  = intersectionWithKey (\k x y -> f x y) m1 m2+  = intersectionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The intersection with a combining function. +-- | /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 -> a) -> IntMap a -> IntMap b -> IntMap a intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)   | shorter m1 m2  = intersection1@@ -674,7 +811,7 @@                   | zero p1 m2        = intersectionWithKey f t1 l2                   | otherwise         = intersectionWithKey f t1 r2 -intersectionWithKey f t1@(Tip k x) t2 +intersectionWithKey f (Tip k x) t2   = case lookup k t2 of       Just y  -> Tip k (f k x y)       Nothing -> Nil@@ -682,8 +819,8 @@   = case lookup k t1 of       Just x  -> Tip k (f k x y)       Nothing -> Nil-intersectionWithKey f Nil t = Nil-intersectionWithKey f t Nil = Nil+intersectionWithKey _ Nil _ = Nil+intersectionWithKey _ _ Nil = Nil   {--------------------------------------------------------------------@@ -691,108 +828,142 @@ --------------------------------------------------------------------}  -- | /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 l in Bin p m t' r-        Bin p m l r         -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'+        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 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 "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 r in Bin p m r t'-        Bin p m l r         -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' l+        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) couple of the map, and the map stripped from that element.--- @fail@s (in the monad) when passed an empty map.-maxViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)+-- | /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 return (result, bin p m t' r)-        Bin p m l r         -> let (result, t') = maxViewUnsigned r in return (result, bin p m l t')-        Tip k y -> return ((k,y), Nil)-        Nil -> fail "maxView: empty map has no maximal element"+        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) couple of the map, and the map stripped from that element.--- @fail@s (in the monad) when passed an empty map.-minViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)+-- | /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 return (result, bin p m l t')-        Bin p m l r         -> let (result, t') = minViewUnsigned l in return (result, bin p m t' r)-        Tip k y -> return ((k,y),Nil)-        Nil -> fail "minView: empty map has no minimal element"+        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) ---- Duplicate the Identity monad here because base < mtl.-newtype Identity a = Identity { runIdentity :: a }-instance Monad Identity where-	return a = Identity a-	m >>= k  = k (runIdentity m) -- 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 from that element.--- @fail@s (in the monad) when passed an empty map.+-- | /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 from that element.--- @fail@s (in the monad) when passed an empty map.+-- | /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 = runIdentity . maxView+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 = runIdentity . minView+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 = fst . runIdentity . minView+findMin :: IntMap a -> a+findMin = maybe (error "findMin: empty map has no minimal element") fst . minView  -- | /O(log n)/. The maximal key of the map.-findMax = fst . runIdentity . maxView+findMax :: IntMap a -> a+findMax = maybe (error "findMax: empty map has no maximal element") fst . maxView  -- | /O(log n)/. Delete the minimal key.-deleteMin = snd . runIdentity . minView+deleteMin :: IntMap a -> IntMap a+deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView  -- | /O(log n)/. Delete the maximal key.-deleteMax = snd . runIdentity . maxView+deleteMax :: IntMap a -> IntMap a+deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView   {--------------------------------------------------------------------@@ -821,36 +992,37 @@   > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)]) -} isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool-isProperSubmapOfBy pred t1 t2-  = case submapCmp pred t1 t2 of +isProperSubmapOfBy predicate t1 t2+  = case submapCmp predicate t1 t2 of       LT -> True-      ge -> False+      _  -> False -submapCmp pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+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 pred t1 l2-                | otherwise         = submapCmp pred t1 r2-    submapCmpEq = case (submapCmp pred l1 l2, submapCmp pred r1 r2) of+                | 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-                    other   -> LT+                    _       -> LT -submapCmp pred (Bin p m l r) t  = GT-submapCmp pred (Tip kx x) (Tip ky y)  -  | (kx == ky) && pred x y = EQ-  | otherwise              = GT  -- disjoint-submapCmp pred (Tip k x) t      +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  | pred x y -> LT-     other   -> GT -- disjoint-submapCmp pred Nil Nil = EQ-submapCmp pred Nil t   = LT+     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' (==)@).@@ -858,7 +1030,7 @@ isSubmapOf m1 m2   = isSubmapOfBy (==) m1 m2 -{- | /O(n+m)/. +{- | /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 @@ -874,28 +1046,34 @@   > 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 pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+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 pred t1 l2-                                                      else isSubmapOfBy pred t1 r2)                     -  | otherwise      = (p1==p2) && isSubmapOfBy pred l1 l2 && isSubmapOfBy pred r1 r2-isSubmapOfBy pred (Bin p m l r) t  = False-isSubmapOfBy pred (Tip k x) t      = case lookup k t of-                                   Just y  -> pred x y-                                   Nothing -> False -isSubmapOfBy pred Nil t            = True+  | 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 m-  = mapWithKey (\k x -> f x) m+  = mapWithKey (\_ x -> f x) m  -- | /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@@ -905,12 +1083,20 @@  -- | /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 a m-  = mapAccumWithKey (\a k x -> f a x) a m+  = mapAccumWithKey (\a' _ x -> f a' x) a m  -- | /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@@ -926,6 +1112,8 @@       Tip k x     -> let (a',x') = f a k x in (a',Tip k x')       Nil         -> (a,Nil) +{-+XXX unused code  -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating -- argument throught the map in descending order of keys.@@ -937,68 +1125,111 @@                      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 (\k x -> p x) 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 pred t+filterWithKey predicate t   = case t of       Bin p m l r -        -> bin p m (filterWithKey pred l) (filterWithKey pred r)+        -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)       Tip k x -        | pred k x  -> t-        | otherwise -> Nil+        | predicate k x -> t+        | otherwise     -> Nil       Nil -> Nil --- | /O(n)/. partition the map according to some predicate. The first+-- | /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 (\k x -> p x) m+  = partitionWithKey (\_ x -> p x) m --- | /O(n)/. partition the map according to some predicate. The first+-- | /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 pred t+partitionWithKey predicate t   = case t of       Bin p m l r -        -> let (l1,l2) = partitionWithKey pred l-               (r1,r2) = partitionWithKey pred 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 -        | pred k x  -> (t,Nil)-        | otherwise -> (Nil,t)+        | 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 m-  = mapMaybeWithKey (\k x -> f x) m+  = mapMaybeWithKey (\_ x -> f x) m  -- | /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 f Nil = 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 (\k x -> f x) 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)@@ -1008,20 +1239,27 @@ mapEitherWithKey f (Tip k x) = case f k x of   Left y  -> (Tip k y, Nil)   Right z -> (Nil, Tip k z)-mapEitherWithKey f Nil = (Nil, Nil)+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@. Any key equal to @k@ is found in neither @map1@ nor @map2@.+--+-- > 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 p m l r +      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 y +      Tip ky _         | k>ky      -> (t,Nil)         | k<ky      -> (Nil,t)         | otherwise -> (Nil,Nil)@@ -1034,7 +1272,7 @@         | 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 y +      Tip ky _         | k>ky      -> (t,Nil)         | k<ky      -> (Nil,t)         | otherwise -> (Nil,Nil)@@ -1042,10 +1280,17 @@  -- | /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 p m l r+      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))@@ -1078,9 +1323,12 @@ -- -- > elems map = fold (:) [] map --+-- > let f a len = len + (length a)+-- > fold f 0 (fromList [(5,"a"), (3,"bbb")]) == 4+ fold :: (a -> b -> b) -> b -> IntMap a -> b fold f z t-  = foldWithKey (\k x y -> f x y) z t+  = foldWithKey (\_ x y -> f x y) z t  -- | /O(n)/. Fold the keys and values in the map, such that -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.@@ -1088,6 +1336,9 @@ -- -- > keys map = foldWithKey (\k x ks -> k:ks) [] map --+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"+ foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b foldWithKey f z t   = foldr f z t@@ -1103,7 +1354,7 @@ foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b foldr' f z t   = case t of-      Bin p m l r -> foldr' f (foldr' f z r) l+      Bin _ _ l r -> foldr' f (foldr' f z r) l       Tip k x     -> f k x z       Nil         -> z @@ -1114,21 +1365,37 @@ --------------------------------------------------------------------} -- | /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 m-  = foldWithKey (\k x xs -> x:xs) [] m  +  = foldWithKey (\_ x xs -> x:xs) [] m  -- | /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 m-  = foldWithKey (\k x ks -> k:ks) [] m+  = foldWithKey (\k _ ks -> k:ks) [] m  -- | /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@@ -1138,30 +1405,50 @@   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 t   = foldWithKey (\k x xs -> (k,x):xs) [] t  -- | /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,x) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos+    let (pos,neg) = span (\(k,_) -> k >=0) (foldr (\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'.+-- | /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 (\k x y -> f x y) 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'.+-- | /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@@ -1170,24 +1457,37 @@  -- | /O(n*min(n,W))/. 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   = fromList xs  -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys.+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+ fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f xs   = fromListWith f xs  -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys.+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+ fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f xs   = fromListWithKey f xs  -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order and all distinct.+--+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]+ fromDistinctAscList :: [(Key,a)] -> IntMap a fromDistinctAscList xs   = fromList xs@@ -1206,7 +1506,7 @@ equal (Tip kx x) (Tip ky y)   = (kx == ky) && (x==y) equal Nil Nil = True-equal t1 t2   = False+equal _   _   = False  nequal :: Eq a => IntMap a -> IntMap a -> Bool nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)@@ -1214,7 +1514,7 @@ nequal (Tip kx x) (Tip ky y)   = (kx /= ky) || (x/=y) nequal Nil Nil = False-nequal t1 t2   = True+nequal _   _   = True  {--------------------------------------------------------------------   Ord @@ -1238,6 +1538,9 @@   showsPrec d m   = showParen (d > 10) $     showString "fromList " . shows (toList m) +{-+XXX unused code+ showMap :: (Show a) => [(Key,a)] -> ShowS showMap []        = showString "{}" @@ -1245,9 +1548,10 @@   = showChar '{' . showElem x . showTail xs   where     showTail []     = showChar '}'-    showTail (x:xs) = showChar ',' . showElem x . showTail xs+    showTail (x':xs') = showChar ',' . showElem x' . showTail xs'     -    showElem (k,x)  = shows k . showString ":=" . shows x+    showElem (k,v)  = shows k . showString ":=" . shows v+-}  {--------------------------------------------------------------------   Read@@ -1319,10 +1623,12 @@       Tip k x           -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"        Nil -> showsBars bars . showString "|\n" -      -showBin p m++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@@ -1333,7 +1639,10 @@       [] -> id       _  -> showString (concat (reverse (tail bars))) . showString node +node :: String node           = "+--"++withBar, withEmpty :: [String] -> [String] withBar bars   = "|  ":bars withEmpty bars = "   ":bars @@ -1356,8 +1665,8 @@   @bin@ assures that we never have empty trees within a tree. --------------------------------------------------------------------} bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a-bin p m l Nil = l-bin p m Nil r = r+bin _ _ l Nil = l+bin _ _ Nil r = r bin p m l r   = Bin p m l r    @@ -1441,19 +1750,20 @@   machine code. The algorithm is derived from Jorg Arndt's FXT library. ----------------------------------------------------------------------} highestBitMask :: Nat -> Nat-highestBitMask x-  = case (x .|. shiftRL x 1) of -     x -> case (x .|. shiftRL x 2) of -      x -> case (x .|. shiftRL x 4) of -       x -> case (x .|. shiftRL x 8) of -        x -> case (x .|. shiftRL x 16) of -         x -> case (x .|. shiftRL x 32) of   -- for 64 bit platforms-          x -> (x `xor` (shiftRL x 1))+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))   {--------------------------------------------------------------------   Utilities  --------------------------------------------------------------------}+foldlStrict :: (a -> b -> a) -> a -> [b] -> a foldlStrict f z xs   = case xs of       []     -> z@@ -1546,4 +1856,16 @@ prop_List :: [Key] -> Bool prop_List xs   = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])+++{--------------------------------------------------------------------+  updateMin / updateMax +--------------------------------------------------------------------}+prop_UpdateMinMax :: [Key] -> Bool+prop_UpdateMinMax xs =+  let m = fromList [(x,0)|x<-xs]+      minKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMin succ $ m+      maxKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMax succ $ m+  in  all (>=minKey) xs && all (<=maxKey) xs+ -}

@@ -1,4 +1,4 @@-{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -cpp #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.IntSet@@ -106,6 +106,7 @@  import qualified Data.List as List import Data.Monoid (Monoid(..))+import Data.Maybe (fromMaybe) import Data.Typeable  {-@@ -118,8 +119,7 @@  #if __GLASGOW_HASKELL__ import Text.Read-import Data.Generics.Basics (Data(..), mkNorepType)-import Data.Generics.Instances ()+import Data.Data (Data(..), mkNorepType) #endif  #if __GLASGOW_HASKELL__ >= 503@@ -206,15 +206,15 @@ --------------------------------------------------------------------} -- | /O(1)/. Is the set empty? null :: IntSet -> Bool-null Nil   = True-null other = False+null Nil = True+null _   = False  -- | /O(n)/. Cardinality of the set. size :: IntSet -> Int size t   = case t of-      Bin p m l r -> size l + size r-      Tip y -> 1+      Bin _ _ l r -> size l + size r+      Tip _ -> 1       Nil   -> 0  -- | /O(min(n,W))/. Is the value a member of the set?@@ -240,10 +240,10 @@ lookupN :: Nat -> IntSet -> Maybe Int lookupN k t   = case t of-      Bin p m l r +      Bin _ m l r         | zeroN k (natFromInt m) -> lookupN k l         | otherwise              -> lookupN k r-      Tip kx +      Tip kx         | (k == natFromInt kx)  -> Just kx         | otherwise             -> Nothing       Nil -> Nothing@@ -361,7 +361,7 @@   | member x t2  = Nil   | otherwise    = t1 -difference Nil t     = Nil+difference Nil _     = Nil difference t (Tip x) = delete x t difference t Nil     = t @@ -393,8 +393,8 @@   = case lookup x t of       Just y  -> Tip y       Nothing -> Nil-intersection Nil t = Nil-intersection t Nil = Nil+intersection Nil _ = Nil+intersection _ Nil = Nil   @@ -406,9 +406,10 @@ isProperSubsetOf t1 t2   = case subsetCmp t1 t2 of        LT -> True-      ge -> False+      _  -> False -subsetCmp t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+subsetCmp :: IntSet -> IntSet -> Ordering+subsetCmp t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)   | shorter m1 m2  = GT   | shorter m2 m1  = case subsetCmpLt of                        GT -> GT@@ -423,9 +424,9 @@                     (GT,_ ) -> GT                     (_ ,GT) -> GT                     (EQ,EQ) -> EQ-                    other   -> LT+                    _       -> LT -subsetCmp (Bin p m l r) t  = GT+subsetCmp (Bin _ _ _ _) _  = GT subsetCmp (Tip x) (Tip y)     | x==y       = EQ   | otherwise  = GT  -- disjoint@@ -433,20 +434,20 @@   | member x t = LT   | otherwise  = GT  -- disjoint subsetCmp Nil Nil = EQ-subsetCmp Nil t   = LT+subsetCmp Nil _   = LT  -- | /O(n+m)/. Is this a subset? -- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.  isSubsetOf :: IntSet -> IntSet -> Bool-isSubsetOf t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+isSubsetOf 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 isSubsetOf t1 l2                                                       else isSubsetOf t1 r2)                        | otherwise      = (p1==p2) && isSubsetOf l1 l2 && isSubsetOf r1 r2-isSubsetOf (Bin p m l r) t  = False+isSubsetOf (Bin _ _ _ _) _  = False isSubsetOf (Tip x) t        = member x t-isSubsetOf Nil t            = True+isSubsetOf Nil _            = True   {--------------------------------------------------------------------@@ -454,38 +455,38 @@ --------------------------------------------------------------------} -- | /O(n)/. Filter all elements that satisfy some predicate. filter :: (Int -> Bool) -> IntSet -> IntSet-filter pred t+filter predicate t   = case t of       Bin p m l r -        -> bin p m (filter pred l) (filter pred r)+        -> bin p m (filter predicate l) (filter predicate r)       Tip x -        | pred x    -> t-        | otherwise -> Nil+        | predicate x -> t+        | otherwise   -> Nil       Nil -> Nil  -- | /O(n)/. partition the set according to some predicate. partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)-partition pred t+partition predicate t   = case t of       Bin p m l r -        -> let (l1,l2) = partition pred l-               (r1,r2) = partition pred r+        -> let (l1,l2) = partition predicate l+               (r1,r2) = partition predicate r            in (bin p m l1 r1, bin p m l2 r2)       Tip x -        | pred x    -> (t,Nil)-        | otherwise -> (Nil,t)+        | predicate x -> (t,Nil)+        | otherwise   -> (Nil,t)       Nil -> (Nil,Nil)   -- | /O(min(n,W))/. The expression (@'split' x set@) is a pair @(set1,set2)@--- where all elements in @set1@ are lower than @x@ and all elements in--- @set2@ larger than @x@.+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@. ----- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [3,4])+-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5]) split :: Int -> IntSet -> (IntSet,IntSet) split x t   = case t of-      Bin p m l r+      Bin _ m l r         | m < 0       -> if x >= 0 then let (lt,gt) = split' x l in (union r lt, gt)                                    else let (lt,gt) = split' x r in (lt, union gt l)                                    -- handle negative numbers.@@ -515,7 +516,7 @@ splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet) splitMember x t   = case t of-      Bin p m l r+      Bin _ m l r         | m < 0       -> if x >= 0 then let (lt,found,gt) = splitMember' x l in (union r lt, found, gt)                                    else let (lt,found,gt) = splitMember' x r in (lt, found, union gt l)                                    -- handle negative numbers.@@ -544,75 +545,67 @@   Min/Max ----------------------------------------------------------------------} --- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set stripped from that element--- @fail@s (in the monad) when passed an empty set.-maxView :: (Monad m) => IntSet -> m (Int, IntSet)+-- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+maxView :: IntSet -> Maybe (Int, IntSet) maxView t     = case t of-        Bin p m l r | m < 0 -> let (result,t') = maxViewUnsigned l in return (result, bin p m t' r)-        Bin p m l r         -> let (result,t') = maxViewUnsigned r in return (result, bin p m l t')            -        Tip y -> return (y,Nil)-        Nil -> fail "maxView: empty set has no maximal element"+        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 y -> Just (y,Nil)+        Nil -> Nothing  maxViewUnsigned :: IntSet -> (Int, IntSet) maxViewUnsigned t      = case t of         Bin p m l r -> let (result,t') = maxViewUnsigned r in (result, bin p m l t')         Tip y -> (y, Nil)+        Nil -> error "maxViewUnsigned Nil" --- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set stripped from that element--- @fail@s (in the monad) when passed an empty set.-minView :: (Monad m) => IntSet -> m (Int, IntSet)+-- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+minView :: IntSet -> Maybe (Int, IntSet) minView t     = case t of-        Bin p m l r | m < 0 -> let (result,t') = minViewUnsigned r in return (result, bin p m l t')            -        Bin p m l r         -> let (result,t') = minViewUnsigned l in return (result, bin p m t' r)-        Tip y -> return (y, Nil)-        Nil -> fail "minView: empty set has no minimal element"+        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 y -> Just (y, Nil)+        Nil -> Nothing  minViewUnsigned :: IntSet -> (Int, IntSet) minViewUnsigned t      = case t of         Bin p m l r -> let (result,t') = minViewUnsigned l in (result, bin p m t' r)         Tip y -> (y, Nil)----- Duplicate the Identity monad here because base < mtl.-newtype Identity a = Identity { runIdentity :: a }-instance Monad Identity where-	return a = Identity a-	m >>= k  = k (runIdentity m)-+        Nil -> error "minViewUnsigned Nil"  -- | /O(min(n,W))/. Delete and find the minimal element. --  -- > deleteFindMin set = (findMin set, deleteMin set) deleteFindMin :: IntSet -> (Int, IntSet)-deleteFindMin = runIdentity . minView+deleteFindMin = fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView  -- | /O(min(n,W))/. Delete and find the maximal element. --  -- > deleteFindMax set = (findMax set, deleteMax set) deleteFindMax :: IntSet -> (Int, IntSet)-deleteFindMax = runIdentity . maxView+deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView  -- | /O(min(n,W))/. The minimal element of a set. findMin :: IntSet -> Int-findMin = fst . runIdentity . minView+findMin = maybe (error "findMin: empty set has no minimal element") fst . minView  -- | /O(min(n,W))/. The maximal element of a set. findMax :: IntSet -> Int-findMax = fst . runIdentity . maxView+findMax = maybe (error "findMax: empty set has no maximal element") fst . maxView  -- | /O(min(n,W))/. Delete the minimal element. deleteMin :: IntSet -> IntSet-deleteMin = snd . runIdentity . minView+deleteMin = maybe (error "deleteMin: empty set has no minimal element") snd . minView  -- | /O(min(n,W))/. Delete the maximal element. deleteMax :: IntSet -> IntSet-deleteMax = snd . runIdentity . maxView--+deleteMax = maybe (error "deleteMax: empty set has no maximal element") snd . maxView  {----------------------------------------------------------------------   Map@@ -639,14 +632,14 @@   = case t of       Bin 0 m l r | m < 0 -> foldr f (foldr f z l) r         -- put negative numbers before.-      Bin p m l r -> foldr f z t+      Bin _ _ _ _ -> foldr f z t       Tip x       -> f x z       Nil         -> z  foldr :: (Int -> b -> b) -> b -> IntSet -> b foldr f z t   = case t of-      Bin p m l r -> foldr f (foldr f z r) l+      Bin _ _ l r -> foldr f (foldr f z r) l       Tip x       -> f x z       Nil         -> z           @@ -701,7 +694,7 @@ equal (Tip x) (Tip y)   = (x==y) equal Nil Nil = True-equal t1 t2   = False+equal _   _   = False  nequal :: IntSet -> IntSet -> Bool nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)@@ -709,7 +702,7 @@ nequal (Tip x) (Tip y)   = (x/=y) nequal Nil Nil = False-nequal t1 t2   = True+nequal _   _   = True  {--------------------------------------------------------------------   Ord @@ -726,6 +719,8 @@   showsPrec p xs = showParen (p > 10) $     showString "fromList " . shows (toList xs) +{-+XXX unused code showSet :: [Int] -> ShowS showSet []        = showString "{}" @@ -733,7 +728,8 @@   = showChar '{' . shows x . showTail xs   where     showTail []     = showChar '}'-    showTail (x:xs) = showChar ',' . shows x . showTail xs+    showTail (x':xs') = showChar ',' . shows x' . showTail xs'+-}  {--------------------------------------------------------------------   Read@@ -805,10 +801,12 @@       Tip x           -> showsBars bars . showString " " . shows x . showString "\n"        Nil -> showsBars bars . showString "|\n" -      -showBin p m++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@@ -819,7 +817,10 @@       [] -> id       _  -> showString (concat (reverse (tail bars))) . showString node +node :: String node           = "+--"++withBar, withEmpty :: [String] -> [String] withBar bars   = "|  ":bars withEmpty bars = "   ":bars @@ -842,8 +843,8 @@   @bin@ assures that we never have empty trees within a tree. --------------------------------------------------------------------} bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet-bin p m l Nil = l-bin p m Nil r = r+bin _ _ l Nil = l+bin _ _ Nil r = r bin p m l r   = Bin p m l r    @@ -928,19 +929,20 @@   machine code. The algorithm is derived from Jorg Arndt's FXT library. ----------------------------------------------------------------------} highestBitMask :: Nat -> Nat-highestBitMask x-  = case (x .|. shiftRL x 1) of -     x -> case (x .|. shiftRL x 2) of -      x -> case (x .|. shiftRL x 4) of -       x -> case (x .|. shiftRL x 8) of -        x -> case (x .|. shiftRL x 16) of -         x -> case (x .|. shiftRL x 32) of   -- for 64 bit platforms-          x -> (x `xor` (shiftRL x 1))+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))   {--------------------------------------------------------------------   Utilities  --------------------------------------------------------------------}+foldlStrict :: (a -> b -> a) -> a -> [b] -> a foldlStrict f z xs   = case xs of       []     -> z

@@ -1,9 +1,10 @@-{-# OPTIONS_GHC -fno-bang-patterns #-}+{-# OPTIONS_GHC -XNoBangPatterns #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Map -- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008 -- License     :  BSD-style -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional@@ -31,6 +32,9 @@ -- Note that the implementation is /left-biased/ -- the elements of a -- first argument are always preferred to the second, for example in -- 'union' or 'insert'.+--+-- Operation comments contain the operation time complexity in+-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>. -----------------------------------------------------------------------------  module Data.Map  ( @@ -92,9 +96,9 @@             , mapWithKey             , mapAccum             , mapAccumWithKey-	    , mapKeys-	    , mapKeysWith-	    , mapKeysMonotonic+            , mapKeys+            , mapKeysWith+            , mapKeysMonotonic              -- ** Fold             , fold@@ -103,7 +107,7 @@             -- * Conversion             , elems             , keys-	    , keysSet+            , keysSet             , assocs                          -- ** Lists@@ -170,10 +174,14 @@ import qualified Data.Set as Set import qualified Data.List as List import Data.Monoid (Monoid(..))-import Data.Typeable import Control.Applicative (Applicative(..), (<$>)) import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable(foldMap))+#ifndef __GLASGOW_HASKELL__+import Data.Typeable ( Typeable, typeOf, typeOfDefault+                     , Typeable1, typeOf1, typeOf1Default)+#endif+import Data.Typeable (Typeable2(..), TyCon, mkTyCon, mkTyConApp)  {- -- for quick check@@ -185,8 +193,7 @@  #if __GLASGOW_HASKELL__ import Text.Read-import Data.Generics.Basics-import Data.Generics.Instances+import Data.Data (Data(..), mkNorepType, gcast2) #endif  {--------------------------------------------------------------------@@ -196,10 +203,14 @@  -- | /O(log n)/. 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'+ (!) :: Ord k => Map k a -> k -> a m ! k    = find k m --- | /O(n+m)/. See 'difference'.+-- | Same as 'difference'. (\\) :: Ord k => Map k a -> Map k b -> Map k a m1 \\ m2 = difference m1 m2 @@ -227,7 +238,7 @@ -- We omit reflection services for the sake of data abstraction.  instance (Data k, Data a, Ord k) => Data (Map k a) where-  gfoldl f z map = z fromList `f` (toList map)+  gfoldl f z m   = z fromList `f` toList m   toConstr _     = error "toConstr"   gunfold _ _    = error "gunfold"   dataTypeOf _   = mkNorepType "Data.Map.Map"@@ -239,58 +250,94 @@   Query --------------------------------------------------------------------} -- | /O(1)/. Is the map empty?+--+-- > Data.Map.null (empty)           == True+-- > Data.Map.null (singleton 1 'a') == False+ null :: Map k a -> Bool null t   = case t of-      Tip             -> True-      Bin sz k x l r  -> False+      Tip    -> True+      Bin {} -> False  -- | /O(1)/. The number of elements in the map.+--+-- > size empty                                   == 0+-- > size (singleton 1 'a')                       == 1+-- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3+ size :: Map k a -> Int size t   = case t of       Tip             -> 0-      Bin sz k x l r  -> sz+      Bin sz _ _ _ _  -> sz  --- | /O(log n)/. Lookup the value at a key in the map. +-- | /O(log n)/. Lookup the value at a key in the map. ----- The function will --- @return@ the result in the monad or @fail@ in it the key isn't in the --- map. Often, the monad to use is 'Maybe', so you get either --- @('Just' result)@ or @'Nothing'@.-lookup :: (Monad m,Ord k) => k -> Map k a -> m a-lookup k t = case lookup' k t of-    Just x -> return x-    Nothing -> fail "Data.Map.lookup: Key not found"-lookup' :: Ord k => k -> Map k a -> Maybe a-lookup' k t+-- The function will return the corresponding value as @('Just' value)@,+-- or 'Nothing' if the key isn't in the map.+--+-- An example of using @lookup@:+--+-- > import Prelude hiding (lookup)+-- > import Data.Map+-- >+-- > employeeDept = fromList([("John","Sales"), ("Bob","IT")])+-- > deptCountry = fromList([("IT","USA"), ("Sales","France")])+-- > countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])+-- >+-- > employeeCurrency :: String -> Maybe String+-- > employeeCurrency name = do+-- >     dept <- lookup name employeeDept+-- >     country <- lookup dept deptCountry+-- >     lookup country countryCurrency+-- >+-- > main = do+-- >     putStrLn $ "John's currency: " ++ (show (employeeCurrency "John"))+-- >     putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete"))+--+-- The output of this program:+--+-- >   John's currency: Just "Euro"+-- >   Pete's currency: Nothing++lookup :: Ord k => k -> Map k a -> Maybe a+lookup k t   = case t of       Tip -> Nothing-      Bin sz kx x l r+      Bin _ kx x l r           -> case compare k kx of-               LT -> lookup' k l-               GT -> lookup' k r+               LT -> lookup k l+               GT -> lookup k r                EQ -> Just x         lookupAssoc :: Ord k => k -> Map k a -> Maybe (k,a) lookupAssoc  k t   = case t of       Tip -> Nothing-      Bin sz kx x l r+      Bin _ kx x l r           -> case compare k kx of                LT -> lookupAssoc k l                GT -> lookupAssoc k r                EQ -> Just (kx,x) --- | /O(log n)/. Is the key a member of the map?+-- | /O(log n)/. Is the key a member of the map? See also 'notMember'.+--+-- > member 5 (fromList [(5,'a'), (3,'b')]) == True+-- > member 1 (fromList [(5,'a'), (3,'b')]) == False+ member :: Ord k => k -> Map k a -> Bool member k m   = case lookup k m of       Nothing -> False-      Just x  -> True+      Just _  -> True --- | /O(log n)/. Is the key not a member of the map?+-- | /O(log n)/. Is the key not a member of the map? See also 'member'.+--+-- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False+-- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True+ notMember :: Ord k => k -> Map k a -> Bool notMember k m = not $ member k m @@ -303,7 +350,12 @@       Just x  -> x  -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns--- the value at key @k@ or returns @def@ when the key is not in the map.+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+--+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'+ findWithDefault :: Ord k => a -> k -> Map k a -> a findWithDefault def k m   = case lookup k m of@@ -316,11 +368,19 @@   Construction --------------------------------------------------------------------} -- | /O(1)/. The empty map.+--+-- > empty      == fromList []+-- > size empty == 0+ empty :: Map k a empty    = Tip  -- | /O(1)/. A map with a single element.+--+-- > singleton 1 'a'        == fromList [(1, 'a')]+-- > size (singleton 1 'a') == 1+ singleton :: k -> a -> Map k a singleton k x     = Bin 1 k x Tip Tip@@ -330,8 +390,13 @@ --------------------------------------------------------------------} -- | /O(log n)/. Insert a new key and value 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+-- replaced with the supplied value. '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 :: Ord k => k -> a -> Map k a -> Map k a insert kx x t   = case t of@@ -342,27 +407,38 @@                GT -> balance ky y l (insert kx x r)                EQ -> Bin sz kx x l r --- | /O(log n)/. Insert with a combining function.+-- | /O(log n)/. Insert with a function, combining new value and old value. -- @'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 the pair @(key, f new_value old_value)@.+--+-- > 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 :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith f k x m          -  = insertWithKey (\k x y -> f x y) k x m+  = insertWithKey (\_ x' y' -> f x' y') k x m  -- | Same as 'insertWith', but the combining function is applied strictly. insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith' f k x m          -  = insertWithKey' (\k x y -> f x y) k x m+  = insertWithKey' (\_ x' y' -> f x' y') k x m  --- | /O(log n)/. Insert with a combining function.+-- | /O(log n)/. Insert with a function, combining key, new value and old value. -- @'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 the pair @(key,f key new_value old_value)@. -- Note that the key passed to f is the same key passed to 'insertWithKey'.+--+-- > 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 :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey f kx x t   = case t of@@ -385,9 +461,22 @@                EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r)  --- | /O(log n)/. The expression (@'insertLookupWithKey' f k x map@)+-- | /O(log n)/. Combines insert operation with old value retrieval.+-- 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 :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a) insertLookupWithKey f kx x t   = case t of@@ -404,39 +493,68 @@ --------------------------------------------------------------------} -- | /O(log n)/. 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 :: Ord k => k -> Map k a -> Map k a delete k t   = case t of       Tip -> Tip-      Bin sx kx x l r +      Bin _ kx x l r           -> case compare k kx of                LT -> balance kx x (delete k l) r                GT -> balance kx x l (delete k r)                EQ -> glue l r --- | /O(log n)/. Adjust a value at a specific key. When the key is not+-- | /O(log n)/. Update a value at a specific key with the result of the provided function.+-- 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 :: Ord k => (a -> a) -> k -> Map k a -> Map k a adjust f k m-  = adjustWithKey (\k x -> f x) k m+  = adjustWithKey (\_ x -> f x) k m  -- | /O(log n)/. 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 :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a adjustWithKey f k m-  = updateWithKey (\k x -> Just (f k x)) k m+  = updateWithKey (\k' x' -> Just (f k' x')) k m  -- | /O(log n)/. 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@.+--+-- > 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 :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a update f k m-  = updateWithKey (\k x -> f x) k m+  = updateWithKey (\_ x -> f x) k m  -- | /O(log n)/. The expression (@'updateWithKey' 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@.+--+-- > 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 :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a updateWithKey f k t   = case t of@@ -449,7 +567,15 @@                        Just x' -> Bin sx kx x' l r                        Nothing -> glue l r --- | /O(log n)/. Lookup and update.+-- | /O(log n)/. Lookup and update. See also 'updateWithKey'.+-- The function returns changed value, if it is updated.+-- 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 "5:new 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 :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a) updateLookupWithKey f k t   = case t of@@ -464,7 +590,16 @@  -- | /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 a 'Map'.--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.+--+-- > let f _ = Nothing+-- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > alter f 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"+-- >+-- > let f _ = Just "c"+-- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")]+-- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]+ alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a alter f k t   = case t of@@ -485,6 +620,12 @@ -- | /O(log n)/. Return the /index/ of a key. The index is a number from -- /0/ up to, but not including, the 'size' of the map. Calls 'error' when -- the key is not a 'member' of the map.+--+-- > findIndex 2 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map+-- > findIndex 3 (fromList [(5,"a"), (3,"b")]) == 0+-- > findIndex 5 (fromList [(5,"a"), (3,"b")]) == 1+-- > findIndex 6 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map+ findIndex :: Ord k => k -> Map k a -> Int findIndex k t   = case lookupIndex k t of@@ -492,23 +633,32 @@       Just idx -> idx  -- | /O(log n)/. Lookup the /index/ of a key. The index is a number from--- /0/ up to, but not including, the 'size' of the map. -lookupIndex :: (Monad m,Ord k) => k -> Map k a -> m Int-lookupIndex k t = case lookup 0 t of-    Nothing -> fail "Data.Map.lookupIndex: Key not found."-    Just x -> return x+-- /0/ up to, but not including, the 'size' of the map.+--+-- > isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")]))   == False+-- > fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) == 0+-- > fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) == 1+-- > isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")]))   == False++lookupIndex :: Ord k => k -> Map k a -> Maybe Int+lookupIndex k t = f 0 t   where-    lookup idx Tip  = Nothing-    lookup idx (Bin _ kx x l r)+    f _   Tip  = Nothing+    f idx (Bin _ kx _ l r)       = case compare k kx of-          LT -> lookup idx l-          GT -> lookup (idx + size l + 1) r +          LT -> f idx l+          GT -> f (idx + size l + 1) r            EQ -> Just (idx + size l)  -- | /O(log n)/. Retrieve an element by /index/. Calls 'error' when an -- invalid index is used.+--+-- > elemAt 0 (fromList [(5,"a"), (3,"b")]) == (3,"b")+-- > elemAt 1 (fromList [(5,"a"), (3,"b")]) == (5, "a")+-- > elemAt 2 (fromList [(5,"a"), (3,"b")])    Error: index out of range+ elemAt :: Int -> Map k a -> (k,a)-elemAt i Tip = error "Map.elemAt: index out of range"+elemAt _ Tip = error "Map.elemAt: index out of range" elemAt i (Bin _ kx x l r)   = case compare i sizeL of       LT -> elemAt i l@@ -519,8 +669,18 @@  -- | /O(log n)/. Update the element at /index/. Calls 'error' when an -- invalid index is used.+--+-- > updateAt (\ _ _ -> Just "x") 0    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "x"), (5, "a")]+-- > updateAt (\ _ _ -> Just "x") 1    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "x")]+-- > updateAt (\ _ _ -> Just "x") 2    (fromList [(5,"a"), (3,"b")])    Error: index out of range+-- > updateAt (\ _ _ -> Just "x") (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range+-- > updateAt (\_ _  -> Nothing)  0    (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"+-- > updateAt (\_ _  -> Nothing)  1    (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"+-- > updateAt (\_ _  -> Nothing)  2    (fromList [(5,"a"), (3,"b")])    Error: index out of range+-- > updateAt (\_ _  -> Nothing)  (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range+ updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a-updateAt f i Tip  = error "Map.updateAt: index out of range"+updateAt _ _ Tip  = error "Map.updateAt: index out of range" updateAt f i (Bin sx kx x l r)   = case compare i sizeL of       LT -> balance kx x (updateAt f i l) r@@ -533,93 +693,148 @@  -- | /O(log n)/. Delete the element at /index/. -- Defined as (@'deleteAt' i map = 'updateAt' (\k x -> 'Nothing') i map@).+--+-- > deleteAt 0  (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"+-- > deleteAt 1  (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"+-- > deleteAt 2 (fromList [(5,"a"), (3,"b")])     Error: index out of range+-- > deleteAt (-1) (fromList [(5,"a"), (3,"b")])  Error: index out of range+ deleteAt :: Int -> Map k a -> Map k a-deleteAt i map-  = updateAt (\k x -> Nothing) i map+deleteAt i m+  = updateAt (\_ _ -> Nothing) i m   {--------------------------------------------------------------------   Minimal, Maximal --------------------------------------------------------------------}--- | /O(log n)/. The minimal key of the map.+-- | /O(log n)/. The minimal key of the map. Calls 'error' is the map is empty.+--+-- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")+-- > findMin empty                            Error: empty map has no minimal element+ findMin :: Map k a -> (k,a)-findMin (Bin _ kx x Tip r)  = (kx,x)-findMin (Bin _ kx x l r)    = findMin l+findMin (Bin _ kx x Tip _)  = (kx,x)+findMin (Bin _ _  _ l _)    = findMin l findMin Tip                 = error "Map.findMin: empty map has no minimal element" --- | /O(log n)/. The maximal key of the map.+-- | /O(log n)/. The maximal key of the map. Calls 'error' is the map is empty.+--+-- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")+-- > findMax empty                            Error: empty map has no maximal element+ findMax :: Map k a -> (k,a)-findMax (Bin _ kx x l Tip)  = (kx,x)-findMax (Bin _ kx x l r)    = findMax r+findMax (Bin _ kx x _ Tip)  = (kx,x)+findMax (Bin _ _  _ _ r)    = findMax r findMax Tip                 = error "Map.findMax: empty map has no maximal element" --- | /O(log n)/. Delete the minimal key.+-- | /O(log n)/. Delete the minimal key. Returns an empty map if the map is empty.+--+-- > deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(5,"a"), (7,"c")]+-- > deleteMin empty == empty+ deleteMin :: Map k a -> Map k a-deleteMin (Bin _ kx x Tip r)  = r+deleteMin (Bin _ _  _ Tip r)  = r deleteMin (Bin _ kx x l r)    = balance kx x (deleteMin l) r deleteMin Tip                 = Tip --- | /O(log n)/. Delete the maximal key.+-- | /O(log n)/. Delete the maximal key. Returns an empty map if the map is empty.+--+-- > deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(3,"b"), (5,"a")]+-- > deleteMax empty == empty+ deleteMax :: Map k a -> Map k a-deleteMax (Bin _ kx x l Tip)  = l+deleteMax (Bin _ _  _ l Tip)  = l deleteMax (Bin _ kx x l r)    = balance kx x l (deleteMax r) deleteMax Tip                 = Tip  -- | /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 -> Maybe a) -> Map k a -> Map k a updateMin f m-  = updateMinWithKey (\k x -> f x) m+  = updateMinWithKey (\_ x -> f x) m  -- | /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 -> Maybe a) -> Map k a -> Map k a updateMax f m-  = updateMaxWithKey (\k x -> f x) m+  = updateMaxWithKey (\_ x -> f x) m   -- | /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 :: (k -> a -> Maybe a) -> Map k a -> Map k a updateMinWithKey f t   = case t of       Bin sx kx x Tip r  -> case f kx x of                               Nothing -> r                               Just x' -> Bin sx kx x' Tip r-      Bin sx kx x l r    -> balance kx x (updateMinWithKey f l) r+      Bin _ kx x l r     -> balance kx x (updateMinWithKey f l) r       Tip                -> Tip  -- | /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 :: (k -> a -> Maybe a) -> Map k a -> Map k a updateMaxWithKey f t   = case t of       Bin sx kx x l Tip  -> case f kx x of                               Nothing -> l                               Just x' -> Bin sx kx x' l Tip-      Bin sx kx x l r    -> balance kx x l (updateMaxWithKey f r)+      Bin _ kx x l r     -> balance kx x l (updateMaxWithKey f r)       Tip                -> Tip --- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and the map stripped from that element--- @fail@s (in the monad) when passed an empty map.-minViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)-minViewWithKey Tip = fail "Map.minView: empty map"-minViewWithKey x = return (deleteFindMin x)+-- | /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 --- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and the map stripped from that element--- @fail@s (in the monad) when passed an empty map.-maxViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)-maxViewWithKey Tip = fail "Map.maxView: empty map"-maxViewWithKey x = return (deleteFindMax x)+minViewWithKey :: Map k a -> Maybe ((k,a), Map k a)+minViewWithKey Tip = Nothing+minViewWithKey x = Just (deleteFindMin x) --- | /O(log n)/. Retrieves the minimal key\'s value of the map, and the map stripped from that element--- @fail@s (in the monad) when passed an empty map.-minView :: Monad m => Map k a -> m (a, Map k a)-minView Tip = fail "Map.minView: empty map"-minView x = return (first snd $ deleteFindMin x)+-- | /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 --- | /O(log n)/. Retrieves the maximal key\'s value of the map, and the map stripped from that element--- @fail@s (in the monad) when passed an empty map.-maxView :: Monad m => Map k a -> m (a, Map k a)-maxView Tip = fail "Map.maxView: empty map"-maxView x = return (first snd $ deleteFindMax x)+maxViewWithKey :: Map k a -> Maybe ((k,a), Map k a)+maxViewWithKey Tip = Nothing+maxViewWithKey x = Just (deleteFindMax x) +-- | /O(log n)/. Retrieves the value associated with minimal key of the+-- map, and the map stripped of that element, or 'Nothing' if passed an+-- empty map.+--+-- > minView (fromList [(5,"a"), (3,"b")]) == Just ("b", singleton 5 "a")+-- > minView empty == Nothing++minView :: Map k a -> Maybe (a, Map k a)+minView Tip = Nothing+minView x = Just (first snd $ deleteFindMin x)++-- | /O(log n)/. Retrieves the value associated with maximal key of the+-- map, and the map stripped of that element, or 'Nothing' if passed an+--+-- > maxView (fromList [(5,"a"), (3,"b")]) == Just ("a", singleton 3 "b")+-- > maxView empty == Nothing++maxView :: Map k a -> Maybe (a, Map k a)+maxView Tip = Nothing+maxView x = Just (first snd $ deleteFindMax x)+ -- Update the 1st component of a tuple (special case of Control.Arrow.first) first :: (a -> b) -> (a,c) -> (b,c) first f (x,y) = (f x, y)@@ -629,12 +844,22 @@ --------------------------------------------------------------------} -- | The union of a list of maps: --   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).+--+-- > 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 :: Ord k => [Map k a] -> Map k a unions ts   = foldlStrict union empty ts  -- | The union of a list of maps, with a combining operation: --   (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).+--+-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]+-- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]+ unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a unionsWith f ts   = foldlStrict (unionWith f) empty ts@@ -644,14 +869,20 @@ -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). -- The implementation uses the efficient /hedge-union/ algorithm.--- Hedge-union is more efficient on (bigset `union` smallset)+-- Hedge-union is more efficient on (bigset \``union`\` smallset).+--+-- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]+ union :: Ord k => Map k a -> Map k a -> Map k a union Tip t2  = t2 union t1 Tip  = t1 union t1 t2 = hedgeUnionL (const LT) (const GT) t1 t2  -- left-biased hedge union-hedgeUnionL cmplo cmphi t1 Tip +hedgeUnionL :: Ord a+            => (a -> Ordering) -> (a -> Ordering) -> Map a b -> Map a b+            -> Map a b+hedgeUnionL _     _     t1 Tip   = t1 hedgeUnionL cmplo cmphi Tip (Bin _ kx x l r)   = join kx x (filterGt cmplo l) (filterLt cmphi r)@@ -661,8 +892,14 @@   where     cmpkx k  = compare kx k +{-+XXX unused code+ -- right-biased hedge union-hedgeUnionR cmplo cmphi t1 Tip +hedgeUnionR :: Ord a+            => (a -> Ordering) -> (a -> Ordering) -> Map a b -> Map a b+            -> Map a b+hedgeUnionR _     _     t1 Tip   = t1 hedgeUnionR cmplo cmphi Tip (Bin _ kx x l r)   = join kx x (filterGt cmplo l) (filterLt cmphi r)@@ -676,26 +913,39 @@     newx        = case found of                     Nothing -> x                     Just (_,y) -> y+-}  {--------------------------------------------------------------------   Union with a combining function --------------------------------------------------------------------} -- | /O(n+m)/. Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.+--+-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+ unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith f m1 m2-  = unionWithKey (\k x y -> f x y) m1 m2+  = unionWithKey (\_ x y -> f x y) m1 m2  -- | /O(n+m)/. -- Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.--- Hedge-union is more efficient on (bigset `union` smallset).+-- Hedge-union is more efficient on (bigset \``union`\` smallset).+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+ unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a-unionWithKey f Tip t2  = t2-unionWithKey f t1 Tip  = t1+unionWithKey _ Tip t2  = t2+unionWithKey _ t1 Tip  = t1 unionWithKey f t1 t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2 -hedgeUnionWithKey f cmplo cmphi t1 Tip +hedgeUnionWithKey :: Ord a+                  => (a -> b -> b -> b)+                  -> (a -> Ordering) -> (a -> Ordering)+                  -> Map a b -> Map a b+                  -> Map a b+hedgeUnionWithKey _ _     _     t1 Tip   = t1-hedgeUnionWithKey f cmplo cmphi Tip (Bin _ kx x l r)+hedgeUnionWithKey _ cmplo cmphi Tip (Bin _ kx x l r)   = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeUnionWithKey f cmplo cmphi (Bin _ kx x l r) t2   = join kx newx (hedgeUnionWithKey f cmplo cmpkx l lt) @@ -712,41 +962,67 @@   Difference --------------------------------------------------------------------} -- | /O(n+m)/. Difference of two maps. +-- Return elements of the first map not existing in the second map. -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.+--+-- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"+ difference :: Ord k => Map k a -> Map k b -> Map k a-difference Tip t2  = Tip+difference Tip _   = Tip difference t1 Tip  = t1 difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2 -hedgeDiff cmplo cmphi Tip t     +hedgeDiff :: Ord a+          => (a -> Ordering) -> (a -> Ordering) -> Map a b -> Map a c+          -> Map a b+hedgeDiff _     _     Tip _   = Tip hedgeDiff cmplo cmphi (Bin _ kx x l r) Tip    = join kx x (filterGt cmplo l) (filterLt cmphi r)-hedgeDiff cmplo cmphi t (Bin _ kx x l r) +hedgeDiff cmplo cmphi t (Bin _ kx _ l r)    = merge (hedgeDiff cmplo cmpkx (trim cmplo cmpkx t) l)            (hedgeDiff cmpkx cmphi (trim cmpkx cmphi t) r)   where     cmpkx k = compare kx k     -- | /O(n+m)/. Difference with a combining function. +-- When two equal keys are+-- encountered, the combining function is applied to the values of these keys.+-- 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@.  -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.+--+-- > 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 :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWith f m1 m2-  = differenceWithKey (\k x y -> f x y) 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@.  -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.+--+-- > 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 :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a-differenceWithKey f Tip t2  = Tip-differenceWithKey f t1 Tip  = t1+differenceWithKey _ Tip _   = Tip+differenceWithKey _ t1 Tip  = t1 differenceWithKey f t1 t2   = hedgeDiffWithKey f (const LT) (const GT) t1 t2 -hedgeDiffWithKey f cmplo cmphi Tip t     +hedgeDiffWithKey :: Ord a+                 => (a -> b -> c -> Maybe b)+                 -> (a -> Ordering) -> (a -> Ordering)+                 -> Map a b -> Map a c+                 -> Map a b+hedgeDiffWithKey _ _     _     Tip _   = Tip-hedgeDiffWithKey f cmplo cmphi (Bin _ kx x l r) Tip +hedgeDiffWithKey _ cmplo cmphi (Bin _ kx x l r) Tip   = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r)    = case found of@@ -767,19 +1043,30 @@ {--------------------------------------------------------------------   Intersection --------------------------------------------------------------------}--- | /O(n+m)/. Intersection of two maps. The values in the first--- map are returned, i.e. (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).+-- | /O(n+m)/. Intersection of two maps.+-- Return data in the first map for the keys existing in both maps.+-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).+--+-- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"+ intersection :: Ord k => Map k a -> Map k b -> Map k a intersection m1 m2-  = intersectionWithKey (\k x y -> x) m1 m2+  = intersectionWithKey (\_ x _ -> x) m1 m2  -- | /O(n+m)/. Intersection with a combining function.+--+-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"+ intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWith f m1 m2-  = intersectionWithKey (\k x y -> f x y) m1 m2+  = intersectionWithKey (\_ x y -> f x y) m1 m2  -- | /O(n+m)/. Intersection with a combining function.--- Intersection is more efficient on (bigset `intersection` smallset)+-- Intersection is more efficient on (bigset \``intersection`\` smallset).+--+-- > 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 :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c --intersectionWithKey f Tip t = Tip --intersectionWithKey f t Tip = Tip@@ -796,10 +1083,9 @@ --    tl            = intersectWithKey f lt l --    tr            = intersectWithKey f gt r - intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c-intersectionWithKey f Tip t = Tip-intersectionWithKey f t Tip = Tip+intersectionWithKey _ Tip _ = Tip+intersectionWithKey _ _ Tip = Tip intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =    if s1 >= s2 then       let (lt,found,gt) = splitLookupWithKey k2 t1@@ -820,13 +1106,14 @@ {--------------------------------------------------------------------   Submap --------------------------------------------------------------------}--- | /O(n+m)/. +-- | /O(n+m)/. -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).+-- isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isSubmapOf m1 m2   = isSubmapOfBy (==) m1 m2 -{- | /O(n+m)/. +{- | /O(n+m)/.  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if  all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when  applied to their respective values. For example, the following @@ -841,13 +1128,16 @@  > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])  > isSubmapOfBy (<)  (fromList [('a',1)]) (fromList [('a',1),('b',2)])  > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)])+ + -} isSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool isSubmapOfBy f t1 t2   = (size t1 <= size t2) && (submap' f t1 t2) -submap' f Tip t = True-submap' f t Tip = False+submap' :: Ord a => (b -> c -> Bool) -> Map a b -> Map a c -> Bool+submap' _ Tip _ = True+submap' _ _ Tip = False submap' f (Bin _ kx x l r) t   = case found of       Nothing -> False@@ -876,6 +1166,8 @@   > 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 :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool isProperSubmapOfBy f t1 t2@@ -885,30 +1177,48 @@   Filter and partition --------------------------------------------------------------------} -- | /O(n)/. Filter all values that satisfy the 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 :: Ord k => (a -> Bool) -> Map k a -> Map k a filter p m-  = filterWithKey (\k x -> p x) m+  = filterWithKey (\_ x -> p x) m  -- | /O(n)/. Filter all keys\/values that satisfy the predicate.+--+-- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"+ filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a-filterWithKey p Tip = Tip+filterWithKey _ Tip = Tip filterWithKey p (Bin _ kx x l r)   | p kx x    = join kx x (filterWithKey p l) (filterWithKey p r)   | otherwise = merge (filterWithKey p l) (filterWithKey p r)  --- | /O(n)/. partition the map according to a predicate. The first+-- | /O(n)/. Partition the map according to a 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 :: Ord k => (a -> Bool) -> Map k a -> (Map k a,Map k a) partition p m-  = partitionWithKey (\k x -> p x) m+  = partitionWithKey (\_ x -> p x) m --- | /O(n)/. partition the map according to a predicate. The first+-- | /O(n)/. Partition the map according to a 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 :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a,Map k a)-partitionWithKey p Tip = (Tip,Tip)+partitionWithKey _ Tip = (Tip,Tip) partitionWithKey p (Bin _ kx x l r)   | p kx x    = (join kx x l1 r1,merge l2 r2)   | otherwise = (merge l1 r1,join kx x l2 r2)@@ -917,26 +1227,50 @@     (r1,r2) = partitionWithKey p r  -- | /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 :: Ord k => (a -> Maybe b) -> Map k a -> Map k b mapMaybe f m-  = mapMaybeWithKey (\k x -> f x) m+  = mapMaybeWithKey (\_ x -> f x) m  -- | /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 :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b-mapMaybeWithKey f Tip = Tip+mapMaybeWithKey _ Tip = Tip mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of   Just y  -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)   Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)  -- | /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 :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEither f m-  = mapEitherWithKey (\k x -> f x) 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 :: Ord k =>   (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)-mapEitherWithKey f Tip = (Tip, Tip)+mapEitherWithKey _ Tip = (Tip, Tip) mapEitherWithKey f (Bin _ kx x l r) = case f kx x of   Left y  -> (join kx y l1 r1, merge l2 r2)   Right z -> (merge l1 r1, join kx z l2 r2)@@ -948,24 +1282,39 @@   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) -> Map k a -> Map k b map f m-  = mapWithKey (\k x -> f x) m+  = mapWithKey (\_ x -> f x) m  -- | /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 :: (k -> a -> b) -> Map k a -> Map k b-mapWithKey f Tip = Tip+mapWithKey _ Tip = Tip mapWithKey f (Bin sx kx x l r)    = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)  -- | /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 -> Map k b -> (a,Map k c) mapAccum f a m-  = mapAccumWithKey (\a k x -> f a x) a m+  = mapAccumWithKey (\a' _ x' -> f a' x') a m  -- | /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 -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumWithKey f a t   = mapAccumL f a t@@ -982,6 +1331,9 @@                  (a3,r') = mapAccumL f a2 r              in (a3,Bin sx kx x' l' r') +{-+XXX unused code+ -- | /O(n)/. The function 'mapAccumR' threads an accumulating -- argument throught the map in descending order of keys. mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)@@ -993,23 +1345,31 @@                  (a2,x') = f a1 kx x                  (a3,l') = mapAccumR f a2 l              in (a3,Bin sx kx x' l' r')+-} --- | /O(n*log n)/. +-- | /O(n*log n)/. -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. --  -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key.  In this case the value at the smallest of -- these keys is retained.+--+-- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])                        == fromList [(4, "b"), (6, "a")]+-- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"+-- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"  mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a-mapKeys = mapKeysWith (\x y->x)+mapKeys = mapKeysWith (\x _ -> x) --- | /O(n*log n)/. +-- | /O(n*log n)/. -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. --  -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key.  In this case the associated values will be -- combined using @c@.+--+-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"+-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"  mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . List.map fFirst . toList@@ -1019,15 +1379,23 @@ -- | /O(n)/. -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic.+-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. -- /The precondition is not checked./ -- Semi-formally, we have: --  -- > and [x < y ==> f x < f y | x <- ls, y <- ls]  -- >                     ==> mapKeysMonotonic f s == mapKeys f s -- >     where ls = keys s+--+-- This means that @f@ maps distinct original keys to distinct resulting keys.+-- This function has better performance than 'mapKeys'.+--+-- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]+-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) == True+-- > valid (mapKeysMonotonic (\ _ -> 1)     (fromList [(5,"a"), (3,"b")])) == False  mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a-mapKeysMonotonic f Tip = Tip+mapKeysMonotonic _ Tip = Tip mapKeysMonotonic f (Bin sz k x l r) =     Bin sz (f k) x (mapKeysMonotonic f l) (mapKeysMonotonic f r) @@ -1041,9 +1409,12 @@ -- -- > elems map = fold (:) [] map --+-- > let f a len = len + (length a)+-- > fold f 0 (fromList [(5,"a"), (3,"bbb")]) == 4+ fold :: (a -> b -> b) -> b -> Map k a -> b fold f z m-  = foldWithKey (\k x z -> f x z) z m+  = foldWithKey (\_ x' z' -> f x' z') z m  -- | /O(n)/. Fold the keys and values in the map, such that -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.@@ -1051,44 +1422,71 @@ -- -- > keys map = foldWithKey (\k x ks -> k:ks) [] map --+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"+ foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b foldWithKey f z t   = foldr f z t +{-+XXX unused code+ -- | /O(n)/. In-order fold. foldi :: (k -> a -> b -> b -> b) -> b -> Map k a -> b -foldi f z Tip               = z+foldi _ z Tip               = z foldi f z (Bin _ kx x l r)  = f kx x (foldi f z l) (foldi f z r)+-}  -- | /O(n)/. Post-order fold. foldr :: (k -> a -> b -> b) -> b -> Map k a -> b-foldr f z Tip              = z+foldr _ z Tip              = z foldr f z (Bin _ kx x l r) = foldr f (f kx x (foldr f z r)) l +{-+XXX unused code+ -- | /O(n)/. Pre-order fold. foldl :: (b -> k -> a -> b) -> b -> Map k a -> b-foldl f z Tip              = z+foldl _ z Tip              = z foldl f z (Bin _ kx x l r) = foldl f (f (foldl f z l) kx x) r+-}  {--------------------------------------------------------------------   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 :: Map k a -> [a] elems m-  = [x | (k,x) <- assocs m]+  = [x | (_,x) <- assocs m]  -- | /O(n)/. Return all keys of the map in ascending order.+--+-- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]+-- > keys empty == []+ keys  :: Map k a -> [k] keys m-  = [k | (k,x) <- assocs m]+  = [k | (k,_) <- assocs m]  -- | /O(n)/. The set of all keys of the map.+--+-- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [3,5]+-- > keysSet empty == Data.Set.empty+ keysSet :: Map k a -> Set.Set k keysSet m = Set.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 :: Map k a -> [(k,a)] assocs m   = toList m@@ -1098,6 +1496,13 @@   use [foldlStrict] to reduce demand on the control-stack --------------------------------------------------------------------} -- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.+-- If the list contains more than one value for the same key, the last value+-- for the key is retained.+--+-- > 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 :: Ord k => [(k,a)] -> Map k a  fromList xs          = foldlStrict ins empty xs@@ -1105,11 +1510,20 @@     ins t (k,x) = insert k x t  -- | /O(n*log n)/. Build 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 :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a  fromListWith f xs-  = fromListWithKey (\k x y -> f x y) xs+  = fromListWithKey (\_ x y -> f x y) xs  -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.+--+-- > let f k a1 a2 = (show k) ++ a1 ++ a2+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]+-- > fromListWithKey f [] == empty+ fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a  fromListWithKey f xs    = foldlStrict ins empty xs@@ -1117,17 +1531,27 @@     ins t (k,x) = insertWithKey f k x t  -- | /O(n)/. Convert to a list of key\/value pairs.+--+-- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]+-- > toList empty == []+ toList :: Map k a -> [(k,a)] toList t      = toAscList t  -- | /O(n)/. Convert to an ascending list.+--+-- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]+ toAscList :: Map k a -> [(k,a)] toAscList t   = foldr (\k x xs -> (k,x):xs) [] t --- | /O(n)/. +{-+XXX unused code++-- | /O(n)/. toDescList :: Map k a -> [(k,a)] toDescList t  = foldl (\xs k x -> (k,x):xs) [] t-+-}  {--------------------------------------------------------------------   Building trees from ascending/descending lists can be done in linear time.@@ -1138,54 +1562,78 @@ --------------------------------------------------------------------} -- | /O(n)/. Build a map from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./+--+-- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]+-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]+-- > valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) == True+-- > valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) == False+ fromAscList :: Eq k => [(k,a)] -> Map k a  fromAscList xs-  = fromAscListWithKey (\k x y -> x) xs+  = fromAscListWithKey (\_ x _ -> x) xs  -- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys. -- /The precondition (input list is ascending) is not checked./+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+-- > valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) == True+-- > valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False+ fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a  fromAscListWith f xs-  = fromAscListWithKey (\k x y -> f x y) xs+  = fromAscListWithKey (\_ x y -> f x y) xs  -- | /O(n)/. Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./+--+-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2+-- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]+-- > valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) == True+-- > valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+ fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a  fromAscListWithKey f xs   = fromDistinctAscList (combineEq f xs)   where   -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]-  combineEq f xs-    = case xs of+  combineEq _ xs'+    = case xs' of         []     -> []         [x]    -> [x]         (x:xx) -> combineEq' x xx    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+  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 an ascending list of distinct elements in linear time. -- /The precondition is not checked./+--+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]+-- > valid (fromDistinctAscList [(3,"b"), (5,"a")])          == True+-- > valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) == False+ fromDistinctAscList :: [(k,a)] -> Map k a  fromDistinctAscList xs   = build const (length xs) xs   where     -- 1) use continutations so that we use heap space instead of stack space.     -- 2) special case for n==5 to build bushier trees. -    build c 0 xs   = c Tip xs -    build c 5 xs   = case xs of+    build c 0 xs'  = c Tip xs'+    build c 5 xs'  = case xs' of                        ((k1,x1):(k2,x2):(k3,x3):(k4,x4):(k5,x5):xx)                              -> c (bin k4 x4 (bin k2 x2 (singleton k1 x1) (singleton k3 x3)) (singleton k5 x5)) xx-    build c n xs   = seq nr $ build (buildR nr c) nl xs+                       _ -> error "fromDistinctAscList build"+    build c n xs'  = seq nr $ build (buildR nr c) nl xs'                    where                      nl = n `div` 2                      nr = n - nl - 1      buildR n c l ((k,x):ys) = build (buildB l k x c) n ys+    buildR _ _ _ []         = error "fromDistinctAscList buildR []"     buildB l k x c r zs     = c (bin k x l r) zs                        @@ -1213,21 +1661,21 @@   empty or the key of the root is between @lo@ and @hi@. --------------------------------------------------------------------} trim :: (k -> Ordering) -> (k -> Ordering) -> Map k a -> Map k a-trim cmplo cmphi Tip = Tip-trim cmplo cmphi t@(Bin sx kx x l r)+trim _     _     Tip = Tip+trim cmplo cmphi t@(Bin _ kx _ l r)   = case cmplo kx of       LT -> case cmphi kx of               GT -> t-              le -> trim cmplo cmphi l-      ge -> trim cmplo cmphi r+              _  -> trim cmplo cmphi l+      _  -> trim cmplo cmphi r                trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe (k,a), Map k a)-trimLookupLo lo cmphi Tip = (Nothing,Tip)-trimLookupLo lo cmphi t@(Bin sx kx x l r)+trimLookupLo _  _     Tip = (Nothing,Tip)+trimLookupLo lo cmphi t@(Bin _ kx x l r)   = case compare lo kx of       LT -> case cmphi kx of               GT -> (lookupAssoc lo t, t)-              le -> trimLookupLo lo cmphi l+              _  -> trimLookupLo lo cmphi l       GT -> trimLookupLo lo cmphi r       EQ -> (Just (kx,x),trim (compare lo) cmphi r) @@ -1237,16 +1685,16 @@   [filterLt k t] filter all keys <[k] from tree [t] --------------------------------------------------------------------} filterGt :: Ord k => (k -> Ordering) -> Map k a -> Map k a-filterGt cmp Tip = Tip-filterGt cmp (Bin sx kx x l r)+filterGt _   Tip = Tip+filterGt cmp (Bin _ kx x l r)   = case cmp kx of       LT -> join kx x (filterGt cmp l) r       GT -> filterGt cmp r       EQ -> r        filterLt :: Ord k => (k -> Ordering) -> Map k a -> Map k a-filterLt cmp Tip = Tip-filterLt cmp (Bin sx kx x l r)+filterLt _   Tip = Tip+filterLt cmp (Bin _ kx x l r)   = case cmp kx of       LT -> filterLt cmp l       GT -> join kx x l (filterLt cmp r)@@ -1256,10 +1704,18 @@   Split --------------------------------------------------------------------} -- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where--- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.+-- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.+-- Any key equal to @k@ is found in neither @map1@ nor @map2@.+--+-- > 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 :: Ord k => k -> Map k a -> (Map k a,Map k a)-split k Tip = (Tip,Tip)-split k (Bin sx kx x l r)+split _ Tip = (Tip,Tip)+split k (Bin _ kx x l r)   = case compare k kx of       LT -> let (lt,gt) = split k l in (lt,join kx x gt r)       GT -> let (lt,gt) = split k r in (join kx x l lt,gt)@@ -1267,9 +1723,16 @@  -- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just -- like 'split' but also returns @'lookup' k 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 :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)-splitLookup k Tip = (Tip,Nothing,Tip)-splitLookup k (Bin sx kx x l r)+splitLookup _ Tip = (Tip,Nothing,Tip)+splitLookup k (Bin _ kx x l r)   = case compare k kx of       LT -> let (lt,z,gt) = splitLookup k l in (lt,z,join kx x gt r)       GT -> let (lt,z,gt) = splitLookup k r in (join kx x l lt,z,gt)@@ -1277,19 +1740,22 @@  -- | /O(log n)/. splitLookupWithKey :: Ord k => k -> Map k a -> (Map k a,Maybe (k,a),Map k a)-splitLookupWithKey k Tip = (Tip,Nothing,Tip)-splitLookupWithKey k (Bin sx kx x l r)+splitLookupWithKey _ Tip = (Tip,Nothing,Tip)+splitLookupWithKey k (Bin _ kx x l r)   = case compare k kx of       LT -> let (lt,z,gt) = splitLookupWithKey k l in (lt,z,join kx x gt r)       GT -> let (lt,z,gt) = splitLookupWithKey k r in (join kx x l lt,z,gt)       EQ -> (l,Just (kx, x),r) +{-+XXX unused code+ -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a) splitMember x t = let (l,m,r) = splitLookup x t in      (l,maybe False (const True) m,r)-+-}  {--------------------------------------------------------------------   Utility functions that maintain the balance properties of the tree.@@ -1337,13 +1803,13 @@ insertMax kx x t   = case t of       Tip -> singleton kx x-      Bin sz ky y l r+      Bin _ ky y l r           -> balance ky y l (insertMax kx x r)               insertMin kx x t   = case t of       Tip -> singleton kx x-      Bin sz ky y l r+      Bin _ ky y l r           -> balance ky y (insertMin kx x l) r               {--------------------------------------------------------------------@@ -1370,6 +1836,10 @@   -- | /O(log n)/. Delete and find the minimal element.+--+-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) +-- > deleteFindMin                                            Error: can not return the minimal element of an empty map+ deleteFindMin :: Map k a -> ((k,a),Map k a) deleteFindMin t    = case t of@@ -1378,6 +1848,10 @@       Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)  -- | /O(log n)/. Delete and find the maximal element.+--+-- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])+-- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map+ deleteFindMax :: Map k a -> ((k,a),Map k a) deleteFindMax t   = case t of@@ -1432,20 +1906,30 @@     sizeX = sizeL + sizeR + 1  -- rotate+rotateL :: a -> b -> Map a b -> Map a b -> Map a b rotateL k x l r@(Bin _ _ _ ly ry)   | size ly < ratio*size ry = singleL k x l r   | otherwise               = doubleL k x l r+rotateL _ _ _ Tip = error "rotateL Tip" +rotateR :: a -> b -> Map a b -> Map a b -> Map a b rotateR k x l@(Bin _ _ _ ly ry) r   | size ry < ratio*size ly = singleR k x l r   | otherwise               = doubleR k x l r+rotateR _ _ Tip _ = error "rotateR Tip"  -- basic rotations+singleL, singleR :: a -> b -> Map a b -> Map a b -> Map a b singleL k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin k2 x2 (bin k1 x1 t1 t2) t3+singleL _ _ _ Tip = error "singleL Tip" singleR k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin k2 x2 t1 (bin k1 x1 t2 t3)+singleR _ _ Tip _ = error "singleR Tip" +doubleL, doubleR :: a -> b -> Map a b -> Map a b -> Map a b doubleL k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin k3 x3 (bin k1 x1 t1 t2) (bin k2 x2 t3 t4)+doubleL _ _ _ _ = error "doubleL" doubleR k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin k3 x3 (bin k2 x2 t1 t2) (bin k1 x1 t3 t4)+doubleR _ _ _ _ = error "doubleR"   {--------------------------------------------------------------------@@ -1478,7 +1962,7 @@   fmap f m  = map f m  instance Traversable (Map k) where-  traverse f Tip = pure Tip+  traverse _ Tip = pure Tip   traverse f (Bin s k v l r)     = flip (Bin s k) <$> traverse f l <*> f v <*> traverse f r @@ -1505,12 +1989,16 @@     return (fromList xs,t) #endif +{-+XXX unused code+ -- parses a pair of things with the syntax a:=b readPair :: (Read a, Read b) => ReadS (a,b) readPair s = do (a, ct1)    <- reads s                 (":=", ct2) <- lex ct1                 (b, ct3)    <- reads ct2                 return ((a,b), ct3)+-}  {--------------------------------------------------------------------   Show@@ -1519,6 +2007,9 @@   showsPrec d m  = showParen (d > 10) $     showString "fromList " . shows (toList m) +{-+XXX unused code+ showMap :: (Show k,Show a) => [(k,a)] -> ShowS showMap []        = showString "{}" @@ -1526,13 +2017,13 @@   = showChar '{' . showElem x . showTail xs   where     showTail []     = showChar '}'-    showTail (x:xs) = showString ", " . showElem x . showTail xs+    showTail (x':xs') = showString ", " . showElem x' . showTail xs'     -    showElem (k,x)  = shows k . showString " := " . shows x-  +    showElem (k,x')  = shows k . showString " := " . shows x'+-}  -- | /O(n)/. Show the tree that implements the map. The tree is shown--- in a compressed, hanging format.+-- in a compressed, hanging format. See 'showTreeWith'. showTree :: (Show k,Show a) => Map k a -> String showTree m   = showTreeWith showElem True False m@@ -1585,9 +2076,9 @@ showsTree showelem wide lbars rbars t   = case t of       Tip -> showsBars lbars . showString "|\n"-      Bin sz kx x Tip Tip+      Bin _ kx x Tip Tip           -> showsBars lbars . showString (showelem kx x) . showString "\n" -      Bin sz kx x l r+      Bin _ kx x l r           -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r .              showWide wide rbars .              showsBars lbars . showString (showelem kx x) . showString "\n" .@@ -1598,16 +2089,16 @@ showsTreeHang showelem wide bars t   = case t of       Tip -> showsBars bars . showString "|\n" -      Bin sz kx x Tip Tip+      Bin _ kx x Tip Tip           -> showsBars bars . showString (showelem kx x) . showString "\n" -      Bin sz kx x l r+      Bin _ kx x l r           -> showsBars bars . showString (showelem kx x) . showString "\n" .               showWide wide bars .              showsTreeHang showelem wide (withBar bars) l .              showWide wide bars .              showsTreeHang showelem wide (withEmpty bars) r -+showWide :: Bool -> [String] -> String -> String showWide wide bars    | wide      = showString (concat (reverse bars)) . showString "|\n"    | otherwise = id@@ -1618,7 +2109,10 @@       [] -> id       _  -> showString (concat (reverse (tail bars))) . showString node +node :: String node           = "+--"++withBar, withEmpty :: [String] -> [String] withBar bars   = "|  ":bars withEmpty bars = "   ":bars @@ -1633,40 +2127,46 @@   Assertions --------------------------------------------------------------------} -- | /O(n)/. Test if the internal map structure is valid.+--+-- > valid (fromAscList [(3,"b"), (5,"a")]) == True+-- > valid (fromAscList [(5,"a"), (3,"b")]) == False+ valid :: Ord k => Map k a -> Bool valid t   = balanced t && ordered t && validsize t +ordered :: Ord a => Map a b -> Bool ordered t   = bounded (const True) (const True) t   where-    bounded lo hi t-      = case t of+    bounded lo hi t'+      = case t' of           Tip              -> True-          Bin sz kx x l r  -> (lo kx) && (hi kx) && bounded lo (<kx) l && bounded (>kx) hi r+          Bin _ kx _ l r  -> (lo kx) && (hi kx) && bounded lo (<kx) l && bounded (>kx) hi r  -- | Exported only for "Debug.QuickCheck" balanced :: Map k a -> Bool balanced t   = case t of-      Tip              -> True-      Bin sz kx x l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&-                          balanced l && balanced r-+      Tip            -> True+      Bin _ _ _ l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&+                        balanced l && balanced r +validsize :: Map a b -> Bool validsize t   = (realsize t == Just (size t))   where-    realsize t-      = case t of-          Tip             -> Just 0-          Bin sz kx x l r -> case (realsize l,realsize r) of-                              (Just n,Just m)  | n+m+1 == sz  -> Just sz-                              other            -> Nothing+    realsize t'+      = case t' of+          Tip            -> Just 0+          Bin sz _ _ l r -> case (realsize l,realsize r) of+                            (Just n,Just m)  | n+m+1 == sz  -> Just sz+                            _                               -> Nothing  {--------------------------------------------------------------------   Utilities --------------------------------------------------------------------}+foldlStrict :: (a -> b -> a) -> a -> [b] -> a foldlStrict f z xs   = case xs of       []     -> z

@@ -1,10 +1,10 @@-{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -cpp #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Sequence -- Copyright   :  (c) Ross Paterson 2005 -- License     :  BSD-style--- Maintainer  :  ross@soi.city.ac.uk+-- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  portable --@@ -75,13 +75,16 @@ import Data.Monoid (Monoid(..)) import Data.Foldable import Data.Traversable-import Data.Typeable+#ifndef __GLASGOW_HASKELL__+import Data.Typeable (Typeable, typeOf, typeOfDefault)+#endif+import Data.Typeable (TyCon, Typeable1(..), mkTyCon, mkTyConApp )  #ifdef __GLASGOW_HASKELL__ import Text.Read (Lexeme(Ident), lexP, parens, prec, 	readPrec, readListPrec, readListPrecDefault)-import Data.Generics.Basics (Data(..), Fixity(..),-			constrIndex, mkConstr, mkDataType)+import Data.Data (Data(..), DataType, Constr, Fixity(..),+                             mkConstr, mkDataType, constrIndex, gcast1) #endif  #if TESTING@@ -183,8 +186,11 @@  	dataCast1 f	= gcast1 f +emptyConstr, consConstr :: Constr emptyConstr = mkConstr seqDataType "empty" [] Prefix consConstr  = mkConstr seqDataType "<|" [] Infix++seqDataType :: DataType seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr] #endif @@ -267,12 +273,12 @@ 	foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c 	foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d -	foldr1 f (One a) = a+	foldr1 _ (One a) = a 	foldr1 f (Two a b) = a `f` b 	foldr1 f (Three a b c) = a `f` (b `f` c) 	foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d)) -	foldl1 f (One a) = a+	foldl1 _ (One a) = a 	foldl1 f (Two a b) = a `f` b 	foldl1 f (Three a b c) = (a `f` b) `f` c 	foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d@@ -691,13 +697,13 @@ 	fmap = fmapDefault  instance Foldable ViewL where-	foldr f z EmptyL = z+	foldr _ z EmptyL = z 	foldr f z (x :< xs) = f x (foldr f z xs) -	foldl f z EmptyL = z+	foldl _ z EmptyL = z 	foldl f z (x :< xs) = foldl f (f z x) xs -	foldl1 f EmptyL = error "foldl1: empty view"+	foldl1 _ EmptyL = error "foldl1: empty view" 	foldl1 f (x :< xs) = foldl f x xs  instance Traversable ViewL where@@ -750,13 +756,13 @@ 	fmap = fmapDefault  instance Foldable ViewR where-	foldr f z EmptyR = z+	foldr _ z EmptyR = z 	foldr f z (xs :> x) = foldr f (f x z) xs -	foldl f z EmptyR = z+	foldl _ z EmptyR = z 	foldl f z (xs :> x) = f (foldl f z xs) x -	foldr1 f EmptyR = error "foldr1: empty view"+	foldr1 _ EmptyR = error "foldr1: empty view" 	foldr1 f (xs :> x) = foldr f x xs  instance Traversable ViewR where@@ -786,7 +792,9 @@  -- Indexing --- | /O(log(min(i,n-i)))/. The element at the specified position+-- | /O(log(min(i,n-i)))/. The element at the specified position,+-- which should be a positive integer less than the size of the sequence.+-- If the position is out of range, 'index' fails with an error. index		:: Seq a -> Int -> a index (Seq xs) i   | 0 <= i && i < size xs = case lookupTree i xs of@@ -848,11 +856,13 @@ 	sab	= sa + size b 	sabc	= sab + size c --- | /O(log(min(i,n-i)))/. Replace the element at the specified position+-- | /O(log(min(i,n-i)))/. Replace the element at the specified position.+-- If the position is out of range, the original sequence is returned. update		:: Int -> a -> Seq a -> Seq a update i x	= adjust (const x) i --- | /O(log(min(i,n-i)))/. Update the element at the specified position+-- | /O(log(min(i,n-i)))/. Update the element at the specified position.+-- If the position is out of range, the original sequence is returned. adjust		:: (a -> a) -> Int -> Seq a -> Seq a adjust f i (Seq xs)   | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)@@ -911,14 +921,21 @@ -- Splitting  -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.+-- If @i@ is negative, @'take' i s@ yields the empty sequence.+-- If the sequence contains fewer than @i@ elements, the whole sequence+-- is returned. take		:: Int -> Seq a -> Seq a take i		=  fst . splitAt i  -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.+-- If @i@ is negative, @'take' i s@ yields the whole sequence.+-- If the sequence contains fewer than @i@ elements, the empty sequence+-- is returned. drop		:: Int -> Seq a -> Seq a drop i		=  snd . splitAt i  -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.+-- @'splitAt' i s = ('take' i s, 'drop' i s)@. splitAt			:: Int -> Seq a -> (Seq a, Seq a) splitAt i (Seq xs)	=  (Seq l, Seq r)   where	(l, r)		=  split i xs@@ -958,7 +975,7 @@ deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a deepL Nothing m sf	= case viewLTree m of 	Nothing2	-> digitToTree sf-	Just2 a m'	-> deep (nodeToDigit a) m' sf+	Just2 a m'	-> Deep (size m + size sf) (nodeToDigit a) m' sf deepL (Just pr) m sf	= deep pr m sf  {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}@@ -966,7 +983,7 @@ deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a deepR pr m Nothing	= case viewRTree m of 	Nothing2	-> digitToTree pr-	Just2 m' a	-> deep pr m' (nodeToDigit a)+	Just2 m' a	-> Deep (size pr + size m) pr m' (nodeToDigit a) deepR pr m (Just sf)	= deep pr m sf  {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}

@@ -103,8 +103,11 @@ import Prelude hiding (filter,foldr,null,map) import qualified Data.List as List import Data.Monoid (Monoid(..))-import Data.Typeable import Data.Foldable (Foldable(foldMap))+#ifndef __GLASGOW_HASKELL__+import Data.Typeable (Typeable, typeOf, typeOfDefault)+#endif+import Data.Typeable (Typeable1(..), TyCon, mkTyCon, mkTyConApp)  {- -- just for testing@@ -115,8 +118,7 @@  #if __GLASGOW_HASKELL__ import Text.Read-import Data.Generics.Basics-import Data.Generics.Instances+import Data.Data (Data(..), mkNorepType, gcast1) #endif  {--------------------------------------------------------------------@@ -143,7 +145,7 @@     mconcat = unions  instance Foldable Set where-    foldMap f Tip = mempty+    foldMap _ Tip = mempty     foldMap f (Bin _s k l r) = foldMap f l `mappend` f k `mappend` foldMap f r  #if __GLASGOW_HASKELL__@@ -171,22 +173,22 @@ null :: Set a -> Bool null t   = case t of-      Tip           -> True-      Bin sz x l r  -> False+      Tip    -> True+      Bin {} -> False  -- | /O(1)/. The number of elements in the set. size :: Set a -> Int size t   = case t of-      Tip           -> 0-      Bin sz x l r  -> sz+      Tip          -> 0+      Bin sz _ _ _ -> sz  -- | /O(log n)/. Is the element in the set? member :: Ord a => a -> Set a -> Bool member x t   = case t of       Tip -> False-      Bin sz y l r+      Bin _ y l r           -> case compare x y of                LT -> member x l                GT -> member x r@@ -231,7 +233,7 @@ delete x t   = case t of       Tip -> Tip-      Bin sz y l r +      Bin _ y l r           -> case compare x y of                LT -> balance y (delete x l) r                GT -> balance y l (delete x r)@@ -252,8 +254,9 @@ isSubsetOf t1 t2   = (size t1 <= size t2) && (isSubsetOfX t1 t2) -isSubsetOfX Tip t = True-isSubsetOfX t Tip = False+isSubsetOfX :: Ord a => Set a -> Set a -> Bool+isSubsetOfX Tip _ = True+isSubsetOfX _ Tip = False isSubsetOfX (Bin _ x l r) t   = found && isSubsetOfX l lt && isSubsetOfX r gt   where@@ -265,25 +268,25 @@ --------------------------------------------------------------------} -- | /O(log n)/. The minimal element of a set. findMin :: Set a -> a-findMin (Bin _ x Tip r) = x-findMin (Bin _ x l r)   = findMin l+findMin (Bin _ x Tip _) = x+findMin (Bin _ _ l _)   = findMin l findMin Tip             = error "Set.findMin: empty set has no minimal element"  -- | /O(log n)/. The maximal element of a set. findMax :: Set a -> a-findMax (Bin _ x l Tip)  = x-findMax (Bin _ x l r)    = findMax r+findMax (Bin _ x _ Tip)  = x+findMax (Bin _ _ _ r)    = findMax r findMax Tip              = error "Set.findMax: empty set has no maximal element"  -- | /O(log n)/. Delete the minimal element. deleteMin :: Set a -> Set a-deleteMin (Bin _ x Tip r) = r+deleteMin (Bin _ _ Tip r) = r deleteMin (Bin _ x l r)   = balance x (deleteMin l) r deleteMin Tip             = Tip  -- | /O(log n)/. Delete the maximal element. deleteMax :: Set a -> Set a-deleteMax (Bin _ x l Tip) = l+deleteMax (Bin _ _ l Tip) = l deleteMax (Bin _ x l r)   = balance x l (deleteMax r) deleteMax Tip             = Tip @@ -306,7 +309,9 @@ union t1 Tip  = t1 union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2 -hedgeUnion cmplo cmphi t1 Tip +hedgeUnion :: Ord a+           => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a+hedgeUnion _     _     t1 Tip   = t1 hedgeUnion cmplo cmphi Tip (Bin _ x l r)   = join x (filterGt cmplo l) (filterLt cmphi r)@@ -322,11 +327,13 @@ -- | /O(n+m)/. Difference of two sets.  -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/. difference :: Ord a => Set a -> Set a -> Set a-difference Tip t2  = Tip+difference Tip _   = Tip difference t1 Tip  = t1 difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2 -hedgeDiff cmplo cmphi Tip t     +hedgeDiff :: Ord a+          => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a+hedgeDiff _ _ Tip _   = Tip hedgeDiff cmplo cmphi (Bin _ x l r) Tip    = join x (filterGt cmplo l) (filterLt cmphi r)@@ -351,8 +358,8 @@ -- -- prints @(fromList [A],fromList [B])@. intersection :: Ord a => Set a -> Set a -> Set a-intersection Tip t = Tip-intersection t Tip = Tip+intersection Tip _ = Tip+intersection _ Tip = Tip intersection t1@(Bin s1 x1 l1 r1) t2@(Bin s2 x2 l2 r2) =    if s1 >= s2 then       let (lt,found,gt) = splitLookup x2 t1@@ -372,7 +379,7 @@ --------------------------------------------------------------------} -- | /O(n)/. Filter all elements that satisfy the predicate. filter :: Ord a => (a -> Bool) -> Set a -> Set a-filter p Tip = Tip+filter _ Tip = Tip filter p (Bin _ x l r)   | p x       = join x (filter p l) (filter p r)   | otherwise = merge (filter p l) (filter p r)@@ -381,7 +388,7 @@ -- the predicate and one with all elements that don't satisfy the predicate. -- See also 'split'. partition :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a)-partition p Tip = (Tip,Tip)+partition _ Tip = (Tip,Tip) partition p (Bin _ x l r)   | p x       = (join x l1 r1,merge l2 r2)   | otherwise = (merge l1 r1,join x l2 r2)@@ -413,7 +420,7 @@ -- >     where ls = toList s  mapMonotonic :: (a->b) -> Set a -> Set b-mapMonotonic f Tip = Tip+mapMonotonic _ Tip = Tip mapMonotonic f (Bin sz x l r) =     Bin sz (f x) (mapMonotonic f l) (mapMonotonic f r) @@ -428,7 +435,7 @@  -- | /O(n)/. Post-order fold. foldr :: (a -> b -> b) -> b -> Set a -> b-foldr f z Tip           = z+foldr _ z Tip           = z foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l  {--------------------------------------------------------------------@@ -473,16 +480,16 @@   = fromDistinctAscList (combineEq xs)   where   -- [combineEq xs] combines equal elements with [const] in an ordered list [xs]-  combineEq xs-    = case xs of+  combineEq xs'+    = case xs' of         []     -> []         [x]    -> [x]         (x:xx) -> combineEq' x xx    combineEq' z [] = [z]-  combineEq' z (x:xs)-    | z==x      = combineEq' z xs-    | otherwise = z:combineEq' x xs+  combineEq' z (x:xs')+    | z==x      =   combineEq' z xs'+    | otherwise = z:combineEq' x xs'   -- | /O(n)/. Build a set from an ascending list of distinct elements in linear time.@@ -493,16 +500,18 @@   where     -- 1) use continutations so that we use heap space instead of stack space.     -- 2) special case for n==5 to build bushier trees. -    build c 0 xs   = c Tip xs -    build c 5 xs   = case xs of+    build c 0 xs'  = c Tip xs'+    build c 5 xs'  = case xs' of                        (x1:x2:x3:x4:x5:xx)                              -> c (bin x4 (bin x2 (singleton x1) (singleton x3)) (singleton x5)) xx-    build c n xs   = seq nr $ build (buildR nr c) nl xs+                       _ -> error "fromDistinctAscList build 5"+    build c n xs'  = seq nr $ build (buildR nr c) nl xs'                    where                      nl = n `div` 2                      nr = n - nl - 1      buildR n c l (x:ys) = build (buildB l x c) n ys+    buildR _ _ _ []     = error "fromDistinctAscList buildR []"     buildB l x c r zs   = c (bin x l r) zs  {--------------------------------------------------------------------@@ -527,14 +536,18 @@   showsPrec p xs = showParen (p > 10) $     showString "fromList " . shows (toList xs) +{-+XXX unused code+ showSet :: (Show a) => [a] -> ShowS showSet []        = showString "{}"  showSet (x:xs)    = showChar '{' . shows x . showTail xs   where-    showTail []     = showChar '}'-    showTail (x:xs) = showChar ',' . shows x . showTail xs+    showTail []       = showChar '}'+    showTail (x':xs') = showChar ',' . shows x' . showTail xs'+-}  {--------------------------------------------------------------------   Read@@ -584,40 +597,43 @@   empty or the key of the root is between @lo@ and @hi@. --------------------------------------------------------------------} trim :: (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a-trim cmplo cmphi Tip = Tip-trim cmplo cmphi t@(Bin sx x l r)+trim _     _     Tip = Tip+trim cmplo cmphi t@(Bin _ x l r)   = case cmplo x of       LT -> case cmphi x of               GT -> t-              le -> trim cmplo cmphi l-      ge -> trim cmplo cmphi r-              +              _  -> trim cmplo cmphi l+      _  -> trim cmplo cmphi r++{-+XXX unused code+ trimMemberLo :: Ord a => a -> (a -> Ordering) -> Set a -> (Bool, Set a)-trimMemberLo lo cmphi Tip = (False,Tip)-trimMemberLo lo cmphi t@(Bin sx x l r)+trimMemberLo _  _     Tip = (False,Tip)+trimMemberLo lo cmphi t@(Bin _ x l r)   = case compare lo x of       LT -> case cmphi x of               GT -> (member lo t, t)-              le -> trimMemberLo lo cmphi l+              _  -> trimMemberLo lo cmphi l       GT -> trimMemberLo lo cmphi r       EQ -> (True,trim (compare lo) cmphi r)-+-}  {--------------------------------------------------------------------   [filterGt x t] filter all values >[x] from tree [t]   [filterLt x t] filter all values <[x] from tree [t] --------------------------------------------------------------------} filterGt :: (a -> Ordering) -> Set a -> Set a-filterGt cmp Tip = Tip-filterGt cmp (Bin sx x l r)+filterGt _ Tip = Tip+filterGt cmp (Bin _ x l r)   = case cmp x of       LT -> join x (filterGt cmp l) r       GT -> filterGt cmp r       EQ -> r        filterLt :: (a -> Ordering) -> Set a -> Set a-filterLt cmp Tip = Tip-filterLt cmp (Bin sx x l r)+filterLt _ Tip = Tip+filterLt cmp (Bin _ x l r)   = case cmp x of       LT -> filterLt cmp l       GT -> join x l (filterLt cmp r)@@ -628,11 +644,11 @@   Split --------------------------------------------------------------------} -- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@--- where all elements in @set1@ are lower than @x@ and all elements in--- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@.+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@. split :: Ord a => a -> Set a -> (Set a,Set a)-split x Tip = (Tip,Tip)-split x (Bin sy y l r)+split _ Tip = (Tip,Tip)+split x (Bin _ y l r)   = case compare x y of       LT -> let (lt,gt) = split x l in (lt,join y gt r)       GT -> let (lt,gt) = split x r in (join y l lt,gt)@@ -647,8 +663,8 @@ -- | /O(log n)/. Performs a 'split' but also returns the pivot -- element that was found in the original set. splitLookup :: Ord a => a -> Set a -> (Set a,Maybe a,Set a)-splitLookup x Tip = (Tip,Nothing,Tip)-splitLookup x (Bin sy y l r)+splitLookup _ Tip = (Tip,Nothing,Tip)+splitLookup x (Bin _ y l r)    = case compare x y of        LT -> let (lt,found,gt) = splitLookup x l in (lt,found,join y gt r)        GT -> let (lt,found,gt) = splitLookup x r in (join y l lt,found,gt)@@ -700,13 +716,13 @@ insertMax x t   = case t of       Tip -> singleton x-      Bin sz y l r+      Bin _ y l r           -> balance y l (insertMax x r)               insertMin x t   = case t of       Tip -> singleton x-      Bin sz y l r+      Bin _ y l r           -> balance y (insertMin x l) r               {--------------------------------------------------------------------@@ -753,18 +769,17 @@       Bin _ x l r   -> let (xm,r') = deleteFindMax r in (xm,balance x l r')       Tip           -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip) --- | /O(log n)/. Retrieves the minimal key of the set, and the set stripped from that element--- @fail@s (in the monad) when passed an empty set.-minView :: Monad m => Set a -> m (a, Set a)-minView Tip = fail "Set.minView: empty set"-minView x = return (deleteFindMin x)---- | /O(log n)/. Retrieves the maximal key of the set, and the set stripped from that element--- @fail@s (in the monad) when passed an empty set.-maxView :: Monad m => Set a -> m (a, Set a)-maxView Tip = fail "Set.maxView: empty set"-maxView x = return (deleteFindMax x)+-- | /O(log n)/. Retrieves the minimal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+minView :: Set a -> Maybe (a, Set a)+minView Tip = Nothing+minView x = Just (deleteFindMin x) +-- | /O(log n)/. Retrieves the maximal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+maxView :: Set a -> Maybe (a, Set a)+maxView Tip = Nothing+maxView x = Just (deleteFindMax x)  {--------------------------------------------------------------------   [balance x l r] balances two trees with value x.@@ -827,20 +842,30 @@     sizeX = sizeL + sizeR + 1  -- rotate+rotateL :: a -> Set a -> Set a -> Set a rotateL x l r@(Bin _ _ ly ry)   | size ly < ratio*size ry = singleL x l r   | otherwise               = doubleL x l r+rotateL _ _ Tip = error "rotateL Tip" +rotateR :: a -> Set a -> Set a -> Set a rotateR x l@(Bin _ _ ly ry) r   | size ry < ratio*size ly = singleR x l r   | otherwise               = doubleR x l r+rotateR _ Tip _ = error "rotateL Tip"  -- basic rotations+singleL, singleR :: a -> Set a -> Set a -> Set a singleL x1 t1 (Bin _ x2 t2 t3)  = bin x2 (bin x1 t1 t2) t3+singleL _  _  Tip               = error "singleL" singleR x1 (Bin _ x2 t1 t2) t3  = bin x2 t1 (bin x1 t2 t3)+singleR _  Tip              _   = error "singleR" +doubleL, doubleR :: a -> Set a -> Set a -> Set a doubleL x1 t1 (Bin _ x2 (Bin _ x3 t2 t3) t4) = bin x3 (bin x1 t1 t2) (bin x2 t3 t4)+doubleL _ _ _ = error "doubleL" doubleR x1 (Bin _ x2 t1 (Bin _ x3 t2 t3)) t4 = bin x3 (bin x2 t1 t2) (bin x1 t3 t4)+doubleR _ _ _ = error "doubleR"   {--------------------------------------------------------------------@@ -854,6 +879,7 @@ {--------------------------------------------------------------------   Utilities --------------------------------------------------------------------}+foldlStrict :: (a -> b -> a) -> a -> [b] -> a foldlStrict f z xs   = case xs of       []     -> z@@ -914,9 +940,9 @@ showsTree wide lbars rbars t   = case t of       Tip -> showsBars lbars . showString "|\n"-      Bin sz x Tip Tip+      Bin _ x Tip Tip           -> showsBars lbars . shows x . showString "\n" -      Bin sz x l r+      Bin _ x l r           -> showsTree wide (withBar rbars) (withEmpty rbars) r .              showWide wide rbars .              showsBars lbars . shows x . showString "\n" .@@ -927,16 +953,16 @@ showsTreeHang wide bars t   = case t of       Tip -> showsBars bars . showString "|\n" -      Bin sz x Tip Tip+      Bin _ x Tip Tip           -> showsBars bars . shows x . showString "\n" -      Bin sz x l r+      Bin _ x l r           -> showsBars bars . shows x . showString "\n" .               showWide wide bars .              showsTreeHang wide (withBar bars) l .              showWide wide bars .              showsTreeHang wide (withEmpty bars) r -+showWide :: Bool -> [String] -> String -> String showWide wide bars    | wide      = showString (concat (reverse bars)) . showString "|\n"    | otherwise = id@@ -947,7 +973,10 @@       [] -> id       _  -> showString (concat (reverse (tail bars))) . showString node +node :: String node           = "+--"++withBar, withEmpty :: [String] -> [String] withBar bars   = "|  ":bars withEmpty bars = "   ":bars @@ -959,31 +988,32 @@ valid t   = balanced t && ordered t && validsize t +ordered :: Ord a => Set a -> Bool ordered t   = bounded (const True) (const True) t   where-    bounded lo hi t-      = case t of-          Tip           -> True-          Bin sz x l r  -> (lo x) && (hi x) && bounded lo (<x) l && bounded (>x) hi r+    bounded lo hi t'+      = case t' of+          Tip         -> True+          Bin _ x l r -> (lo x) && (hi x) && bounded lo (<x) l && bounded (>x) hi r  balanced :: Set a -> Bool balanced t   = case t of-      Tip           -> True-      Bin sz x l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&-                       balanced l && balanced r-+      Tip         -> True+      Bin _ _ l r -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&+                     balanced l && balanced r +validsize :: Set a -> Bool validsize t   = (realsize t == Just (size t))   where-    realsize t-      = case t of+    realsize t'+      = case t' of           Tip          -> Just 0-          Bin sz x l r -> case (realsize l,realsize r) of+          Bin sz _ l r -> case (realsize l,realsize r) of                             (Just n,Just m)  | n+m+1 == sz  -> Just sz-                            other            -> Nothing+                            _                -> Nothing  {- {--------------------------------------------------------------------

@@ -38,8 +38,7 @@ import Data.Typeable  #ifdef __GLASGOW_HASKELL__-import Data.Generics.Basics (Data)-import Data.Generics.Instances+import Data.Data (Data) #endif  -- | Multi-way trees, also known as /rose trees/.@@ -155,9 +154,9 @@ unfoldForestQ :: Monad m => (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a)) unfoldForestQ f aQ = case viewl aQ of 	EmptyL -> return empty-	a :< aQ -> do+	a :< aQ' -> do 		(b, as) <- f a-		tQ <- unfoldForestQ f (Prelude.foldl (|>) aQ as)+		tQ <- unfoldForestQ f (Prelude.foldl (|>) aQ' as) 		let (tQ', ts) = splitOnto [] as tQ 		return (Node b ts <| tQ')   where splitOnto :: [a'] -> [b'] -> Seq a' -> (Seq a', [a'])

@@ -1,17 +1,22 @@ name:       containers-version:    0.1.0.1+version:    0.2.0.0 license:    BSD3 license-file:    LICENSE maintainer:    libraries@haskell.org synopsis:   Assorted concrete container types+category:   Data Structures description:         This package contains efficient general-purpose implementations         of various basic immutable container types.  The declared cost of         each operation is either worst-case or amortized, but remains         valid even if structures are shared. build-type: Simple-build-depends: base, array-exposed-modules:+cabal-version:  >=1.2+extra-source-files: include/Typeable.h++Library {+    build-depends: base, array+    exposed-modules:         Data.Graph         Data.IntMap         Data.IntSet@@ -19,8 +24,10 @@         Data.Sequence         Data.Set         Data.Tree-include-dirs: include-extensions: CPP--- We need this for Data deriving, but we can't just turn on that--- extension because we only try to do it when building with GHC.-ghc-options: -fglasgow-exts+    include-dirs: include+    extensions: CPP+    if impl(ghc) {+        extensions: DeriveDataTypeable, MagicHash, Rank2Types+    }+}+

@@ -0,0 +1,69 @@+{- --------------------------------------------------------------------------+// Macros to help make Typeable instances.+//+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines+//+//	instance Typeable/n/ tc+//	instance Typeable a => Typeable/n-1/ (tc a)+//	instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)+//	...+//	instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)+// --------------------------------------------------------------------------+-}++#ifndef TYPEABLE_H+#define TYPEABLE_H++#define INSTANCE_TYPEABLE0(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }++#ifdef __GLASGOW_HASKELL__++--  // For GHC, the extra instances follow from general instance declarations+--  // defined in Data.Typeable.++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }++#else /* !__GLASGOW_HASKELL__ */++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable1 (tycon a) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \+  typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable2 (tycon a) where { \+  typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \+  typeOf = typeOfDefault }++#endif /* !__GLASGOW_HASKELL__ */++#endif