[commit: ghc] ghc-7.10: Do not optimise RULE lhs in substRule (3794b59)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/3794b597896e1138e23043de5646e60e3d011b27/ghc

>---------------------------------------------------------------

commit 3794b597896e1138e23043de5646e60e3d011b27
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Jul 13 10:29:18 2015 +0100

    Do not optimise RULE lhs in substRule
    
    This was causing Trac #10627.
    See Note [Substitute lazily] in CoreSubst.
    
    The bug was introduced by
       commit 30c17e7096919c55218083c8fcb98e6287552058
        Author: simonpj at microsoft.com <unknown>
        Date:   Thu Nov 25 17:23:56 2010 +0000
        Substitution should just substitute, not optimise
    
    The fix is not to optimise the RHS as well as not-optimising the LHS!
    The simplifier does the right thing in Simplify.simplRule


>---------------------------------------------------------------

3794b597896e1138e23043de5646e60e3d011b27
 compiler/coreSyn/CoreSubst.hs                      | 31 ++++++++++++++++------
 testsuite/tests/simplCore/should_compile/T10627.hs | 17 ++++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  1 +
 3 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs
index 26732a2..fa83f41 100644
--- a/compiler/coreSyn/CoreSubst.hs
+++ b/compiler/coreSyn/CoreSubst.hs
@@ -780,15 +780,16 @@ substRule _ _ rule@(BuiltinRule {}) = rule
 substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
                                        , ru_fn = fn_name, ru_rhs = rhs
                                        , ru_local = is_local })
-  = rule { ru_bndrs = bndrs',
-           ru_fn    = if is_local
+  = rule { ru_bndrs = bndrs'
+         , ru_fn    = if is_local
                         then subst_ru_fn fn_name
-                        else fn_name,
-           ru_args  = map (substExpr (text "subst-rule" <+> ppr fn_name) subst') args,
-           ru_rhs   = simpleOptExprWith subst' rhs }
-           -- Do simple optimisation on RHS, in case substitution lets
-           -- you improve it.  The real simplifier never gets to look at it.
+                        else fn_name
+         , ru_args  = map (substExpr doc subst') args
+         , ru_rhs   = substExpr (text "foo") subst' rhs }
+           -- Do NOT optimise the RHS (previously we did simplOptExpr here)
+           -- See Note [Substitute lazily]
   where
+    doc = ptext (sLit "subst-rule") <+> ppr fn_name
     (subst', bndrs') = substBndrs subst bndrs
 
 ------------------
@@ -818,8 +819,22 @@ substTickish subst (Breakpoint n ids) = Breakpoint n (map do_one ids)
  where do_one = getIdFromTrivialExpr . lookupIdSubst (text "subst_tickish") subst
 substTickish _subst other = other
 
-{- Note [substTickish]
+{- Note [Substitute lazily]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The functions that substitute over IdInfo must be pretty lazy, becuause
+they are knot-tied by substRecBndrs.
 
+One case in point was Trac #10627 in which a rule for a function 'f'
+referred to 'f' (at a differnet type) on the RHS.  But instead of just
+substituting in the rhs of the rule, we were calling simpleOptExpr, which
+looked at the idInfo for 'f'; result <<loop>>.
+
+In any case we don't need to optimise the RHS of rules, or unfoldings,
+because the simplifier will do that.
+
+
+Note [substTickish]
+~~~~~~~~~~~~~~~~~~~~~~
 A Breakpoint contains a list of Ids.  What happens if we ever want to
 substitute an expression for one of these Ids?
 
diff --git a/testsuite/tests/simplCore/should_compile/T10627.hs b/testsuite/tests/simplCore/should_compile/T10627.hs
new file mode 100644
index 0000000..6b4d73a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T10627.hs
@@ -0,0 +1,17 @@
+-- Made GHC 6.10.2 go into a loop in substRecBndrs
+{-# OPTIONS_GHC -w #-}
+
+module T10627 where
+
+import Data.Word
+
+class C a where
+    splitFraction    :: a -> (b,a)
+
+roundSimple :: (C a) => a -> b
+roundSimple x = error "rik"
+
+{-# RULES
+     "rs"  roundSimple = (fromIntegral :: Int -> Word) . roundSimple;
+  #-}
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 84e9c6d..6a211fb 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -211,3 +211,4 @@ test('T9583', only_ways(['optasm']), compile, [''])
 test('T9565', only_ways(['optasm']), compile, [''])
 test('T10176', only_ways(['optasm']), compile, [''])
 test('T10602', only_ways(['optasm']), compile, ['-O2'])
+test('T10627', only_ways(['optasm']), compile, [''])