Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 269c4087 by Simon Peyton Jones at 2026-02-01T19:38:10-05:00 Include current phase in the range for rule/unfoldings This MR fixes a bad loop in the compiler: #26826. The fix is to add (WAR2) to Note [What is active in the RHS of a RULE or unfolding?] in GHC.Core.Opt.Simplify.Utils - - - - - 7 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Types/InlinePragma.hs - + testsuite/tests/simplCore/should_compile/T26826.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1417,16 +1417,17 @@ then we *must* choose f to be a loop breaker. Example: see Note That is the whole reason for computing rule_fv_env in mkLoopBreakerNodes. Wrinkles: -* We only consider /active/ rules. See Note [Finding rule RHS free vars] +(RLB1) We only consider /active/ rules. + This is important: see Note [Finding rule RHS free vars] -* We need only consider free vars that are also binders in this Rec +(RLB2) We need only consider free vars that are also binders in this Rec group. See also Note [Finding rule RHS free vars] -* We only consider variables free in the *RHS* of the rule, in +(RLB3) We only consider variables free in the *RHS* of the rule, in contrast to the way we build the Rec group in the first place (Note [Rule dependency info]) -* Why "transitive sequence of rules"? Because active rules apply +(RLB4) Why "transitive sequence of rules"? Because active rules apply unconditionally, without checking loop-breaker-ness. See Note [Loop breaker dependencies]. @@ -1854,10 +1855,13 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) add_rule_uds (_, l, r) uds = l `andUDs` r `andUDs` uds -------- active_rule_fvs ------------ + -- See Note [Rules and loop breakers] active_rule_fvs = foldr add_active_rule imp_rule_fvs rules_w_uds add_active_rule (rule, _, rhs_uds) fvs - | is_active (ruleActivation rule) + | is_active (ruleActivation rule) -- See (RLB1) = udFreeVars bndr_set rhs_uds `unionVarSet` fvs + -- Only consider the `rhs_uss`, not the LHS ones; see (RLB3) + -- udFreeVars restricts to bndr_set; see (RLB2) | otherwise = fvs ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Core.Opt.Simplify.Env ( -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract - SimplPhase(..), isActive, + SimplPhase(..), isActive, simplStartPhase, simplEndPhase, seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, seOptCoercionOpts, sePhase, sePlatform, sePreInline, @@ -293,7 +293,9 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad -- | See Note [SimplPhase] data SimplPhase -- | A simplifier phase: InitialPhase, Phase 2, Phase 1, Phase 0, FinalPhase + -- NB: (SimplPhase p) is equivalent to (SimplPhaseRange p p) = SimplPhase CompilerPhase + -- | Simplifying the RHS of a rule or of a stable unfolding: the range of -- phases of the activation of the rule/stable unfolding. -- @@ -302,13 +304,18 @@ data SimplPhase -- -- See Note [What is active in the RHS of a RULE or unfolding?] -- in GHC.Core.Opt.Simplify.Utils. - | SimplPhaseRange - { simplStartPhase :: CompilerPhase - , simplEndPhase :: CompilerPhase - } + | SimplPhaseRange CompilerPhase CompilerPhase deriving Eq +simplStartPhase :: SimplPhase -> CompilerPhase +simplStartPhase (SimplPhase p) = p +simplStartPhase (SimplPhaseRange p _) = p + +simplEndPhase :: SimplPhase -> CompilerPhase +simplEndPhase (SimplPhase p) = p +simplEndPhase (SimplPhaseRange _ p) = p + instance Outputable SimplPhase where ppr (SimplPhase p) = ppr p ppr (SimplPhaseRange s e) = brackets $ ppr s <> ellipsis <> ppr e @@ -322,12 +329,13 @@ instance Outputable SimplPhase where -- -- See Note [SimplPhase]. isActive :: SimplPhase -> ActivationGhc -> Bool -isActive (SimplPhase p) act = isActiveInPhase p act -isActive (SimplPhaseRange start end) act = - -- To check whether the activation is active throughout the whole phase range, - -- it's sufficient to check the endpoints of the phase range, because an - -- activation can never have gaps (all activations are phase intervals). - isActiveInPhase start act && isActiveInPhase end act +isActive (SimplPhase p) act + = isActiveInPhase p act +isActive (SimplPhaseRange start end) act + = -- To check whether the activation is active throughout the whole phase range, + -- it's sufficient to check the endpoints of the phase range, because an + -- activation can never have gaps (all activations are phase intervals). + isActiveInPhase start act && isActiveInPhase end act {- Note [SimplPhase] ~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1099,7 +1099,7 @@ updModeForStableUnfoldings :: ActivationGhc -> SimplMode -> SimplMode -- See Note [Simplifying inside stable unfoldings] updModeForStableUnfoldings unf_act current_mode = current_mode - { sm_phase = phaseFromActivation (sm_phase current_mode) unf_act + { sm_phase = phaseForRuleOrUnf (sm_phase current_mode) unf_act -- See Note [What is active in the RHS of a RULE or unfolding?] , sm_eta_expand = False -- See Note [Eta expansion in stable unfoldings and rules] @@ -1123,27 +1123,32 @@ updModeForRuleRHS :: ActivationGhc -> SimplMode -> SimplMode updModeForRuleRHS rule_act current_mode = current_mode -- See Note [What is active in the RHS of a RULE or unfolding?] - { sm_phase = phaseFromActivation (sm_phase current_mode) rule_act + { sm_phase = phaseForRuleOrUnf (sm_phase current_mode) rule_act , sm_eta_expand = False -- See Note [Eta expansion in stable unfoldings and rules] } --- | Compute the phase range to set the 'SimplMode' to --- when simplifying the RHS of a rule or of a stable unfolding. +-- | `phaseForRuleOrUnf` computes the phase range to use when +-- simplifying the RHS of a rule or of a stable unfolding. -- +-- This subtle function implements the careful plan described in -- See Note [What is active in the RHS of a RULE or unfolding?] -phaseFromActivation - :: SimplPhase -- ^ the current simplifier phase +phaseForRuleOrUnf + :: SimplPhase -- ^ the current simplifier phase -> ActivationGhc -- ^ the activation of the RULE or stable unfolding -> SimplPhase -phaseFromActivation p act - | isNeverActive act - = p +phaseForRuleOrUnf current_phase act + | start == end + = SimplPhase start | otherwise - = SimplPhaseRange act_start act_end + = SimplPhaseRange start end where - act_start = beginPhase act - act_end = endPhase act + start, end :: CompilerPhase + start = beginPhase act `earliestPhase` simplStartPhase current_phase + end = endPhase act `latestPhase` simplEndPhase current_phase + -- The beginPhase/endPhase implements (WAR1) + -- The simplStartPhase/simplEndPhase implements (WAR2) + -- of Note [What is active in the RHS of a RULE or unfolding?] {- Note [Simplifying rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1275,26 +1280,47 @@ Our carefully crafted plan is as follows: ------------------------------------------------------------- When simplifying the RHS of a RULE R with activation range A, - fire only other rules R' that are active throughout all of A. + fire only other rules R' that are active + (WAR1) throughout all of A + (WAR2) in the current phase + See `phaseForRuleOrUnf`. ------------------------------------------------------------- -Reason: R might fire in any phase in A. Then R' can fire only if R' is active -in that phase. If not, it's not safe to unconditionally fire R' in the RHS of R. +Reasons for (WAR1): + * R might fire in any phase in A. Then R' can fire only if R' is active in that + phase. If not, it's not safe to unconditionally fire R' in the RHS of R. + +Reasons for (WAR2): + * If A is empty (e.g. a NOINLINE pragma, so the unfolding is never active) + we don't want to vacuously satisfy (WAR1) and thereby fire /all/ RULES in + the unfolding. Two RULES may be crafted so that they are never simultaneously + active, and will loop if they are. + + * Suppose we are in Phase 2, looking at a stable unfolding for INLINE [1]. + If we just do (WAR1) we will fire RULES active in phase 1; but the + occurrence analyser ignores any rules not active in the current phase. + So occ-anal may fail to detect a loop breaker; see #26826 for details. + See Note [Rules and loop breakers] in GHC.Core.Opt.OccurAnal. + + * Aesthetically, this means that when the simplifer is in phase N, it + won't switch to a phase-range that doesn't include N (e.g. might be later + than N). This is what caused #26826. + + * Also note that as the current phase advances, it'll eventually be inside + the range specified by (WAR1), and hence will not widen the range. + Unless the latter is empty, of course. This plan is implemented by: - 1. Setting the simplifier phase to the range of phases - corresponding to the start/end phases of the rule's activation. + 1. Setting the simplifier phase to the /range/ of phases + corresponding to the start/end phases of the rule's activation, implementing + (WAR1) and (WAR2). This happens in `phaseForRuleOrUnf`. + 2. When checking whether another rule is active, we use the function isActive :: SimplPhase -> Activation -> Bool from GHC.Core.Opt.Simplify.Env, which checks whether the other rule is active throughout the whole range of phases. -However, if the rule whose RHS we are simplifying is never active, instead of -setting the phase range to an empty interval, we keep the current simplifier -phase. This special case avoids firing ALL rules in the RHS of a never-active -rule. - You might wonder about a situation such as the following: module M1 where @@ -1307,6 +1333,7 @@ It looks tempting to use "r1" when simplifying the RHS of "r2", yet we **must not** do so: for any module M that imports M1, we are going to start simplification in M starting at InitialPhase, and we will see the fully simplified rules RHSs imported from M1. + Conclusion: stick to the plan. Note [Simplifying inside stable unfoldings] ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -914,9 +914,9 @@ mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl where srcTxt = SourceText $ fsLit "{-# INLINE" -- See Note [Wrapper activation] - wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_inline_phase rules - earliest_inline_phase = beginPhase fn_act `laterPhase` nextPhase InitialPhase - -- laterPhase (nextPhase InitialPhase) is a temporary hack + wrapper_phase = foldr (latestPhase . get_rule_phase) earliest_inline_phase rules + earliest_inline_phase = beginPhase fn_act `latestPhase` nextPhase InitialPhase + -- latestPhase (nextPhase InitialPhase) is a temporary hack -- to inline no earlier than phase 2. I got regressions in -- 'mate', due to changes in full laziness due to Note [Case -- MFEs], when I did earlier inlining. ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -104,9 +104,8 @@ module GHC.Types.InlinePragma , endPhase -- *** Queries , isActiveInPhase - , laterPhase - , laterThanPhase - , nextPhase + , latestPhase, earliestPhase + , laterThanPhase, nextPhase ) where import GHC.Prelude @@ -422,13 +421,21 @@ nextPhase (Phase 0) = FinalPhase nextPhase (Phase n) = Phase (n-1) nextPhase FinalPhase = FinalPhase -laterPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase --- ^ Returns the later of two phases -laterPhase (Phase n1) (Phase n2) = Phase (n1 `min` n2) -laterPhase InitialPhase p2 = p2 -laterPhase FinalPhase _ = FinalPhase -laterPhase p1 InitialPhase = p1 -laterPhase _ FinalPhase = FinalPhase +earliestPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase +-- ^ Returns the earliest of two phases +earliestPhase (Phase n1) (Phase n2) = Phase (n1 `max` n2) +earliestPhase InitialPhase _ = InitialPhase +earliestPhase FinalPhase p2 = p2 +earliestPhase _ InitialPhase = InitialPhase +earliestPhase p1 FinalPhase = p1 + +latestPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase +-- ^ Returns the latest of two phases +latestPhase (Phase n1) (Phase n2) = Phase (n1 `min` n2) +latestPhase InitialPhase p2 = p2 +latestPhase FinalPhase _ = FinalPhase +latestPhase p1 InitialPhase = p1 +latestPhase _ FinalPhase = FinalPhase -- | @p1 `laterThanOrEqualPhase` p2@ computes whether @p1@ happens (strictly) -- after @p2@. ===================================== testsuite/tests/simplCore/should_compile/T26826.hs ===================================== @@ -0,0 +1,86 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeAbstractions #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeData #-} + +module T26826 where + +import Data.Kind (Type) + +type data AstSpan = + FullSpan | PrimalStepSpan AstSpan | PlainSpan + +data SAstSpan (s :: AstSpan) where + SFullSpan :: SAstSpan FullSpan + SPrimalStepSpan :: SAstSpan s -> SAstSpan (PrimalStepSpan s) + SPlainSpan :: SAstSpan PlainSpan + +class KnownSpan (s :: AstSpan) where + knownSpan :: SAstSpan s + +instance KnownSpan FullSpan where + knownSpan = SFullSpan + +instance KnownSpan s => KnownSpan (PrimalStepSpan s) where + knownSpan = SPrimalStepSpan (knownSpan @s) + +instance KnownSpan PlainSpan where + knownSpan = SPlainSpan + +class ADReady target where + ttlet :: target a -> (target a -> target b) -> target b + ttletPrimal :: target a -> (target a -> target b) -> target b + ttletPlain :: target a -> (target a -> target b) -> target b + tplainPart :: target a -> target a + tfromPlain :: target a -> target a + tprimalPart :: target a -> target a + tfromPrimal :: target a -> target a + +type SpanTargetFam target (s :: AstSpan) (y :: Type) = target y + +type AstEnv target = () + +data AstTensor (s :: AstSpan) (y :: Type) where + AstLet + :: forall a b s1 s2. + KnownSpan s1 + => AstTensor s1 a + -> AstTensor s2 b + -> AstTensor s2 b + + AstPrimalPart :: KnownSpan s' => AstTensor s' a -> AstTensor (PrimalStepSpan s') a + AstFromPrimal :: AstTensor (PrimalStepSpan s') a -> AstTensor s' a + AstPlainPart :: KnownSpan s' => AstTensor s' a -> AstTensor PlainSpan a + AstFromPlain :: AstTensor PlainSpan a -> AstTensor s' a + +interpretAst + :: forall target s y. (ADReady target, KnownSpan s) + => AstEnv target -> AstTensor s y + -> SpanTargetFam target s y +{-# INLINE [1] interpretAst #-} +interpretAst !env + = \case + AstLet @_ @_ @s1 @s2 u v -> + case knownSpan @s1 of + SFullSpan -> + ttlet (interpretAst env u) + (\_w -> interpretAst env v) + SPrimalStepSpan _ -> + ttletPrimal (interpretAst env u) + (\_w -> interpretAst env v) + SPlainSpan -> + ttletPlain (interpretAst env u) + (\_w -> interpretAst env v) + AstPrimalPart a -> + tprimalPart (interpretAst env a) + AstFromPrimal a -> + tfromPrimal (interpretAst env a) + AstPlainPart a -> + tplainPart (interpretAst env a) + AstFromPlain a -> + tfromPlain (interpretAst env a) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -578,4 +578,6 @@ test('T26615', [grep_errmsg(r'fEqList')], multimod_compile, ['T26615', '-O -fsp # T26722: there should be no reboxing in $wg test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds']) + test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques']) +test('T26826', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/269c4087979ff9d675cd1a5907615721... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/269c4087979ff9d675cd1a5907615721... You're receiving this email because of your account on gitlab.haskell.org.