Make -fno-enable-rewrite-rules work properly

I'd failed to propagate the Opt_EnableRewriteRules flag properly,
which meant that -fno-enable-rewrite-rules didn't disable all
rewrites.  This patch fixes it.

4 files changed, 17 insertions, 13 deletions

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index bb598c6f2a..c527d820c5 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -401,7 +401,7 @@ getCoreToDo dflags
     simpl_gently = CoreDoSimplify max_iter
                        (base_mode { sm_phase = InitialPhase
                                   , sm_names = ["Gentle"]
-                                  , sm_rules = True     -- Note [RULEs enabled in SimplGently]
+                                  , sm_rules = rules_on   -- Note [RULEs enabled in SimplGently]
                                   , sm_inline = False
                                   , sm_case_case = False })
                           -- Don't do case-of-case transformations.
@@ -568,9 +568,6 @@ RULES are enabled when doing "gentle" simplification.  Two reasons:
 But watch out: list fusion can prevent floating.  So use phase control
 to switch off those rules until after floating.
 
-Currently (Oct10) I think that sm_rules is always True, so we
-could remove it.
-
 
 %************************************************************************
 %*									*
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 1a634d5e0e..ea81317928 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -211,7 +211,7 @@ simplifyExpr dflags expr
 	; us <-  mkSplitUniqSupply 's'
 
 	; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
-				 simplExprGently simplEnvForGHCi expr
+				 simplExprGently (simplEnvForGHCi dflags) expr
 
 	; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
 			(pprCoreExpr expr')
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 99a63e4e92..7e9a010051 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -468,12 +468,17 @@ CoreMonad
         sm_eta_expand :: Bool     -- Whether eta-expansion is enabled
 
 \begin{code}
-simplEnvForGHCi :: SimplEnv
-simplEnvForGHCi = mkSimplEnv $
-                  SimplMode { sm_names = ["GHCi"]
-                            , sm_phase = InitialPhase
-                            , sm_rules = True, sm_inline = False
-                            , sm_eta_expand = False, sm_case_case = True }
+simplEnvForGHCi :: DynFlags -> SimplEnv
+simplEnvForGHCi dflags
+  = mkSimplEnv $ SimplMode { sm_names = ["GHCi"]
+                           , sm_phase = InitialPhase
+                           , sm_rules = rules_on
+                           , sm_inline = False
+                           , sm_eta_expand = eta_expand_on
+                           , sm_case_case = True }
+  where
+    rules_on      = dopt Opt_EnableRewriteRules   dflags
+    eta_expand_on = dopt Opt_DoLambdaEtaExpansion dflags
    -- Do not do any inlining, in case we expose some unboxed
    -- tuple stuff that confuses the bytecode interpreter
 
@@ -481,9 +486,10 @@ updModeForInlineRules :: Activation -> SimplifierMode -> SimplifierMode
 -- See Note [Simplifying inside InlineRules]
 updModeForInlineRules inline_rule_act current_mode
   = current_mode { sm_phase = phaseFromActivation inline_rule_act
-                 , sm_rules = True
                  , sm_inline = True
                  , sm_eta_expand = False }
+		 -- For sm_rules, just inherit; sm_rules might be "off"
+		 -- becuase of -fno-enable-rewrite-rules
   where
     phaseFromActivation (ActiveAfter n) = Phase n
     phaseFromActivation _               = InitialPhase
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index b82dd31691..8249c89425 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1391,9 +1391,10 @@ tryRules env rules fn args call_cont
     trace_dump dflags rule rule_rhs stuff
       | not (dopt Opt_D_dump_rule_firings dflags)
       , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff
-      | not (dopt Opt_D_dump_rule_rewrites dflags)
 
+      | not (dopt Opt_D_dump_rule_rewrites dflags)
       = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff
+
       | otherwise
       = pprTrace "Rule fired"
            (vcat [text "Rule:" <+> ftext (ru_name rule),