Sync with FPS head, including the following patches:

[haskell-directory.git] / Data / Map.hs

diff --git a/Data/Map.hs b/Data/Map.hs
index d88ceb5..54730f8 100644 (file)
--- a/Data/Map.hs
+++ b/Data/Map.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Map
@@ -42,6 +44,7 @@ module Data.Map  (
             , null
             , size
             , member
+            , notMember
             , lookup
             , findWithDefault
             
@@ -60,6 +63,7 @@ module Data.Map  (
             , update
             , updateWithKey
             , updateLookupWithKey
+            , alter
 
             -- * Combine
 
@@ -156,7 +160,7 @@ import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Monoid (Monoid(..))
 import Data.Typeable
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), (<$>))
 import Data.Traversable (Traversable(traverse))
 import Data.Foldable (Foldable(foldMap))
 
@@ -270,6 +274,10 @@ member k m
       Nothing -> False
       Just x  -> True
 
+-- | /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
@@ -420,6 +428,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
 --------------------------------------------------------------------}