diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2020-05-26 19:29:10 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-30 06:08:43 -0400 |
commit | 7c555b054bf074a9ab612f9d93e3475bfb8c6594 (patch) | |
tree | ac4baf6c0d7a13937fe66b27f87a1b128830a045 /compiler | |
parent | 7f8f948c024c46282228243391238d09b297cd9d (diff) | |
download | haskell-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
-------------------------
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Utils/Monad.hs | 37 |
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 |