diff options
Diffstat (limited to 'compiler/GHC/Core/Opt')
| -rw-r--r-- | compiler/GHC/Core/Opt/Monad.hs | 23 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Pipeline.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 10 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Specialise.hs | 2 |
5 files changed, 22 insertions, 18 deletions
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs index 70c40aab42..262b0d686e 100644 --- a/compiler/GHC/Core/Opt/Monad.hs +++ b/compiler/GHC/Core/Opt/Monad.hs @@ -165,17 +165,18 @@ pprPassDetails _ = Outputable.empty data SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad = SimplMode - { sm_names :: [String] -- ^ Name(s) of the phase - , sm_phase :: CompilerPhase - , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options - , sm_rules :: !Bool -- ^ Whether RULES are enabled - , sm_inline :: !Bool -- ^ Whether inlining is enabled - , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled - , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled - , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? - , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_logger :: !Logger - , sm_dflags :: DynFlags + { sm_names :: [String] -- ^ Name(s) of the phase + , sm_phase :: CompilerPhase + , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options + , sm_rules :: !Bool -- ^ Whether RULES are enabled + , sm_builtin_rules :: !Bool + , sm_inline :: !Bool -- ^ Whether inlining is enabled + , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled + , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled + , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? + , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled + , sm_logger :: !Logger + , sm_dflags :: DynFlags -- Just for convenient non-monadic access; we don't override these. -- -- Used for: diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs index 34f283f7ed..4f5ab970cc 100644 --- a/compiler/GHC/Core/Opt/Pipeline.hs +++ b/compiler/GHC/Core/Opt/Pipeline.hs @@ -148,6 +148,7 @@ getCoreToDo logger dflags late_dmd_anal = gopt Opt_LateDmdAnal dflags late_specialise = gopt Opt_LateSpecialise dflags static_args = gopt Opt_StaticArgumentTransformation dflags + builtin_rules_on = gopt Opt_EnableBuiltinRules dflags rules_on = gopt Opt_EnableRewriteRules dflags eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags pre_inline_on = gopt Opt_SimplPreInlining dflags @@ -168,6 +169,7 @@ getCoreToDo logger dflags , sm_logger = logger , sm_uf_opts = unfoldingOpts dflags , sm_rules = rules_on + , sm_builtin_rules = builtin_rules_on , sm_eta_expand = eta_expand_on , sm_cast_swizzle = True , sm_inline = True diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 7fe17442f7..6886d35c9a 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -2248,7 +2248,7 @@ tryRules env rules fn args call_cont -} | Just (rule, rule_rhs) <- lookupRule ropts (getUnfoldingInRuleMatch env) - (activeRule (getMode env)) fn + (activeRule (getMode env)) (sm_builtin_rules (getMode env)) fn (argInfoAppArgs args) rules -- Fire a rule for the function = do { checkedTick (RuleFired (ruleName rule)) @@ -4202,4 +4202,3 @@ for the RHS as well as the LHS, but that seems more conservative than necesary. Allowing some inlining might, for example, eliminate a binding. -} - diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index d607ecfaf2..6b1907724a 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -868,6 +868,7 @@ simplEnvForGHCi logger dflags , sm_dflags = dflags , sm_uf_opts = uf_opts , sm_rules = rules_on + , sm_builtin_rules = builtin_rules_on , sm_inline = False -- Do not do any inlining, in case we expose some -- unboxed tuple stuff that confuses the bytecode @@ -878,10 +879,11 @@ simplEnvForGHCi logger dflags , sm_pre_inline = pre_inline_on } where - rules_on = gopt Opt_EnableRewriteRules dflags - eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags - pre_inline_on = gopt Opt_SimplPreInlining dflags - uf_opts = unfoldingOpts dflags + builtin_rules_on = gopt Opt_EnableBuiltinRules dflags + rules_on = gopt Opt_EnableRewriteRules dflags + eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags + pre_inline_on = gopt Opt_SimplPreInlining dflags + uf_opts = unfoldingOpts dflags updModeForStableUnfoldings :: Activation -> SimplMode -> SimplMode updModeForStableUnfoldings unf_act current_mode diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index 47c72fabf1..af443ed9d0 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -1461,7 +1461,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs already_covered :: RuleOpts -> [CoreRule] -> [CoreExpr] -> Bool already_covered ropts new_rules args -- Note [Specialisations already covered] = isJust (lookupRule ropts (in_scope, realIdUnfolding) - (const True) fn args + (const True) True fn args (new_rules ++ existing_rules)) -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) |