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.
simpl_gently = CoreDoSimplify max_iter
(base_mode { sm_phase = InitialPhase
, sm_names = ["Gentle"]
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.
, sm_inline = False
, sm_case_case = False })
-- Don't do case-of-case transformations.
But watch out: list fusion can prevent floating. So use phase control
to switch off those rules until after floating.
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.
-
%************************************************************************
%* *
%************************************************************************
%* *
; us <- mkSplitUniqSupply 's'
; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
; 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')
; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
(pprCoreExpr expr')
sm_eta_expand :: Bool -- Whether eta-expansion is enabled
\begin{code}
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
-- Do not do any inlining, in case we expose some unboxed
-- tuple stuff that confuses the bytecode interpreter
-- See Note [Simplifying inside InlineRules]
updModeForInlineRules inline_rule_act current_mode
= current_mode { sm_phase = phaseFromActivation inline_rule_act
-- See Note [Simplifying inside InlineRules]
updModeForInlineRules inline_rule_act current_mode
= current_mode { sm_phase = phaseFromActivation inline_rule_act
, sm_inline = True
, sm_eta_expand = False }
, 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
where
phaseFromActivation (ActiveAfter n) = Phase n
phaseFromActivation _ = InitialPhase
trace_dump dflags rule rule_rhs stuff
| not (dopt Opt_D_dump_rule_firings dflags)
, not (dopt Opt_D_dump_rule_rewrites dflags) = stuff
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
= pprTrace "Rule fired:" (ftext (ru_name rule)) stuff
| otherwise
= pprTrace "Rule fired"
(vcat [text "Rule:" <+> ftext (ru_name rule),
| otherwise
= pprTrace "Rule fired"
(vcat [text "Rule:" <+> ftext (ru_name rule),