diff options
| author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-01-26 15:35:41 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-30 21:20:35 -0500 |
| commit | d0f34f25ceaae9ef0a21f15f811469d0bed9da69 (patch) | |
| tree | c42d57f585cef54e0a9e2a52956d45eadb949ade /compiler/GHC/Core/Rules.hs | |
| parent | 2f1450521b816a7d287b72deba14d59b6ccfbdbf (diff) | |
| download | haskell-d0f34f25ceaae9ef0a21f15f811469d0bed9da69.tar.gz | |
Take account of loop breakers in specLookupRule
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/Rules.hs')
| -rw-r--r-- | compiler/GHC/Core/Rules.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index d9bd0a912c..d635d6aebe 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -514,7 +514,7 @@ lookupRule :: RuleOpts -> InScopeEnv -- 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@(ISE in_scope _) is_active fn args rules = -- pprTrace "lookupRule" (ppr fn <+> ppr args $$ ppr rules $$ ppr in_scope) $ case go [] rules of [] -> Nothing @@ -574,11 +574,12 @@ isMoreSpecific _ (Rule {}) (BuiltinRule {}) = True isMoreSpecific in_scope (Rule { ru_bndrs = bndrs1, ru_args = args1 }) (Rule { ru_bndrs = bndrs2, ru_args = args2 , ru_name = rule_name2, ru_rhs = rhs2 }) - = isJust (matchN (full_in_scope, id_unfolding_fun) + = isJust (matchN in_scope_env rule_name2 bndrs2 args2 args1 rhs2) where - id_unfolding_fun _ = NoUnfolding -- Don't expand in templates full_in_scope = in_scope `extendInScopeSetList` bndrs1 + in_scope_env = ISE full_in_scope noUnfoldingFun + -- noUnfoldingFun: don't expand in templates noBlackList :: Activation -> Bool noBlackList _ = False -- Nothing is black listed @@ -687,7 +688,7 @@ matchN :: InScopeEnv -- trailing ones, returning the result of applying the rule to a prefix -- of the actual arguments. -matchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es rhs +matchN (ISE in_scope id_unf) rule_name tmpl_vars tmpl_es target_es rhs = do { rule_subst <- match_exprs init_menv emptyRuleSubst tmpl_es target_es ; let (_, matched_es) = mapAccumL (lookup_tmpl rule_subst) (mkEmptySubst in_scope) $ @@ -872,7 +873,7 @@ see `init_menv` in `matchN`. -} rvInScopeEnv :: RuleMatchEnv -> InScopeEnv -rvInScopeEnv renv = (rnInScopeSet (rv_lcl renv), rv_unf renv) +rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv) -- * The domain of the TvSubstEnv and IdSubstEnv are the template -- variables passed into the match. @@ -1686,7 +1687,7 @@ ruleAppCheck_help env fn args rules = text "Rule" <+> doubleQuotes (ftext name) rule_info opts rule - | Just _ <- matchRule opts (emptyInScopeSet, rc_id_unf env) + | Just _ <- matchRule opts (ISE emptyInScopeSet (rc_id_unf env)) noBlackList fn args rough_args rule = text "matches (which is very peculiar!)" |