Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e867b112086e9c0001034af6826e2d1f6547ee45 >--------------------------------------------------------------- commit e867b112086e9c0001034af6826e2d1f6547ee45 Author: Milan Straka <[email protected]> Date: Thu Nov 24 16:12:56 2011 +0100 Remove obsolete stuff from Data.Map.Base. >--------------------------------------------------------------- Data/Map/Base.hs | 72 ------------------------------------------------------ 1 files changed, 0 insertions(+), 72 deletions(-) diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs index d32eb3d..1e6096f 100644 --- a/Data/Map/Base.hs +++ b/Data/Map/Base.hs @@ -79,11 +79,8 @@ module Data.Map.Base ( -- ** Insertion , insert , insertWith - , insertWith' , insertWithKey - , insertWithKey' , insertLookupWithKey - , insertLookupWithKey' -- ** Delete\/Update , delete @@ -134,9 +131,6 @@ module Data.Map.Base ( , foldl' , foldrWithKey' , foldlWithKey' - -- ** Legacy folds - , fold - , foldWithKey -- * Conversion , elems @@ -506,17 +500,6 @@ insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith f = insertWithKey (\_ x' y' -> f x' y') {-# INLINE insertWith #-} --- | Same as 'insertWith', but the combining function is applied strictly. --- This is often the most desirable behavior. >--------------------------------------------------------------- --- For example, to update a counter: >--------------------------------------------------------------- --- > insertWith' (+) k 1 m >--------------------------------------------------------------- -insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a -insertWith' f = insertWithKey' (\_ x' y' -> f x' y') -{-# INLINE insertWith' #-} - -- | /O(log n)/. Insert with a function, combining key, new value and old value. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does @@ -545,23 +528,6 @@ insertWithKey = go {-# INLINE insertWithKey #-} #endif --- | 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' = go - where - STRICT_2_OF_4(go) - go _ kx x Tip = x `seq` singleton kx x - go f kx x (Bin sy ky y l r) = - case compare kx ky of - LT -> balanceL ky y (go f kx x l) r - GT -> balanceR ky y l (go f kx x r) - EQ -> let x' = f kx x y in x' `seq` (Bin sy kx x' l r) -#if __GLASGOW_HASKELL__ >= 700 -{-# INLINEABLE insertWithKey' #-} -#else -{-# INLINE insertWithKey' #-} -#endif - -- | /O(log n)/. Combines insert operation with old value retrieval. -- The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) @@ -597,26 +563,6 @@ insertLookupWithKey = go {-# INLINE insertLookupWithKey #-} #endif --- | /O(log n)/. A strict version of 'insertLookupWithKey'. -insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a - -> (Maybe a, Map k a) -insertLookupWithKey' = go - where - STRICT_2_OF_4(go) - go _ kx x Tip = x `seq` (Nothing, singleton kx x) - go f kx x (Bin sy ky y l r) = - case compare kx ky of - LT -> let (found, l') = go f kx x l - in (found, balanceL ky y l' r) - GT -> let (found, r') = go f kx x r - in (found, balanceR ky y l r') - EQ -> let x' = f kx x y in x' `seq` (Just y, Bin sy kx x' l r) -#if __GLASGOW_HASKELL__ >= 700 -{-# INLINEABLE insertLookupWithKey' #-} -#else -{-# INLINE insertLookupWithKey' #-} -#endif - {-------------------------------------------------------------------- Deletion [delete] is the inlined version of [deleteWith (\k x -> Nothing)] @@ -1663,15 +1609,6 @@ mapKeysMonotonic f (Bin sz k x l r) = --------------------------------------------------------------------} -- | /O(n)/. Fold the values in the map using the given right-associative --- binary operator. This function is an equivalent of 'foldr' and is present --- for compatibility only. >--------------------------------------------------------------- --- /Please note that fold will be deprecated in the future and removed./ -fold :: (a -> b -> b) -> b -> Map k a -> b -fold = foldr -{-# INLINE fold #-} - --- | /O(n)/. Fold the values in the map using the given right-associative -- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. -- -- For example, @@ -1726,15 +1663,6 @@ foldl' f = go {-# INLINE foldl' #-} -- | /O(n)/. Fold the keys and values in the map using the given right-associative --- binary operator. This function is an equivalent of 'foldrWithKey' and is present --- for compatibility only. >--------------------------------------------------------------- --- /Please note that foldWithKey will be deprecated in the future and removed./ -foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b -foldWithKey = foldrWithKey -{-# INLINE foldWithKey #-} - --- | /O(n)/. Fold the keys and values in the map using the given right-associative -- binary operator, such that -- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. -- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
