Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/857ae5b7da3b730f579c546939e3d3776c237bff >--------------------------------------------------------------- commit 857ae5b7da3b730f579c546939e3d3776c237bff Author: Milan Straka <[email protected]> Date: Mon Apr 23 15:54:13 2012 +0200 Change INLINE to INLINABLE on methods using Ord. As mentioned previously, INLINE - INLINABLE method chain does not result in specialization, it has to be INLINABLE - INLINABLE. >--------------------------------------------------------------- Data/Map.hs | 6 +++--- 1 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Data/Map.hs b/Data/Map.hs index 3194e7e..910dc40 100644 --- a/Data/Map.hs +++ b/Data/Map.hs @@ -66,7 +66,7 @@ import qualified Data.Map.Strict as S -- insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith' = S.insertWith -{-# INLINE insertWith' #-} +{-# INLINABLE insertWith' #-} -- | /Deprecated./ As of version 0.5, replaced by 'S.insertWithKey'. -- @@ -74,7 +74,7 @@ insertWith' = S.insertWith -- applied strictly. insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey' = S.insertWithKey -{-# INLINE insertWithKey' #-} +{-# INLINABLE insertWithKey' #-} -- | /Deprecated./ As of version 0.5, replaced by -- 'S.insertLookupWithKey'. @@ -83,7 +83,7 @@ insertWithKey' = S.insertWithKey insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a) insertLookupWithKey' = S.insertLookupWithKey -{-# INLINE insertLookupWithKey' #-} +{-# INLINABLE insertLookupWithKey' #-} -- | /Deprecated./ As of version 0.5, replaced by 'L.foldr'. -- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
