summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2020-05-26 19:29:10 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-30 06:08:43 -0400
commit7c555b054bf074a9ab612f9d93e3475bfb8c6594 (patch)
treeac4baf6c0d7a13937fe66b27f87a1b128830a045
parent7f8f948c024c46282228243391238d09b297cd9d (diff)
downloadhaskell-7c555b054bf074a9ab612f9d93e3475bfb8c6594.tar.gz
Optimize GHC.Utils.Monad.
Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec -------------------------
-rw-r--r--compiler/GHC/Utils/Monad.hs37
1 files changed, 25 insertions, 12 deletions
diff --git a/compiler/GHC/Utils/Monad.hs b/compiler/GHC/Utils/Monad.hs
index 9e53edd0bb..c4abd3785f 100644
--- a/compiler/GHC/Utils/Monad.hs
+++ b/compiler/GHC/Utils/Monad.hs
@@ -138,22 +138,31 @@ mapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f
-- See Note [Inline @mapAndUnzipNM@ functions] above.
mapAndUnzip5M f xs = unzip5 <$> traverse f xs
+-- TODO: mapAccumLM is used in many places. Surely most of
+-- these don't actually want to be lazy. We should add a strict
+-- variant and use it where appropriate.
+
-- | Monadic version of mapAccumL
mapAccumLM :: Monad m
=> (acc -> x -> m (acc, y)) -- ^ combining function
-> acc -- ^ initial state
-> [x] -- ^ inputs
-> m (acc, [y]) -- ^ final state, outputs
-mapAccumLM _ s [] = return (s, [])
-mapAccumLM f s (x:xs) = do
- (s1, x') <- f s x
- (s2, xs') <- mapAccumLM f s1 xs
- return (s2, x' : xs')
+mapAccumLM f s xs =
+ go s xs
+ where
+ go s (x:xs) = do
+ (s1, x') <- f s x
+ (s2, xs') <- go s1 xs
+ return (s2, x' : xs')
+ go s [] = return (s, [])
-- | Monadic version of mapSnd
mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
-mapSndM _ [] = return []
-mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
+mapSndM f xs = go xs
+ where
+ go [] = return []
+ go ((a,b):xs) = do { c <- f b; rs <- go xs; return ((a,c):rs) }
-- | Monadic version of concatMap
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
@@ -176,15 +185,19 @@ fmapEitherM _ fr (Right b) = fr b >>= (return . Right)
-- | Monadic version of 'any', aborts the computation at the first @True@ value
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-anyM _ [] = return False
-anyM f (x:xs) = do b <- f x
+anyM f xs = go xs
+ where
+ go [] = return False
+ go (x:xs) = do b <- f x
if b then return True
- else anyM f xs
+ else go xs
-- | Monad version of 'all', aborts the computation at the first @False@ value
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-allM _ [] = return True
-allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)
+allM f bs = go bs
+ where
+ go [] = return True
+ go (b:bs) = (f b) >>= (\bv -> if bv then go bs else return False)
-- | Monadic version of or
orM :: Monad m => m Bool -> m Bool -> m Bool