diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-02-11 18:07:28 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-26 02:06:51 -0500 |
commit | 2be7446089de644048466ab8e9c71c596fa82d09 (patch) | |
tree | 97a0a67f8abc5f023aad79cb3addd5f18a8f2341 | |
parent | 61a203ba2e942b39c5f26a7ad01017841937fd0a (diff) | |
download | haskell-2be7446089de644048466ab8e9c71c596fa82d09.tar.gz |
Use a more up-to-date snapshot of the current rules in the simplifier
As the prescient (now deleted) note warns in simplifyPgmIO we have to be a bit careful
about when we gather rules from the EPS so that we get the rules for
imported bindings.
```
-- Get any new rules, and extend the rule base
-- See Note [Overall plumbing for rules] in GHC.Core.Rules
-- We need to do this regularly, because simplification can
-- poke on IdInfo thunks, which in turn brings in new rules
-- behind the scenes. Otherwise there's a danger we'll simply
-- miss the rules for Ids hidden inside imported inlinings
```
Given the previous commit, the loading of unfoldings is now even more
delayed so we need to be more careful to read the EPS rule base closer to the point
where we decide to try rules.
Without this fix GHC performance regressed by a noticeably amount
because the `zip` rule was not brought into scope eagerly enough which
led to a further series of unfortunate events in the simplifer which
tipped `substTyWithCoVars` over the edge of the size threshold, stopped
it being inlined and increased allocations by 10% in some cases.
Furthermore, this change is noticeably in the testsuite as it changes
T19790 so that the `length` rules from GHC.List fires earlier.
-------------------------
Metric Increase:
T9961
-------------------------
-rw-r--r-- | compiler/GHC/Core/Opt/Pipeline.hs | 21 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Monad.hs | 19 | ||||
-rw-r--r-- | compiler/GHC/Core/Rules.hs | 17 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T19790.stderr | 2 |
4 files changed, 37 insertions, 22 deletions
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs index 276bfee45d..a6170e185b 100644 --- a/compiler/GHC/Core/Opt/Pipeline.hs +++ b/compiler/GHC/Core/Opt/Pipeline.hs @@ -17,7 +17,7 @@ import GHC.Platform.Ways ( hasWay, Way(WayProf) ) import GHC.Core import GHC.Core.Opt.CSE ( cseProgram ) -import GHC.Core.Rules ( mkRuleBase, unionRuleBase, +import GHC.Core.Rules ( mkRuleBase, extendRuleBaseList, ruleCheckProgram, addRuleInfo, getRules, initRuleOpts ) import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) @@ -591,15 +591,14 @@ simplifyExpr :: HscEnv -- includes spec of what core-to-core passes to do simplifyExpr hsc_env expr = withTiming logger (text "Simplify [expr]") (const ()) $ do { eps <- hscEPS hsc_env ; - ; let rule_env = mkRuleEnv (eps_rule_base eps) [] - fi_env = ( eps_fam_inst_env eps + ; let fi_env = ( eps_fam_inst_env eps , extendFamInstEnvList emptyFamInstEnv $ snd $ ic_instances $ hsc_IC hsc_env ) simpl_env = simplEnvForGHCi logger dflags ; let sz = exprSize expr - ; (expr', counts) <- initSmpl logger dflags rule_env fi_env sz $ + ; (expr', counts) <- initSmpl logger dflags (eps_rule_base <$> hscEPS hsc_env) emptyRuleEnv fi_env sz $ simplExprGently simpl_env expr ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats @@ -726,21 +725,23 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) FormatCore (pprCoreBindings tagged_binds); - -- Get any new rules, and extend the rule base - -- See Note [Overall plumbing for rules] in GHC.Core.Rules - -- We need to do this regularly, because simplification can + -- read_eps_rules: + -- We need to read rules from the EPS regularly because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings + -- Hence just before attempting to match rules we read on the EPS + -- value and then combine it when the existing rule base. + -- See `GHC.Core.Opt.Simplify.Monad.getSimplRules`. eps <- hscEPS hsc_env ; - let { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps) - ; rule_base2 = extendRuleBaseList rule_base1 rules + let { read_eps_rules = eps_rule_base <$> hscEPS hsc_env + ; rule_base = extendRuleBaseList hpt_rule_base rules ; fam_envs = (eps_fam_inst_env eps, fam_inst_env) ; vis_orphs = this_mod : dep_orphs deps } ; -- Simplify the program ((binds1, rules1), counts1) <- - initSmpl logger dflags (mkRuleEnv rule_base2 vis_orphs) fam_envs sz $ + initSmpl logger dflags read_eps_rules (mkRuleEnv rule_base vis_orphs) fam_envs sz $ do { (floats, env1) <- {-# SCC "SimplTopBinds" #-} simplTopBinds simpl_env tagged_binds diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs index 83d27f4fe5..8ee49f4968 100644 --- a/compiler/GHC/Core/Opt/Simplify/Monad.hs +++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs @@ -28,7 +28,8 @@ import GHC.Types.Id ( Id, mkSysLocalOrCoVar ) import GHC.Types.Id.Info ( IdDetails(..), vanillaIdInfo, setArityInfo ) import GHC.Core.Type ( Type, Mult ) import GHC.Core.FamInstEnv ( FamInstEnv ) -import GHC.Core ( RuleEnv(..) ) +import GHC.Core ( RuleEnv(..), RuleBase) +import GHC.Core.Rules import GHC.Core.Utils ( mkLamTypes ) import GHC.Core.Coercion.Opt import GHC.Types.Unique.Supply @@ -79,20 +80,23 @@ data SimplTopEnv = STE { st_flags :: DynFlags , st_logger :: !Logger , st_max_ticks :: IntWithInf -- ^ Max #ticks in this simplifier run - , st_rules :: RuleEnv + , st_query_rulebase :: IO RuleBase + -- ^ The action to retrieve an up-to-date EPS RuleBase + -- See Note [Overall plumbing for rules] + , st_mod_rules :: RuleEnv , st_fams :: (FamInstEnv, FamInstEnv) , st_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } -initSmpl :: Logger -> DynFlags -> RuleEnv -> (FamInstEnv, FamInstEnv) +initSmpl :: Logger -> DynFlags -> IO RuleBase -> RuleEnv -> (FamInstEnv, FamInstEnv) -> Int -- Size of the bindings, used to limit -- the number of ticks we allow -> SimplM a -> IO (a, SimplCount) -initSmpl logger dflags rules fam_envs size m +initSmpl logger dflags qrb rules fam_envs size m = do -- No init count; set to 0 let simplCount = zeroSimplCount dflags (result, count) <- unSM m env simplCount @@ -100,7 +104,8 @@ initSmpl logger dflags rules fam_envs size m where env = STE { st_flags = dflags , st_logger = logger - , st_rules = rules + , st_query_rulebase = qrb + , st_mod_rules = rules , st_max_ticks = computeMaxTicks dflags size , st_fams = fam_envs , st_co_opt_opts = initOptCoercionOpts dflags @@ -203,7 +208,9 @@ instance MonadIO SimplM where return (x, sc) getSimplRules :: SimplM RuleEnv -getSimplRules = SM (\st_env sc -> return (st_rules st_env, sc)) +getSimplRules = SM (\st_env sc -> do + eps_rules <- st_query_rulebase st_env + return (extendRuleEnv (st_mod_rules st_env) eps_rules, sc)) getFamEnvs :: SimplM (FamInstEnv, FamInstEnv) getFamEnvs = SM (\st_env sc -> return (st_fams st_env, sc)) diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index a365b838c4..99cfea8af2 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -10,7 +10,7 @@ module GHC.Core.Rules ( -- ** Constructing emptyRuleBase, mkRuleBase, extendRuleBaseList, - unionRuleBase, pprRuleBase, + unionRuleBase, pprRuleBase, extendRuleEnv, -- ** Checking rule applications ruleCheckProgram, @@ -136,14 +136,18 @@ Note [Overall plumbing for rules] [NB: we are inconsistent here. We should do the same for external packages, but we don't. Same for type-class instances.] -* So in the outer simplifier loop, we combine (b-d) into a single +* So in the outer simplifier loop (simplifyPgmIO), we combine (b & c) into a single RuleBase, reading (b) from the ModGuts, (c) from the GHC.Core.Opt.Monad, and + just before doing rule matching we read (d) from its mutable variable - [Of course this means that we won't see new EPS rules that come in - during a single simplifier iteration, but that probably does not - matter.] + and combine it with the results from (b & c). + + In a single simplifier run new rules can be added into the EPS so it matters + to keep an up-to-date view of which rules have been loaded. For examples of + where this went wrong and caused cryptic performance regressions seee + see T19790 and !6735. ************************************************************************ @@ -368,6 +372,9 @@ extendRuleBase :: RuleBase -> CoreRule -> RuleBase extendRuleBase rule_base rule = extendNameEnv_Acc (:) Utils.singleton rule_base (ruleIdName rule) rule +extendRuleEnv :: RuleEnv -> RuleBase -> RuleEnv +extendRuleEnv (RuleEnv rules orphs) rb = (RuleEnv (rules `unionRuleBase` rb) orphs) + pprRuleBase :: RuleBase -> SDoc pprRuleBase rules = pprUFM rules $ \rss -> vcat [ pprRules (tidyRules emptyTidyEnv rs) diff --git a/testsuite/tests/simplCore/should_compile/T19790.stderr b/testsuite/tests/simplCore/should_compile/T19790.stderr index 71632231f7..2108b82afe 100644 --- a/testsuite/tests/simplCore/should_compile/T19790.stderr +++ b/testsuite/tests/simplCore/should_compile/T19790.stderr @@ -1,7 +1,7 @@ Rule fired: Class op + (BUILTIN) Rule fired: Class op length (BUILTIN) +Rule fired: length (GHC.List) Rule fired: map (GHC.Base) Rule fired: fold/build (GHC.Base) Rule fired: This rule should fire! (T19790) -Rule fired: length (GHC.List) Rule fired: lengthList (GHC.List) |