X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMap.hs;h=1d812fc729dd51494c76f2788c71cabc671b36e4;hb=d71aee821935e29a3569bc4b401f695536209c85;hp=74a57c01e5f3bc0d27b7600f3d188b06df4131a7;hpb=42459d4ce473c881242c8c24c0cd570c3288393e;p=haskell-directory.git

diff --git a/Data/Map.hs b/Data/Map.hs
index 74a57c0..1d812fc 100644
--- a/Data/Map.hs
+++ b/Data/Map.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Map
@@ -9,10 +11,11 @@
 --
 -- An efficient implementation of maps from keys to values (dictionaries).
 --
--- This module is intended to be imported @qualified@, to avoid name
--- clashes with Prelude functions.  eg.
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
 --
--- >  import Data.Map as Map
+-- >  import Data.Map (Map)
+-- >  import qualified Data.Map as Map
 --
 -- The implementation of 'Map' is based on /size balanced/ binary trees (or
 -- trees of /bounded balance/) as described by:
@@ -24,11 +27,15 @@
 --    * J. Nievergelt and E.M. Reingold,
 --	\"/Binary search trees of bounded balance/\",
 --	SIAM journal of computing 2(1), March 1973.
+--
+-- 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'.
 -----------------------------------------------------------------------------
 
 module Data.Map  ( 
             -- * Map type
-              Map          -- instance Eq,Show
+              Map          -- instance Eq,Show,Read
 
             -- * Operators
             , (!), (\\)
@@ -38,6 +45,7 @@ module Data.Map  (
             , null
             , size
             , member
+            , notMember
             , lookup
             , findWithDefault
             
@@ -48,6 +56,7 @@ module Data.Map  (
             -- ** Insertion
             , insert
             , insertWith, insertWithKey, insertLookupWithKey
+            , insertWith', insertWithKey'
             
             -- ** Delete\/Update
             , delete
@@ -56,6 +65,7 @@ module Data.Map  (
             , update
             , updateWithKey
             , updateLookupWithKey
+            , alter
 
             -- * Combine
 
@@ -115,6 +125,11 @@ module Data.Map  (
             , partition
             , partitionWithKey
 
+            , mapMaybe
+            , mapMaybeWithKey
+            , mapEither
+            , mapEitherWithKey
+
             , split         
             , splitLookup   
 
@@ -140,6 +155,8 @@ module Data.Map  (
             , updateMax
             , updateMinWithKey
             , updateMaxWithKey
+            , minView
+            , maxView
             
             -- * Debugging
             , showTree
@@ -148,10 +165,13 @@ module Data.Map  (
             ) where
 
 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import Data.Monoid
 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))
 
 {-
 -- for quick check
@@ -162,6 +182,7 @@ import List(nub,sort)
 -}
 
 #if __GLASGOW_HASKELL__
+import Text.Read
 import Data.Generics.Basics
 import Data.Generics.Instances
 #endif
@@ -171,7 +192,8 @@ import Data.Generics.Instances
 --------------------------------------------------------------------}
 infixl 9 !,\\ --
 
--- | /O(log n)/. Find the value of a key. Calls 'error' when the element can not be found.
+-- | /O(log n)/. Find the value at a key.
+-- Calls 'error' when the element can not be found.
 (!) :: Ord k => Map k a -> k -> a
 m ! k    = find k m
 
@@ -188,6 +210,11 @@ data Map k a  = Tip
 
 type Size     = Int
 
+instance (Ord k) => Monoid (Map k v) where
+    mempty  = empty
+    mappend = union
+    mconcat = unions
+
 #if __GLASGOW_HASKELL__
 
 {--------------------------------------------------------------------
@@ -202,6 +229,7 @@ instance (Data k, Data a, Ord k) => Data (Map k a) where
   toConstr _     = error "toConstr"
   gunfold _ _    = error "gunfold"
   dataTypeOf _   = mkNorepType "Data.Map.Map"
+  dataCast2 f    = gcast2 f
 
 #endif
 
@@ -223,17 +251,36 @@ size t
       Bin sz k x l r  -> sz
 
 
--- | /O(log n)/. Lookup the value of key in the map.
-lookup :: Ord k => k -> Map k a -> Maybe a
-lookup k t
+-- | /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
   = case t of
       Tip -> Nothing
       Bin sz 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
+          -> 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?
 member :: Ord k => k -> Map k a -> Bool
 member k m
@@ -241,7 +288,12 @@ member k m
       Nothing -> False
       Just x  -> True
 
--- | /O(log n)/. Find the value of a key. Calls 'error' when the element can not be found.
+-- | /O(log n)/. Is the key not a member of the map?
+notMember :: Ord k => k -> Map k a -> Bool
+notMember k m = not $ member k m
+
+-- | /O(log n)/. Find the value at a key.
+-- Calls 'error' when the element can not be found.
 find :: Ord k => k -> Map k a -> a
 find k m
   = case lookup k m of
@@ -249,7 +301,7 @@ find k m
       Just x  -> x
 
 -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
--- the value of key @k@ or returns @def@ when the key is not in the map.
+-- the value at key @k@ or returns @def@ when the key is not in the map.
 findWithDefault :: Ord k => a -> k -> Map k a -> a
 findWithDefault def k m
   = case lookup k m of
@@ -266,16 +318,18 @@ empty :: Map k a
 empty 
   = Tip
 
--- | /O(1)/. Create a map with a single element.
+-- | /O(1)/. A map with a single element.
 singleton :: k -> a -> Map k a
 singleton k x  
   = Bin 1 k x Tip Tip
 
 {--------------------------------------------------------------------
   Insertion
-  [insert] is the inlined version of [insertWith (\k x y -> x)]
 --------------------------------------------------------------------}
 -- | /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
+-- @'insertWith' 'const'@.
 insert :: Ord k => k -> a -> Map k a -> Map k a
 insert kx x t
   = case t of
@@ -287,11 +341,26 @@ insert kx x t
                EQ -> Bin sz kx x l r
 
 -- | /O(log n)/. Insert with a combining function.
+-- @'insertWith' f key value mp@ 
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert the pair @(key, f new_value old_value)@.
 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
 
+-- | 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
+
+
 -- | /O(log n)/. 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 the pair @(key,f key new_value old_value)@.
+-- Note that the key passed to f is the same key passed to 'insertWithKey'.
 insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
 insertWithKey f kx x t
   = case t of
@@ -300,7 +369,19 @@ insertWithKey f kx x t
           -> case compare kx ky of
                LT -> balance ky y (insertWithKey f kx x l) r
                GT -> balance ky y l (insertWithKey f kx x r)
-               EQ -> Bin sy ky (f ky x y) l r
+               EQ -> Bin sy kx (f kx x y) l r
+
+-- | Same as 'insertWithKey', but the combining function is applied strictly.
+insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
+insertWithKey' f kx x t
+  = case t of
+      Tip -> singleton kx x
+      Bin sy ky y l r
+          -> case compare kx ky of
+               LT -> balance ky y (insertWithKey' f kx x l) r
+               GT -> balance ky y l (insertWithKey' f kx x r)
+               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@)
 -- is a pair where the first element is equal to (@'lookup' k map@)
@@ -313,7 +394,7 @@ insertLookupWithKey f kx x t
           -> case compare kx ky of
                LT -> let (found,l') = insertLookupWithKey f kx x l in (found,balance ky y l' r)
                GT -> let (found,r') = insertLookupWithKey f kx x r in (found,balance ky y l r')
-               EQ -> (Just y, Bin sy ky (f ky x y) l r)
+               EQ -> (Just y, Bin sy kx (f kx x y) l r)
 
 {--------------------------------------------------------------------
   Deletion
@@ -379,6 +460,23 @@ updateLookupWithKey f k t
                        Just x' -> (Just x',Bin sx kx x' l r)
                        Nothing -> (Just x,glue l r)
 
+-- | /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 :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
+alter f k t
+  = case t of
+      Tip -> case f Nothing of
+               Nothing -> Tip
+               Just x -> singleton k x
+      Bin sx kx x l r 
+          -> case compare k kx of
+               LT -> balance kx x (alter f k l) r
+               GT -> balance kx x l (alter f k r)
+               EQ -> case f (Just x) of
+                       Just x' -> Bin sx kx x' l r
+                       Nothing -> glue l r
+
 {--------------------------------------------------------------------
   Indexing
 --------------------------------------------------------------------}
@@ -393,9 +491,10 @@ findIndex k t
 
 -- | /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 :: Ord k => k -> Map k a -> Maybe Int
-lookupIndex k t
-  = lookup 0 t
+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
   where
     lookup idx Tip  = Nothing
     lookup idx (Bin _ kx x l r)
@@ -444,13 +543,13 @@ deleteAt i map
 findMin :: Map k a -> (k,a)
 findMin (Bin _ kx x Tip r)  = (kx,x)
 findMin (Bin _ kx x l r)    = findMin l
-findMin Tip                 = error "Map.findMin: empty tree has no minimal element"
+findMin Tip                 = error "Map.findMin: empty map has no minimal element"
 
 -- | /O(log n)/. The maximal key of the map.
 findMax :: Map k a -> (k,a)
 findMax (Bin _ kx x l Tip)  = (kx,x)
 findMax (Bin _ kx x l r)    = findMax r
-findMax Tip                 = error "Map.findMax: empty tree has no maximal element"
+findMax Tip                 = error "Map.findMax: empty map has no maximal element"
 
 -- | /O(log n)/. Delete the minimal key.
 deleteMin :: Map k a -> Map k a
@@ -464,18 +563,18 @@ deleteMax (Bin _ kx x l Tip)  = l
 deleteMax (Bin _ kx x l r)    = balance kx x l (deleteMax r)
 deleteMax Tip                 = Tip
 
--- | /O(log n)/. Update the minimal key.
+-- | /O(log n)/. Update the value at the minimal key.
 updateMin :: (a -> Maybe a) -> Map k a -> Map k a
 updateMin f m
   = updateMinWithKey (\k x -> f x) m
 
--- | /O(log n)/. Update the maximal key.
+-- | /O(log n)/. Update the value at the maximal key.
 updateMax :: (a -> Maybe a) -> Map k a -> Map k a
 updateMax f m
   = updateMaxWithKey (\k x -> f x) m
 
 
--- | /O(log n)/. Update the minimal key.
+-- | /O(log n)/. Update the value at the minimal key.
 updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
 updateMinWithKey f t
   = case t of
@@ -485,7 +584,7 @@ updateMinWithKey f t
       Bin sx kx x l r    -> balance kx x (updateMinWithKey f l) r
       Tip                -> Tip
 
--- | /O(log n)/. Update the maximal key.
+-- | /O(log n)/. Update the value at the maximal key.
 updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
 updateMaxWithKey f t
   = case t of
@@ -495,6 +594,19 @@ updateMaxWithKey f t
       Bin sx kx x l r    -> balance kx x l (updateMaxWithKey f r)
       Tip                -> Tip
 
+-- | /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.
+minView :: Monad m => Map k a -> m (Map k a, (k,a))
+minView Tip = fail "Map.minView: empty map"
+minView x = return (swap $ deleteFindMin x)
+
+-- | /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.
+maxView :: Monad m => Map k a -> m (Map k a, (k,a))
+maxView Tip = fail "Map.maxView: empty map"
+maxView x = return (swap $ deleteFindMax x)
+
+swap (a,b) = (b,a)
 
 {--------------------------------------------------------------------
   Union. 
@@ -516,13 +628,11 @@ unionsWith f ts
 -- 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 :: Ord k => Map k a -> Map k a -> Map k a
 union Tip t2  = t2
 union t1 Tip  = t1
-union t1 t2
-   | size t1 >= size t2  = hedgeUnionL (const LT) (const GT) t1 t2
-   | otherwise           = hedgeUnionR (const LT) (const GT) t2 t1
+union t1 t2 = hedgeUnionL (const LT) (const GT) t1 t2
 
 -- left-biased hedge union
 hedgeUnionL cmplo cmphi t1 Tip 
@@ -549,7 +659,7 @@ hedgeUnionR cmplo cmphi (Bin _ kx x l r) t2
     (found,gt)  = trimLookupLo kx cmphi t2
     newx        = case found of
                     Nothing -> x
-                    Just y  -> y
+                    Just (_,y) -> y
 
 {--------------------------------------------------------------------
   Union with a combining function
@@ -565,11 +675,7 @@ unionWith f m1 m2
 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 f t1 t2
-  | size t1 >= size t2  = hedgeUnionWithKey f (const LT) (const GT) t1 t2
-  | otherwise           = hedgeUnionWithKey flipf (const LT) (const GT) t2 t1
-  where
-    flipf k x y   = f k y x
+unionWithKey f t1 t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2
 
 hedgeUnionWithKey f cmplo cmphi t1 Tip 
   = t1
@@ -584,7 +690,7 @@ hedgeUnionWithKey f cmplo cmphi (Bin _ kx x l r) t2
     (found,gt)  = trimLookupLo kx cmphi t2
     newx        = case found of
                     Nothing -> x
-                    Just y  -> f kx x y
+                    Just (_,y) -> f kx x y
 
 {--------------------------------------------------------------------
   Difference
@@ -629,9 +735,10 @@ hedgeDiffWithKey f cmplo cmphi (Bin _ kx x l r) Tip
 hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r) 
   = case found of
       Nothing -> merge tl tr
-      Just y  -> case f kx y x of
-                   Nothing -> merge tl tr
-                   Just z  -> join kx z tl tr
+      Just (ky,y) -> 
+          case f ky y x of
+            Nothing -> merge tl tr
+            Just z  -> join ky z tl tr
   where
     cmpkx k     = compare kx k   
     lt          = trim cmplo cmpkx t
@@ -657,25 +764,40 @@ intersectionWith f m1 m2
 
 -- | /O(n+m)/. Intersection with a combining function.
 -- Intersection is more efficient on (bigset `intersection` smallset)
+--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 f t1 t2 = intersectWithKey f t1 t2
+--
+--intersectWithKey f Tip t = Tip
+--intersectWithKey f t Tip = Tip
+--intersectWithKey f t (Bin _ kx x l r)
+--  = case found of
+--      Nothing -> merge tl tr
+--      Just y  -> join kx (f kx y x) tl tr
+--  where
+--    (lt,found,gt) = splitLookup kx t
+--    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 f t1 t2
-  | size t1 >= size t2  = intersectWithKey f t1 t2
-  | otherwise           = intersectWithKey flipf t2 t1
-  where
-    flipf k x y   = f k y x
-
-intersectWithKey f Tip t = Tip
-intersectWithKey f t Tip = Tip
-intersectWithKey f t (Bin _ kx x l r)
-  = case found of
+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
+          tl            = intersectionWithKey f lt l2
+          tr            = intersectionWithKey f gt r2
+      in case found of
+      Just (k,x) -> join k (f k x x2) tl tr
+      Nothing -> merge tl tr
+   else let (lt,found,gt) = splitLookup k1 t2
+            tl            = intersectionWithKey f l1 lt
+            tr            = intersectionWithKey f r1 gt
+      in case found of
+      Just x -> join k1 (f k1 x1 x) tl tr
       Nothing -> merge tl tr
-      Just y  -> join kx (f kx y x) tl tr
-  where
-    (found,lt,gt) = splitLookup kx t
-    tl            = intersectWithKey f lt l
-    tr            = intersectWithKey f gt r
 
 
 
@@ -715,7 +837,7 @@ submap' f (Bin _ kx x l r) t
       Nothing -> False
       Just y  -> f x y && submap' f l lt && submap' f r gt
   where
-    (found,lt,gt) = splitLookup kx t
+    (lt,found,gt) = splitLookup kx t
 
 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). 
 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
@@ -778,6 +900,33 @@ partitionWithKey p (Bin _ kx x l r)
     (l1,l2) = partitionWithKey p l
     (r1,r2) = partitionWithKey p r
 
+-- | /O(n)/. Map values and collect the 'Just' results.
+mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
+mapMaybe f m
+  = mapMaybeWithKey (\k x -> f x) m
+
+-- | /O(n)/. Map keys\/values and collect the 'Just' results.
+mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b
+mapMaybeWithKey f 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.
+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
+
+-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
+mapEitherWithKey :: Ord k =>
+  (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
+mapEitherWithKey f 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)
+  where
+    (l1,l2) = mapEitherWithKey f l
+    (r1,r2) = mapEitherWithKey f r
 
 {--------------------------------------------------------------------
   Mapping
@@ -794,19 +943,19 @@ 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 an unspecified order.
+-- argument through the map in ascending order of keys.
 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
 
 -- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating
--- argument through the map in unspecified order. (= ascending pre-order)
+-- argument through the map in ascending order of keys.
 mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
 mapAccumWithKey f a t
   = mapAccumL f a t
 
 -- | /O(n)/. The function 'mapAccumL' threads an accumulating
--- argument throught the map in (ascending) pre-order.
+-- argument throught the map in ascending order of keys.
 mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
 mapAccumL f a t
   = case t of
@@ -818,7 +967,7 @@ mapAccumL f a t
              in (a3,Bin sx kx x' l' r')
 
 -- | /O(n)/. The function 'mapAccumR' threads an accumulating
--- argument throught the map in (descending) post-order.
+-- argument throught the map in descending order of keys.
 mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
 mapAccumR f a t
   = case t of
@@ -832,8 +981,9 @@ mapAccumR f a t
 -- | /O(n*log n)/. 
 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
 -- 
--- It's worth noting that the size of the result may be smaller if,
--- for some @(x,y)@, @x \/= y && f x == f y@
+-- 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 :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
 mapKeys = mapKeysWith (\x y->x)
@@ -841,9 +991,9 @@ mapKeys = mapKeysWith (\x y->x)
 -- | /O(n*log n)/. 
 -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
 -- 
--- It's worth noting that the size of the result may be smaller if,
--- for some @(x,y)@, @x \/= y && f x == f y@
--- In such a case, the values will be combined using @c@
+-- 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 :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
 mapKeysWith c f = fromListWith c . List.map fFirst . toList
@@ -851,7 +1001,8 @@ mapKeysWith c f = fromListWith c . List.map fFirst . toList
 
 
 -- | /O(n)/.
--- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ is monotonic.
+-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
+-- is strictly monotonic.
 -- /The precondition is not checked./
 -- Semi-formally, we have:
 -- 
@@ -867,12 +1018,23 @@ mapKeysMonotonic f (Bin sz k x l r) =
 {--------------------------------------------------------------------
   Folds  
 --------------------------------------------------------------------}
--- | /O(n)/. Fold the map in an unspecified order. (= descending post-order).
+
+-- | /O(n)/. Fold the values in the map, such that
+-- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
+-- For example,
+--
+-- > elems map = fold (:) [] map
+--
 fold :: (a -> b -> b) -> b -> Map k a -> b
 fold f z m
   = foldWithKey (\k x z -> f x z) z m
 
--- | /O(n)/. Fold the map in an unspecified order. (= descending post-order).
+-- | /O(n)/. Fold the keys and values in the map, such that
+-- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
+-- For example,
+--
+-- > keys map = foldWithKey (\k x ks -> k:ks) [] map
+--
 foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
 foldWithKey f z t
   = foldr f z t
@@ -895,12 +1057,13 @@ 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.
+-- | /O(n)/.
+-- Return all elements of the map in the ascending order of their keys.
 elems :: Map k a -> [a]
 elems m
   = [x | (k,x) <- assocs m]
 
--- | /O(n)/. Return all keys of the map.
+-- | /O(n)/. Return all keys of the map in ascending order.
 keys  :: Map k a -> [k]
 keys m
   = [k | (k,x) <- assocs m]
@@ -909,7 +1072,7 @@ keys m
 keysSet :: Map k a -> Set.Set k
 keysSet m = Set.fromDistinctAscList (keys m)
 
--- | /O(n)/. Return all key\/value pairs in the map.
+-- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
 assocs :: Map k a -> [(k,a)]
 assocs m
   = toList m
@@ -1042,15 +1205,15 @@ trim cmplo cmphi t@(Bin sx kx x l r)
               le -> trim cmplo cmphi l
       ge -> trim cmplo cmphi r
               
-trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe a, Map k a)
+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)
   = case compare lo kx of
       LT -> case cmphi kx of
-              GT -> (lookup lo t, t)
+              GT -> (lookupAssoc lo t, t)
               le -> trimLookupLo lo cmphi l
       GT -> trimLookupLo lo cmphi r
-      EQ -> (Just x,trim (compare lo) cmphi r)
+      EQ -> (Just (kx,x),trim (compare lo) cmphi r)
 
 
 {--------------------------------------------------------------------
@@ -1088,13 +1251,29 @@ split k (Bin sx kx x l r)
 
 -- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just
 -- like 'split' but also returns @'lookup' k map@.
-splitLookup :: Ord k => k -> Map k a -> (Maybe a,Map k a,Map k a)
-splitLookup k Tip = (Nothing,Tip,Tip)
+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)
   = case compare k kx of
-      LT -> let (z,lt,gt) = splitLookup k l in (z,lt,join kx x gt r)
-      GT -> let (z,lt,gt) = splitLookup k r in (z,join kx x l lt,gt)
-      EQ -> (Just x,l,r)
+      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)
+      EQ -> (l,Just x,r)
+
+-- | /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)
+  = 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)
+
+-- | /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.
@@ -1211,7 +1390,7 @@ deleteFindMax t
   - A lower [delta] leads to a more 'perfectly' balanced tree.
   - A higher [delta] performs less rebalancing.
 
-  - Balancing is automaic for random data and a balancing
+  - Balancing is automatic for random data and a balancing
     scheme is only necessary to avoid pathological worst cases.
     Almost any choice will do, and in practice, a rather large
     [delta] may perform better than smaller one.
@@ -1274,28 +1453,55 @@ instance (Eq k,Eq a) => Eq (Map k a) where
 --------------------------------------------------------------------}
 
 instance (Ord k, Ord v) => Ord (Map k v) where
-    compare m1 m2 = compare (toList m1) (toList m2)
+    compare m1 m2 = compare (toAscList m1) (toAscList m2)
 
 {--------------------------------------------------------------------
-  Monoid 
+  Functor
 --------------------------------------------------------------------}
+instance Functor (Map k) where
+  fmap f m  = map f m
 
-instance (Ord k) => Monoid (Map k v) where
-    mempty = empty
-    mappend = union
-    mconcat = unions
+instance Traversable (Map k) where
+  traverse f Tip = pure Tip
+  traverse f (Bin s k v l r)
+    = flip (Bin s k) <$> traverse f l <*> f v <*> traverse f r
+
+instance Foldable (Map k) where
+  foldMap _f Tip = mempty
+  foldMap f (Bin _s _k v l r)
+    = foldMap f l `mappend` f v `mappend` foldMap f r
 
 {--------------------------------------------------------------------
-  Functor
+  Read
 --------------------------------------------------------------------}
-instance Functor (Map k) where
-  fmap f m  = map f m
+instance (Ord k, Read k, Read e) => Read (Map k e) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromList" <- lexP
+    xs <- readPrec
+    return (fromList xs)
+
+  readListPrec = readListPrecDefault
+#else
+  readsPrec p = readParen (p > 10) $ \ r -> do
+    ("fromList",s) <- lex r
+    (xs,t) <- reads s
+    return (fromList xs,t)
+#endif
+
+-- 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
 --------------------------------------------------------------------}
 instance (Show k, Show a) => Show (Map k a) where
-  showsPrec d m  = showMap (toAscList m)
+  showsPrec d m  = showParen (d > 10) $
+    showString "fromList " . shows (toList m)
 
 showMap :: (Show k,Show a) => [(k,a)] -> ShowS
 showMap []     
@@ -1304,9 +1510,9 @@ showMap (x:xs)
   = showChar '{' . showElem x . showTail xs
   where
     showTail []     = showChar '}'
-    showTail (x:xs) = showChar ',' . 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