X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FIntMap.hs;h=f9ee03a21febb3957181df5d47942ce4f85ac087;hb=68937167ecaa5ddaeb0420ad8c204902e09c508b;hp=fd648cb6d9c6863c8cf88899df12967394174deb;hpb=6cd8e25a9ad88133e04f424b6daf0c6a7db2bba8;p=haskell-directory.git

diff --git a/Data/IntMap.hs b/Data/IntMap.hs
index fd648cb..f9ee03a 100644
--- a/Data/IntMap.hs
+++ b/Data/IntMap.hs
@@ -147,6 +147,7 @@ import qualified List
 -}  
 
 #if __GLASGOW_HASKELL__
+import Text.Read
 import Data.Generics.Basics
 import Data.Generics.Instances
 #endif
@@ -296,11 +297,11 @@ singleton k x
 
 {--------------------------------------------------------------------
   Insert
-  'insert' is the inlined version of 'insertWith (\k x y -> x)'
 --------------------------------------------------------------------}
--- | /O(min(n,W))/. Insert a new key\/value pair in the map. When the key 
--- is already an element of the set, its value is replaced by the new value, 
--- ie. 'insert' is left-biased.
+-- | /O(min(n,W))/. Insert a new key\/value pair in the map.
+-- If the key is already present in the map, the associated value is
+-- replaced with the supplied value, i.e. 'insert' is equivalent to
+-- @'insertWith' 'const'@.
 insert :: Key -> a -> IntMap a -> IntMap a
 insert k x t
   = case t of
@@ -432,7 +433,9 @@ 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 sets. 
+-- | /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 :: IntMap a -> IntMap a -> IntMap a
 union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
   | shorter m1 m2  = union1
@@ -796,6 +799,7 @@ split :: Key -> IntMap a -> (IntMap a,IntMap a)
 split k t
   = case t of
       Bin p m l r
+        | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
         | zero k m  -> let (lt,gt) = split k l in (lt,union gt r)
         | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
       Tip ky y 
@@ -810,6 +814,7 @@ splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
 splitLookup k t
   = case t of
       Bin p m l r
+        | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
         | zero k m  -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
         | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
       Tip ky y 
@@ -974,8 +979,8 @@ instance Functor IntMap where
 --------------------------------------------------------------------}
 
 instance Show a => Show (IntMap a) where
-  showsPrec d t   = showMap (toList t)
-
+  showsPrec d m   = showParen (d > 10) $
+    showString "fromList " . shows (toList m)
 
 showMap :: (Show a) => [(Key,a)] -> ShowS
 showMap []     
@@ -987,7 +992,25 @@ showMap (x:xs)
     showTail (x:xs) = showChar ',' . showElem x . showTail xs
     
     showElem (k,x)  = shows k . showString ":=" . shows x
-  
+
+{--------------------------------------------------------------------
+  Read
+--------------------------------------------------------------------}
+instance (Read e) => Read (IntMap e) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromList" <- lexP
+    xs <- readPrec
+    return (fromList xs)
+
+  readListPrec = readListPrecDefault
+#else
+  readsPrec p = readParen (p > 10) $ \ r -> do
+    ("fromList",s) <- lex r
+    (xs,t) <- reads s
+    return (fromList xs,t)
+#endif
+
 {--------------------------------------------------------------------
   Typeable
 --------------------------------------------------------------------}