[commit: ghc] master: Don't inline/apply other rules when simplifying a rule RHS. (dcc3428)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dcc342870b4d8a739ccbed3ae26e84dcc3579914/ghc

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

commit dcc342870b4d8a739ccbed3ae26e84dcc3579914
Author: Andrew Farmer <afarmer at ittc.ku.edu>
Date:   Mon Oct 12 21:27:41 2015 -0500

    Don't inline/apply other rules when simplifying a rule RHS.
    
    HERMIT users depend on RULES to specify equational properties. 7.10.2
    performed both inlining and simplification in both sides of the rules, meaning
    they can't really be used for this. This breaks most HERMIT use cases.  A
    separate commit already disabled this for the LHS of rules. This does so for
    the RHS.
    
    See Trac #10829 for nofib results.
    
    Reviewed By: austin, bgamari, simonpj
    
    Differential Revision: https://phabricator.haskell.org/D1246
    
    GHC Trac Issues: #10829


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

dcc342870b4d8a739ccbed3ae26e84dcc3579914
 compiler/simplCore/SimplUtils.hs                      | 19 ++++++++++---------
 compiler/simplCore/Simplify.hs                        | 12 +++++-------
 testsuite/tests/simplCore/should_compile/T7785.stderr |  2 --
 3 files changed, 15 insertions(+), 18 deletions(-)

diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 59d3a05..1577efd 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -14,7 +14,7 @@ module SimplUtils (
         preInlineUnconditionally, postInlineUnconditionally,
         activeUnfolding, activeRule,
         getUnfoldingInRuleMatch,
-        simplEnvForGHCi, updModeForStableUnfoldings, updModeForRuleLHS,
+        simplEnvForGHCi, updModeForStableUnfoldings, updModeForRules,
 
         -- The continuation type
         SimplCont(..), DupFlag(..),
@@ -701,24 +701,25 @@ updModeForStableUnfoldings inline_rule_act current_mode
     phaseFromActivation (ActiveAfter n) = Phase n
     phaseFromActivation _               = InitialPhase
 
-updModeForRuleLHS :: SimplifierMode -> SimplifierMode
--- See Note [Simplifying rule LHSs]
-updModeForRuleLHS current_mode
+updModeForRules :: SimplifierMode -> SimplifierMode
+-- See Note [Simplifying rules]
+updModeForRules current_mode
   = current_mode { sm_phase  = InitialPhase
                  , sm_inline = False
                  , sm_rules  = False
                  , sm_eta_expand = False }
 
-{- Note [Simplifying rule LHSs]
+{- Note [Simplifying rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When simplifying on the LHS of a rule, refrain from all inlining and
-all RULES.  Doing anything to the LHS is plain confusing, because it
-means that what the rule matches is not what the user wrote.
-c.f. Trac #10595, and #10528.
+When simplifying a rule, refrain from any inlining or applying of other RULES.
 
+Doing anything to the LHS is plain confusing, because it means that what the
+rule matches is not what the user wrote. c.f. Trac #10595, and #10528.
 Moreover, inlining (or applying rules) on rule LHSs risks introducing
 Ticks into the LHS, which makes matching trickier. Trac #10665, #10745.
 
+Doing this to either side confounds tools like HERMIT, which seek to reason
+about and apply the RULES as originally written. See Trac #10829.
 
 Note [Inlining in gentle mode]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 320ea9f..2c73f8e 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -2970,13 +2970,11 @@ simplRules env mb_new_nm rules
       = return rule
 
     simpl_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args
-                          , ru_fn = fn_name, ru_rhs = rhs
-                          , ru_act = act })
-      = do { (env, bndrs') <- simplBinders env bndrs
-           ; let lhs_env = updMode updModeForRuleLHS env
-                 rhs_env = updMode (updModeForStableUnfoldings act) env
-           ; args' <- mapM (simplExpr lhs_env) args
-           ; rhs'  <- simplExpr rhs_env rhs
+                          , ru_fn = fn_name, ru_rhs = rhs })
+      = do { (env', bndrs') <- simplBinders env bndrs
+           ; let rule_env = updMode updModeForRules env'
+           ; args' <- mapM (simplExpr rule_env) args
+           ; rhs'  <- simplExpr rule_env rhs
            ; return (rule { ru_bndrs = bndrs'
                           , ru_fn    = mb_new_nm `orElse` fn_name
                           , ru_args  = args'
diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr
index f0b9117..db80b99 100644
--- a/testsuite/tests/simplCore/should_compile/T7785.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7785.stderr
@@ -4,7 +4,5 @@
     forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int).
       shared @ [] $dMyFunctor irred
       = bar_$sshared
-"SPEC/Foo myfmap @ []" [ALWAYS]
-    forall (tpl :: MyFunctor []). myfmap @ [] tpl = $cmyfmap