Jan-Willem Maessen's improved implementation of Data.HashTable

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

diff --git a/Data/IntMap.hs b/Data/IntMap.hs
index d5fc9e7..652a23e 100644 (file)
--- a/Data/IntMap.hs
+++ b/Data/IntMap.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp -fglasgow-exts #-} 
+{-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-} 
 -----------------------------------------------------------------------------
 -- Module      :  Data.IntMap
 -- Copyright   :  (c) Daan Leijen 2002
@@ -45,6 +45,7 @@ module Data.IntMap  (
             , null
             , size
             , member
+            , notMember
            , lookup
             , findWithDefault
             
@@ -63,6 +64,7 @@ module Data.IntMap  (
             , update
             , updateWithKey
             , updateLookupWithKey
+            , alter
   
             -- * Combine
 
@@ -236,7 +238,7 @@ instance Data a => Data (IntMap a) where
   toConstr _    = error "toConstr"
   gunfold _ _   = error "gunfold"
   dataTypeOf _  = mkNorepType "Data.IntMap.IntMap"
-  dataCast1      = gcast1
+  dataCast1 f   = gcast1 f
 
 #endif
 
@@ -263,9 +265,18 @@ member k m
       Nothing -> False
       Just x  -> True
     
+-- | /O(log n)/. Is the key not a member of the map?
+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 :: Key -> IntMap a -> Maybe a
-lookup k t
+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
   = let nk = natFromInt k  in seq nk (lookupN nk t)
 
 lookupN :: Nat -> IntMap a -> Maybe a
@@ -441,6 +452,30 @@ updateLookupWithKey f k t
       Nil -> (Nothing,Nil)
 
 
+
+-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- 'alter' can be used to insert, delete, or update a value in a 'Map'.
+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
+alter f k t
+  = case t of
+      Bin p m l r 
+        | nomatch k p m -> case f Nothing of 
+                             Nothing -> t
+                             Just x -> join k (Tip k x) p t
+        | zero k m      -> bin p m (alter f k l) r
+        | otherwise     -> bin p m l (alter f k r)
+      Tip ky y          
+        | k==ky         -> case f (Just y) of
+                             Just x -> Tip ky x
+                             Nothing -> Nil
+        | otherwise     -> case f Nothing of
+                             Just x -> join k (Tip k x) ky t
+                             Nothing -> Tip ky y
+      Nil               -> case f Nothing of
+                             Just x -> Tip k x
+                             Nothing -> Nil
+
+
 {--------------------------------------------------------------------
   Union
 --------------------------------------------------------------------}