diff options
| author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-01-26 15:35:41 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-01-27 13:09:47 +0000 |
| commit | 7e423687ed75e32cca797af1b63bbbd400a6ed44 (patch) | |
| tree | 3371e08c274dcf7e4b9926c88a383441d6d826b0 /compiler/GHC/Core/Opt/Specialise.hs | |
| parent | 2648c09cd3caefbcb5febd41867347b81cd94e47 (diff) | |
| download | haskell-wip/T22802.tar.gz | |
Take account of loop breakers in specLookupRulewip/T22802
The key change is that in GHC.Core.Opt.Specialise.specLookupRule
we were using realIdUnfolding, which ignores the loop-breaker
flag. When given a loop breaker, rule matching therefore
looped infinitely -- #22802.
In fixing this I refactored a bit.
* Define GHC.Core.InScopeEnv as a data type, and use it.
(Previously it was a pair: hard to grep for.)
* Put several functions returning an IdUnfoldingFun into
GHC.Types.Id, namely
idUnfolding
alwaysActiveUnfoldingFun,
whenActiveUnfoldingFun,
noUnfoldingFun
and use them. (The are all loop-breaker aware.)
Diffstat (limited to 'compiler/GHC/Core/Opt/Specialise.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/Specialise.hs | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index fa9323ab3b..13bff9f170 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -1626,11 +1626,11 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- See Note [Inline specialisations] for why we do not -- switch off specialisation for inline functions - = do { -- debugTraceMsg (text "specCalls: some" <+> vcat - -- [ text "function" <+> ppr fn - -- , text "calls:" <+> ppr calls_for_me - -- , text "subst" <+> ppr (se_subst env) ]) - ; foldlM spec_call ([], [], emptyUDs) calls_for_me } + = -- pprTrace "specCalls: some" (vcat + -- [ text "function" <+> ppr fn + -- , text "calls:" <+> ppr calls_for_me + -- , text "subst" <+> ppr (se_subst env) ]) $ + foldlM spec_call ([], [], emptyUDs) calls_for_me | otherwise -- No calls or RHS doesn't fit our preconceptions = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me && not (isClassOpId fn)) @@ -1685,7 +1685,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , rule_bndrs, rule_lhs_args , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args --- ; debugTraceMsg (text "spec_call" <+> vcat +-- ; pprTrace "spec_call" (vcat -- [ text "fun: " <+> ppr fn -- , text "call info: " <+> ppr _ci -- , text "useful: " <+> ppr useful @@ -1698,7 +1698,8 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- , text "rhs_bndrs" <+> ppr rhs_bndrs -- , text "rhs_body" <+> ppr rhs_body -- , text "rhs_env2: " <+> ppr (se_subst rhs_env2) --- , ppr dx_binds ] +-- , ppr dx_binds ]) $ +-- return () ; if not useful -- No useful specialisation || already_covered rhs_env2 rules_acc rule_lhs_args @@ -1795,12 +1796,13 @@ specLookupRule :: SpecEnv -> Id -> [CoreExpr] -> CompilerPhase -- Look up rules as if we were in this phase -> [CoreRule] -> Maybe (CoreRule, CoreExpr) specLookupRule env fn args phase rules - = lookupRule ropts (in_scope, realIdUnfolding) is_active fn args rules + = lookupRule ropts in_scope_env is_active fn args rules where - dflags = se_dflags env - in_scope = getSubstInScope (se_subst env) - ropts = initRuleOpts dflags - is_active = isActive phase + dflags = se_dflags env + in_scope = getSubstInScope (se_subst env) + in_scope_env = ISE in_scope (whenActiveUnfoldingFun is_active) + ropts = initRuleOpts dflags + is_active = isActive phase {- Note [Specialising DFuns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |