Simon Peyton Jones pushed to branch wip/T26615 at Glasgow Haskell Compiler / GHC Commits: 0d62261b by Simon Peyton Jones at 2025-11-28T17:33:16+00:00 Comments and tracing only - - - - - 3 changed files: - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1781,7 +1781,8 @@ specRec :: ScEnv -- plus details of specialisations specRec env body_calls rhs_infos - = go 1 body_calls nullUsage (map initSpecInfo rhs_infos) [] + = -- pprTrace "specRec" (ppr (map ri_fn rhs_infos) $$ ppr body_calls) $ + go 1 body_calls nullUsage (map initSpecInfo rhs_infos) [] -- body_calls: see Note [Seeding recursive groups] -- NB: 'go' always calls 'specialise' once, which in turn unleashes -- si_mb_unspec if there are any boring calls in body_calls, @@ -1801,7 +1802,7 @@ specRec env body_calls rhs_infos go n_iter seed_calls usg_so_far spec_infos ws_so_far = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) -- , text "iteration" <+> int n_iter - -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) + -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) -- ]) $ do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -68,7 +68,6 @@ import GHC.Unit.Module.ModGuts import GHC.Core.Unfold import Data.List( partition ) --- import Data.List.NonEmpty ( NonEmpty (..) ) {- ************************************************************************ @@ -1617,11 +1616,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - inl_prag = idInlinePragma fn - inl_act = inlinePragmaActivation inl_prag + fn_prag = idInlinePragma fn + rule_act = inlinePragmaActivation fn_prag + -- rule_act: see Note [Auto-specialisation and RULES] is_active :: Activation -> Bool - is_active = isActive (SimplPhaseRange (beginPhase inl_act) (endPhase inl_act)) - -- is_active: inl_act is the activation we are going to put in the new + is_active = isActive (SimplPhaseRange (beginPhase rule_act) (endPhase rule_act)) + -- is_active: rule_act is the activation we are going to put in the new -- SPEC rule; so we want to see if it is covered by another rule with -- that same activation. is_local = isLocalId fn @@ -1643,7 +1643,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal = neverInlinePragma | otherwise - = inl_prag + = fn_prag not_in_scope :: InterestingVarFun not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope) @@ -1785,7 +1785,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs | otherwise = -- Specialising local fn text "SPEC" - spec_rule = mkSpecRule dflags this_mod True inl_act + spec_rule = mkSpecRule dflags this_mod True rule_act herald fn all_rule_bndrs rule_lhs_args (mkVarApps (Var spec_fn) rule_rhs_args1) @@ -1795,9 +1795,10 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , ppr spec_rule , text "acc" <+> ppr rules_acc , text "existing" <+> ppr existing_rules + , text "rule_act" <+> ppr rule_act ] - ; -- pprTrace "spec_call: rule" _rule_trace_doc + ; pprTrace "spec_call: rule" _rule_trace_doc return ( spec_rule : rules_acc , (spec_fn, spec_rhs1) : pairs_acc , rhs_uds2 `thenUDs` uds_acc @@ -2380,12 +2381,13 @@ Thus when adding also add RULE f g_spec = 0 -But that's a bit complicated. For now we ask the programmer's help, -by *copying the INLINE activation pragma* to the auto-specialised -rule. So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule -will also not be active until phase 2. And that's what programmers -should jolly well do anyway, even aside from specialisation, to ensure -that g doesn't inline too early. +But that's a bit complicated. For now we lean on the programmer: + * Set the activation of the RULE is the same as the activation of the Id, + i.e. (idInlineActivation g) + +So if `g` says {-# NOINLINE[2] g #-}, then the auto-spec rule will also not be +active until phase 2. And that's what programmers should jolly well do anyway, +even aside from specialisation, to ensure that `g` doesn't inline too early. This in turn means that the RULE would never fire for a NOINLINE thing so not much point in generating a specialisation at all. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -703,8 +703,14 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) = do { (joins, alts) <- go body -- Check for capture; but only if we could otherwise do a merge - ; let capture = outer_bndr `elem` bindersOf bind - || outer_bndr `elemVarSet` bindFreeVars bind + -- (i.e. the recursive `go` succeeds) + -- "Capture" means + -- (a) case x of r { DEFAULT -> join r = ... in ...r... } + -- (b) case x of r { DEFAULT -> join j = ...r.. in ... } + -- In both cases we can't float the join point out + -- because r changes its meaning + ; let capture = outer_bndr `elem` bindersOf bind -- (a) + || outer_bndr `elemVarSet` bindFreeVars bind -- (b) ; guard (not capture) ; return (bind:joins, alts ) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d62261b741db62442e75fc034a50072... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d62261b741db62442e75fc034a50072... You're receiving this email because of your account on gitlab.haskell.org.