summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-02-11 18:07:28 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-26 02:06:51 -0500
commit2be7446089de644048466ab8e9c71c596fa82d09 (patch)
tree97a0a67f8abc5f023aad79cb3addd5f18a8f2341
parent61a203ba2e942b39c5f26a7ad01017841937fd0a (diff)
downloadhaskell-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.hs21
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Monad.hs19
-rw-r--r--compiler/GHC/Core/Rules.hs17
-rw-r--r--testsuite/tests/simplCore/should_compile/T19790.stderr2
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)