[Git][ghc/ghc][master] Optimize GHC.Utils.Monad.

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00
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
-------------------------

- - - - -


1 changed file:

- compiler/GHC/Utils/Monad.hs


Changes:

=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c555b054bf074a9ab612f9d93e3475bfb8c6594

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c555b054bf074a9ab612f9d93e3475bfb8c6594
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200530/e81ab7b4/attachment-0001.html>