Make sure forM_ and related functions fuse cleanly

Summary:
It was revealed in #8763 that it's hard to come up with a list fusion
helper for `efdtIntFB` that doesn't duplicated occurrences of `c`,
which is crucial in guaranteeing that it is inlined.

Not inlining `c` led to spoiled join points, in turn leading to unnecessary
heap allocation. This patch tackles the problem from a different angle:
Fixing all consumers instead of the less often used producer
`efdtIntFB` by inserting an INLINE pragma in the appropriate places.
See https://ghc.haskell.org/trac/ghc/ticket/8763#comment:76 and the new
Note [List fusion and continuations in 'c'].

A quick run of NoFib revealed no regression or improvements whatsoever.

Reviewers: hvr, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, carter

GHC Trac Issues: #8763

Differential Revision: https://phabricator.haskell.org/D5131

2 files changed, 48 insertions, 0 deletions

diff --git a/testsuite/tests/perf/should_run/T8763.hs b/testsuite/tests/perf/should_run/T8763.hs
new file mode 100644
index 0000000000..90c4436ce9
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T8763.hs
@@ -0,0 +1,41 @@
+-- | The fusion helper for @enumFromThenTo \@Int@ had multiple
+-- occurences of @c@, which made the simplifier refuse to inline it.
+-- The new implementation for @efdtInt{Up,Dn}FB@ only have a single
+-- occurence of @c@ which the simplifier inlines unconditionally.
+module Main  (main) where
+
+import Control.Monad (when, forM_)
+import GHC.ST
+
+nop :: Monad m => a -> m ()
+nop _ = return ()
+{-# NOINLINE nop #-}
+
+-- This is the baseline, using @enumFromTo@ which already had only a
+-- single occurence of @c@.
+f :: Int -> ST s ()
+f n =
+    do
+      forM_ [2..n] $ \p -> do
+        let isPrime = p == (p - 1)
+        when isPrime $
+          forM_ [p + p, p + p + p .. n] $ \k ->  do
+            nop k
+{-# NOINLINE f #-}
+
+g :: Int -> ST s ()
+g n =
+    do
+      forM_ [2,3..n] $ \p -> do
+        -- This do block should be too big to get inlined multiple times.
+        -- Pad with @nop@s as necessary if this doesn't reproduce anymore.
+        let isPrime = p == (p - 1)
+        when isPrime $
+          forM_ [p + p, p + p + p .. n] $ \k ->  do
+            nop k
+{-# NOINLINE g #-}
+
+main :: IO ()
+main = do
+  -- runST (f 40000000) `seq` return ()
+  runST (g 40000000) `seq` return ()
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 1a85e7073d..37ce0a454f 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -518,6 +518,13 @@ test('T13001',
      compile_and_run,
      ['-O2'])
 
+test('T8763',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(64),    41056, 20) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
+
 test('T12990',
     [stats_num_field('bytes allocated',
                      [ (wordsize(64), 20040936, 5) ]),