X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMap.hs;h=37a9695dca86ce010ae0d5bb628c0b3ecff925c3;hb=68937167ecaa5ddaeb0420ad8c204902e09c508b;hp=e2dd0b603eb6637d64c07935d1d1e8054fa1778a;hpb=bbbba97cbcf12039810533e3a2daf2eefdefe7f0;p=haskell-directory.git diff --git a/Data/Map.hs b/Data/Map.hs index e2dd0b6..37a9695 100644 --- a/Data/Map.hs +++ b/Data/Map.hs @@ -1,31 +1,34 @@ --------------------------------------------------------------------------------- -{-| Module : Data.Map - Copyright : (c) Daan Leijen 2002 - License : BSD-style - Maintainer : libraries@haskell.org - Stability : provisional - Portability : portable - - 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. - - > import Data.Map as Map - - The implementation of "Map" is based on /size balanced/ binary trees (or - trees of /bounded balance/) as described by: - - * Stephen Adams, \"/Efficient sets: a balancing act/\", Journal of Functional - Programming 3(4):553-562, October 1993, . +----------------------------------------------------------------------------- +-- | +-- Module : Data.Map +-- Copyright : (c) Daan Leijen 2002 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- 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. +-- +-- > import Data.Map as Map +-- +-- The implementation of 'Map' is based on /size balanced/ binary trees (or +-- trees of /bounded balance/) as described by: +-- +-- * Stephen Adams, \"/Efficient sets: a balancing act/\", +-- Journal of Functional Programming 3(4):553-562, October 1993, +-- . +-- +-- * J. Nievergelt and E.M. Reingold, +-- \"/Binary search trees of bounded balance/\", +-- SIAM journal of computing 2(1), March 1973. +----------------------------------------------------------------------------- - * J. Nievergelt and E.M. Reingold, \"/Binary search trees of bounded balance/\", - SIAM journal of computing 2(1), March 1973. --} ----------------------------------------------------------------------------------- module Data.Map ( -- * Map type - Map -- instance Eq,Show + Map -- instance Eq,Show,Read -- * Operators , (!), (\\) @@ -145,9 +148,9 @@ 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.Typeable {- -- for quick check @@ -157,12 +160,19 @@ import Debug.QuickCheck import List(nub,sort) -} +#if __GLASGOW_HASKELL__ +import Text.Read +import Data.Generics.Basics +import Data.Generics.Instances +#endif + {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} 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 @@ -179,6 +189,23 @@ data Map k a = Tip type Size = Int +#if __GLASGOW_HASKELL__ + +{-------------------------------------------------------------------- + A Data instance +--------------------------------------------------------------------} + +-- This instance preserves data abstraction at the cost of inefficiency. +-- 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) + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "Data.Map.Map" + +#endif + {-------------------------------------------------------------------- Query --------------------------------------------------------------------} @@ -197,15 +224,19 @@ 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. +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 -- | /O(log n)/. Is the key a member of the map? @@ -215,15 +246,16 @@ 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)/. 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 Nothing -> error "Map.find: element not in the map" 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. +-- | /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. findWithDefault :: Ord k => a -> k -> Map k a -> a findWithDefault def k m = case lookup k m of @@ -240,16 +272,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 @@ -276,9 +310,9 @@ insertWithKey f kx x t GT -> balance ky y l (insertWithKey f kx x r) EQ -> Bin sy ky (f ky x y) 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@) and the second element --- equal to (@insertWithKey f k x map@). +-- | /O(log n)/. 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@). 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 @@ -317,16 +351,17 @@ 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 --- | /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@. +-- | /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@. update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a update f k m = updateWithKey (\k x -> f 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 k x@) is @Nothing@, the element is --- deleted. If it is (@Just y@), the key @k@ is bound to the new value @y@. +-- | /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@. updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a updateWithKey f k t = case t of @@ -366,9 +401,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) @@ -403,7 +439,8 @@ updateAt f i (Bin sx kx x l r) where sizeL = size l --- | /O(log n)/. Delete the element at /index/. Defined as (@deleteAt i map = updateAt (\k x -> Nothing) i map@). +-- | /O(log n)/. Delete the element at /index/. +-- Defined as (@'deleteAt' i map = 'updateAt' (\k x -> 'Nothing') i map@). deleteAt :: Int -> Map k a -> Map k a deleteAt i map = updateAt (\k x -> Nothing) i map @@ -436,18 +473,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 @@ -457,7 +494,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 @@ -471,20 +508,22 @@ updateMaxWithKey f t {-------------------------------------------------------------------- Union. --------------------------------------------------------------------} --- | The union of a list of maps: (@unions == foldl union empty@). +-- | The union of a list of maps: +-- (@'unions' == 'Prelude.foldl' 'union' 'empty'@). 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 == foldl (unionWith f) empty@). +-- (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@). unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a unionsWith f ts = foldlStrict (unionWith f) empty ts -- | /O(n+m)/. -- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. --- It prefers @t1@ when duplicate keys are encountered, ie. (@union == unionWith const@). +-- 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)? union :: Ord k => Map k a -> Map k a -> Map k a @@ -584,8 +623,8 @@ differenceWith f 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@. +-- 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/. differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWithKey f Tip t2 = Tip @@ -615,19 +654,19 @@ hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r) 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@). +-- map are returned, i.e. (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). intersection :: Ord k => Map k a -> Map k b -> Map k a intersection m1 m2 = intersectionWithKey (\k x y -> x) m1 m2 -- | /O(n+m)/. Intersection with a combining function. -intersectionWith :: Ord k => (a -> b -> a) -> Map k a -> Map k b -> Map k a +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 -- | /O(n+m)/. Intersection with a combining function. -- Intersection is more efficient on (bigset `intersection` smallset) -intersectionWithKey :: Ord k => (k -> a -> b -> a) -> Map k a -> Map k b -> Map k 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 intersectionWithKey f t1 t2 @@ -643,7 +682,7 @@ intersectWithKey f t (Bin _ kx x l r) Nothing -> merge tl tr Just y -> join kx (f kx y x) tl tr where - (found,lt,gt) = splitLookup kx t + (lt,found,gt) = splitLookup kx t tl = intersectWithKey f lt l tr = intersectWithKey f gt r @@ -653,22 +692,22 @@ intersectWithKey f t (Bin _ kx x l r) Submap --------------------------------------------------------------------} -- | /O(n+m)/. --- This function is defined as (@submap = submapBy (==)@). +-- 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)/. - The expression (@isSubmapOfBy f t1 t2@) returns @True@ if - all keys in @t1@ are in tree @t2@, and when @f@ returns @True@ when + 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 - expressions are all @True@. + expressions are all 'True': > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) - But the following are all @False@: + But the following are all 'False': > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @@ -685,25 +724,25 @@ 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 (==)@). +-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2 = isProperSubmapOfBy (==) m1 m2 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). - The expression (@isProperSubmapOfBy f m1 m2@) returns @True@ when + The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not equal, - all keys in @m1@ are in @m2@, and when @f@ returns @True@ when + all keys in @m1@ are in @m2@, and when @f@ returns 'True' when applied to their respective values. For example, the following - expressions are all @True@. + expressions are all 'True': > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) - But the following are all @False@: + But the following are all 'False': > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @@ -763,20 +802,20 @@ mapWithKey f 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 an unspecified order. +-- | /O(n)/. The function 'mapAccum' threads an accumulating +-- 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) +-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating +-- 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. +-- | /O(n)/. The function 'mapAccumL' threads an accumulating +-- 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 @@ -787,8 +826,8 @@ mapAccumL f a t (a3,r') = mapAccumL f a2 r in (a3,Bin sx kx x' l' r') --- | /O(n)/. The function @mapAccumR@ threads an accumulating --- argument throught the map in (descending) post-order. +-- | /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) mapAccumR f a t = case t of @@ -800,34 +839,35 @@ mapAccumR f a t in (a3,Bin sx kx x' l' r') -- | /O(n*log n)/. --- @mapKeys f s@ is the map obtained by applying @f@ to each key of @s@. +-- @'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) -- | /O(n*log n)/. --- @mapKeysWith c f s@ is the map obtained by applying @f@ to each key of @s@. +-- @'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 where fFirst (x,y) = (f x, y) --- | /O(n)/. The --- --- @mapMonotonic f s == 'map' f s@, but works only when @f@ is monotonic. +-- | /O(n)/. +-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ +-- is strictly monotonic. -- /The precondition is not checked./ -- Semi-formally, we have: -- -- > and [x < y ==> f x < f y | x <- ls, y <- ls] --- > ==> mapMonotonic f s == map f s +-- > ==> mapKeysMonotonic f s == mapKeys f s -- > where ls = keys s mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a @@ -838,12 +878,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 @@ -866,12 +917,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] @@ -880,7 +932,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 @@ -940,7 +992,8 @@ fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromAscListWith f xs = fromAscListWithKey (\k 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 +-- | /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./ fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs @@ -960,7 +1013,6 @@ fromAscListWithKey f xs -- | /O(n)/. Build a map from an ascending list of distinct elements in linear time. --- -- /The precondition is not checked./ fromDistinctAscList :: [(k,a)] -> Map k a fromDistinctAscList xs @@ -1047,7 +1099,7 @@ filterLt cmp (Bin sx kx x l r) {-------------------------------------------------------------------- Split --------------------------------------------------------------------} --- | /O(log n)/. The expression (@split k map@) is a pair @(map1,map2)@ where +-- | /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@. split :: Ord k => k -> Map k a -> (Map k a,Map k a) split k Tip = (Tip,Tip) @@ -1057,15 +1109,15 @@ split k (Bin sx kx x l r) GT -> let (lt,gt) = split k r in (join kx x l lt,gt) EQ -> (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) +-- | /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 -> (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) {-------------------------------------------------------------------- Utility functions that maintain the balance properties of the tree. @@ -1182,7 +1234,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. @@ -1245,16 +1297,7 @@ 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) - -{-------------------------------------------------------------------- - Monoid ---------------------------------------------------------------------} - -instance (Ord k) => Monoid (Map k v) where - mempty = empty - mappend = union - mconcat = unions + compare m1 m2 = compare (toAscList m1) (toAscList m2) {-------------------------------------------------------------------- Functor @@ -1263,10 +1306,36 @@ instance Functor (Map k) where fmap f m = map f m {-------------------------------------------------------------------- + Read +--------------------------------------------------------------------} +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 [] @@ -1275,9 +1344,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 @@ -1289,10 +1358,10 @@ showTree m showElem k x = show k ++ ":=" ++ show x -{- | /O(n)/. The expression (@showTreeWith showelem hang wide map@) shows +{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is - @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If - @wide@ is true, an extra wide version is shown. + 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If + @wide@ is 'True', an extra wide version is shown. > Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]] > Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t @@ -1371,6 +1440,12 @@ node = "+--" withBar bars = "| ":bars withEmpty bars = " ":bars +{-------------------------------------------------------------------- + Typeable +--------------------------------------------------------------------} + +#include "Typeable.h" +INSTANCE_TYPEABLE2(Map,mapTc,"Map") {-------------------------------------------------------------------- Assertions