Make specialisation a bit more aggressive

The patch

    commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Fri Oct 23 16:15:51 2009 +0000
    Fix Trac #3591: very tricky specialiser bug

fixed a nasty specialisation bug /for DFuns/.  Eight years
later, this patch

    commit 2b74bd9d8b4c6b20f3e8d9ada12e7db645cc3c19
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Wed Jun 7 12:03:51 2017 +0100
    Stop the specialiser generating loopy code

extended it to work for /imported/ DFuns.  But in the process
we lost the fact that it was needed only for DFuns! As a result
we started silently losing useful specialisation for non-DFuns.
But there was no regression test to spot the lossage.

Then, nearly four years later, Andreas filed #19599, which showed
the lossage in high relief.  This patch restores the DFun test,
and adds Note [Avoiding loops (non-DFuns)] to explain why.

This is undoubtedly a very tricky corner of the specialiser,
and one where I would love to have a more solid argument, even a
paper!  But meanwhile I think this fixes the lost specialisations
without introducing any new loops.

I have two regression tests, T19599 and T19599a, so I hope we'll
know if we lose them again in the future.

Vanishingly small effect on nofib.

A couple of compile-time benchmarks improve
  T9872a(normal) ghc/alloc  1660559328.0  1643827784.0  -1.0% GOOD
  T9872c(normal) ghc/alloc  1691359152.0  1672879384.0  -1.1% GOOD
Many others wiggled around a bit.

Metric Decrease:
    T9872a
    T9872c

5 files changed, 49 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T19599.hs b/testsuite/tests/simplCore/should_compile/T19599.hs
new file mode 100644
index 0000000000..18619b4f86
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T19599.hs
@@ -0,0 +1,20 @@
+module SPEC where
+
+class (Show a, Enum a) => MyShow a where
+    myShow :: a -> String
+
+instance MyShow Int where
+    myShow = myShow_impl . succ
+
+foo :: Int -> String
+foo = myShow_impl
+
+-- This pragma should not be necessary
+-- {-# specialize myShow_impl :: Int -> String #-}
+
+{-# INLINEABLE myShow_impl #-}
+myShow_impl :: MyShow a => a -> String
+-- Make it large enough not to inline
+myShow_impl x = show . succ . succ . succ . succ . succ . succ .
+                succ . succ . succ . succ . succ . succ . succ .
+                succ . succ . succ $ x
diff --git a/testsuite/tests/simplCore/should_compile/T19599.stderr b/testsuite/tests/simplCore/should_compile/T19599.stderr
new file mode 100644
index 0000000000..0629c719fd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T19599.stderr
@@ -0,0 +1,6 @@
+
+==================== Tidy Core rules ====================
+"SPEC myShow_impl @Int"
+    forall ($dMyShow :: MyShow Int). myShow_impl @Int $dMyShow = foo
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T19599a.hs b/testsuite/tests/simplCore/should_compile/T19599a.hs
new file mode 100644
index 0000000000..a2e9ceb6a4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T19599a.hs
@@ -0,0 +1,14 @@
+module Spec where
+
+class C a where { foo,bar :: [a] -> [a] }
+
+instance C Int where
+     foo x = r_bar x
+     bar xs = reverse xs
+
+r_bar :: C a => [a] -> [a]
+r_bar (x:xs) = bar (xs ++ r_bar xs)
+r_bar [] = []
+
+-- We should specialise `r_bar` at Int
+-- C.f. Note Note [Avoiding loops (non-DFuns)] in GHC.Core.Opt.Specialise
diff --git a/testsuite/tests/simplCore/should_compile/T19599a.stderr b/testsuite/tests/simplCore/should_compile/T19599a.stderr
new file mode 100644
index 0000000000..17a0fd8330
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T19599a.stderr
@@ -0,0 +1,6 @@
+
+==================== Tidy Core rules ====================
+"SPEC r_bar @Int"
+    forall ($dC :: C Int). r_bar @Int $dC = $fCInt_$sr_bar
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 3a16d55508..04cab4234f 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -351,3 +351,6 @@ test('T19360', only_ways(['optasm']), compile, [''])
 
 # If the test goes wrong we'll get more case expressions in the output
 test('T19581', [ grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+
+test('T19599', normal, compile, ['-O -ddump-rules'])
+test('T19599a', normal, compile, ['-O -ddump-rules'])