[Git][ghc/ghc][wip/zliu41/spec/patch/925] Support turning off builtin rules
Ziyang Liu (@zliu41)
gitlab at gitlab.haskell.org
Mon Mar 20 03:18:57 UTC 2023
Ziyang Liu pushed to branch wip/zliu41/spec/patch/925 at Glasgow Haskell Compiler / GHC
Commits:
3cbf2dcd by Ziyang Liu at 2023-03-19T20:18:13-07:00
Support turning off builtin rules
- - - - -
8 changed files:
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
Changes:
=====================================
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:
=====================================
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
=====================================
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.
-}
-
=====================================
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
=====================================
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)
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -381,12 +381,13 @@ pprRuleBase rules = pprUFM rules $ \rss ->
-- successful.
lookupRule :: RuleOpts -> InScopeEnv
-> (Activation -> Bool) -- When rule is active
+ -> Bool -- Whether builtin rules are active
-> Id -> [CoreExpr]
-> [CoreRule] -> Maybe (CoreRule, CoreExpr)
-- See Note [Extra args in the target]
-- See comments on matchRule
-lookupRule opts rule_env@(in_scope,_) is_active fn args rules
+lookupRule opts rule_env@(in_scope,_) is_active builtin_is_active fn args rules
= -- pprTrace "matchRules" (ppr fn <+> ppr args $$ ppr rules ) $
case go [] rules of
[] -> Nothing
@@ -403,7 +404,7 @@ lookupRule opts rule_env@(in_scope,_) is_active fn args rules
go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]
go ms [] = ms
go ms (r:rs)
- | Just e <- matchRule opts rule_env is_active fn args' rough_args r
+ | Just e <- matchRule opts rule_env is_active builtin_is_active fn args' rough_args r
= go ((r,mkTicks ticks e):ms) rs
| otherwise
= -- pprTrace "match failed" (ppr r $$ ppr args $$
@@ -490,7 +491,7 @@ start, in general eta expansion wastes work. SLPJ July 99
-}
------------------------------------
-matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool)
+matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -> Bool
-> Id -> [CoreExpr] -> [Maybe Name]
-> CoreRule -> Maybe CoreExpr
@@ -516,14 +517,13 @@ matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool)
-- Any 'surplus' arguments in the input are simply put on the end
-- of the output.
-matchRule opts rule_env _is_active fn args _rough_args
+matchRule opts rule_env _is_active builtin_is_active fn args _rough_args
(BuiltinRule { ru_try = match_fn })
--- Built-in rules can't be switched off, it seems
- = case match_fn opts rule_env fn args of
- Nothing -> Nothing
- Just expr -> Just expr
+ = if builtin_is_active
+ then match_fn opts rule_env fn args
+ else Nothing
-matchRule _ rule_env is_active _ args rough_args
+matchRule _ rule_env is_active _ _ args rough_args
(Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops
, ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })
| not (is_active act) = Nothing
@@ -1560,7 +1560,7 @@ ruleAppCheck_help env fn args rules
rule_info opts rule
| Just _ <- matchRule opts (emptyInScopeSet, rc_id_unf env)
- noBlackList fn args rough_args rule
+ noBlackList True fn args rough_args rule
= text "matches (which is very peculiar!)"
rule_info _ (BuiltinRule {}) = text "does not match"
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -181,6 +181,7 @@ data GeneralFlag
| Opt_UnboxStrictFields
| Opt_UnboxSmallStrictFields
| Opt_DictsCheap
+ | Opt_EnableBuiltinRules
| Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_EnableThSpliceWarnings -- Enable warnings for TH splices
| Opt_RegsGraph -- do graph coloring register allocation
@@ -399,6 +400,7 @@ optimisationFlags = EnumSet.fromList
, Opt_UnboxStrictFields
, Opt_UnboxSmallStrictFields
, Opt_DictsCheap
+ , Opt_EnableBuiltinRules
, Opt_EnableRewriteRules
, Opt_RegsGraph
, Opt_RegsIterative
@@ -543,4 +545,3 @@ data Language = Haskell98 | Haskell2010 | GHC2021
instance Outputable Language where
ppr = text . show
-
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3330,6 +3330,7 @@ fFlagsDeps = [
flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion,
flagSpec "eager-blackholing" Opt_EagerBlackHoling,
flagSpec "embed-manifest" Opt_EmbedManifest,
+ flagSpec "enable-builtin-rules" Opt_EnableBuiltinRules,
flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules,
flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings,
flagSpec "error-spans" Opt_ErrorSpans,
@@ -3894,7 +3895,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
, ([1,2], Opt_CSE)
, ([1,2], Opt_StgCSE)
, ([2], Opt_StgLiftLams)
-
+ , ([0,1,2], Opt_EnableBuiltinRules)
, ([1,2], Opt_EnableRewriteRules)
-- Off for -O0. Otherwise we desugar list literals
-- to 'build' but don't run the simplifier passes that
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbf2dcdfa232c8d94303be2fc389081716393f9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbf2dcdfa232c8d94303be2fc389081716393f9
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230319/23ab4acb/attachment-0001.html>
More information about the ghc-commits
mailing list