recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: 7a5b0700 by Recursion Ninja at 2025-12-22T20:06:56-05:00 Removing TTG pass parameters in Core/Info/IFace code - - - - - 15 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/InlinePragma.hs - compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Extension.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -655,32 +655,19 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings , text "rhs:" <+> ppr rhs ]) ; return (mkFloatBind env (NonRec bndr rhs)) } -mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn +mkCastWrapperInlinePrag :: InlinePragma GhcTc -> InlinePragma GhcTc -- See Note [Cast worker/wrapper] mkCastWrapperInlinePrag prag = prag - -- Consider each field of the 'InlinePragma' constructor - -- and deterimine what is the appropriate definition for the - -- corresponding value used within a worker/wrapper. - -- - -- 1. 'inl_ext': Overwrite with defaults - -- > Changes <SOME> `setInlinePragmaSource` src_txt - `setInlinePragmaSaturation` AnySaturation - -- - -- 2. 'inl_inline': *Preserve* - -- See Note [Worker/wrapper for INLINABLE functions] + `setInlinePragmaSaturation` AnySaturation + `setInlinePragmaActivation` wrap_act + -- 1. 'Activation' is conditionally updated + -- See Note [Wrapper activation] -- in GHC.Core.Opt.WorkWrap - -- > Changes <NONE> - -- - -- 3. 'inl_act': Conditionally Update - -- See Note [Wrapper activation] + -- 2. 'InlineSpec' is also preserved + -- See Note [Worker/wrapper for INLINABLE functions] -- in GHC.Core.Opt.WorkWrap - -- > Changes <SOME> - `setInlinePragmaActivation` wrap_act - -- - -- 4. 'inl_rule': *Preserve* - -- RuleMatchInfo is (and must be) unaffected - -- > Changes <NONE> + -- 3. 'RuleMatchInfo' is (and must be) unaffected where -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap -- But simpler, because we don't need to disable during InitialPhase ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -44,7 +44,7 @@ import GHC.Data.Bag import GHC.Data.OrdList import GHC.Data.List.SetOps -import GHC.Hs.Extension ( GhcPass, GhcRn ) +import GHC.Hs.Extension ( GhcPass ) import GHC.Types.Basic import GHC.Types.Unique.Supply @@ -1641,7 +1641,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- Copy InlinePragma information from the parent Id. -- So if f has INLINE[1] so does spec_fn - spec_inl_prag :: InlinePragma GhcRn spec_inl_prag | not is_local -- See Note [Specialising imported functions] , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.SimpleOpt import GHC.Data.FastString -import GHC.Hs.Extension (GhcPass, GhcRn) +import GHC.Hs.Extension (GhcPass, GhcTc) import GHC.Types.Var import GHC.Types.Id @@ -897,7 +897,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div fn_unfolding = realUnfoldingInfo fn_info fn_rules = ruleInfoRules (ruleInfo fn_info) -mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma GhcRn +mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma GhcTc mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl , inl_act = fn_act , inl_rule = rule_info }) rules ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -67,7 +67,7 @@ import GHC.Core.Make ( mkCoreLams ) import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Core.Rules.Config (roBuiltinRules) -import GHC.Hs.Extension ( GhcPass, GhcRn ) +import GHC.Hs.Extension ( GhcPass, GhcTc ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -1930,7 +1930,7 @@ ruleCheckProgram ropts curr_phase rule_pat rules binds in ds `unionBags` go env' binds data RuleCheckEnv = RuleCheckEnv - { rc_is_active :: Activation GhcRn -> Bool + { rc_is_active :: Activation GhcTc -> Bool , rc_id_unf :: IdUnfoldingFun , rc_pattern :: String , rc_rules :: Id -> [CoreRule] ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -87,7 +87,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Hs.Extension (GhcRn) +import GHC.Hs.Extension ( GhcRn ) import Data.Maybe ( isNothing, catMaybes ) ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1020,7 +1020,7 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call fn_unf = realIdUnfolding poly_id spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf spec_info = vanillaIdInfo - `setInlinePragInfo` specFunInlinePrag poly_id id_inl (demoteInlinePragmaTc spec_inl) + `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl `setUnfoldingInfo` spec_unf spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info -- Specialised binding is toplevel, hence Many. @@ -1191,7 +1191,7 @@ getCastedVar (Var v) = Just (v, MRefl) getCastedVar (Cast (Var v) co) = Just (v, MCo co) getCastedVar _ = Nothing -specFunInlinePrag :: Id -> InlinePragma GhcRn -> InlinePragma GhcRn -> InlinePragma GhcRn +specFunInlinePrag :: Id -> InlinePragma GhcTc -> InlinePragma GhcTc -> InlinePragma GhcTc -- See Note [Activation pragmas for SPECIALISE] specFunInlinePrag poly_id id_inl spec_inl | not (isDefaultInlinePragma spec_inl) = spec_inl ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -84,7 +84,7 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.EnforceEpt.TagSig import GHC.Parser.Annotation (noLocA) -import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Extension ( GhcRn, GhcTc ) import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) @@ -460,7 +460,7 @@ data IfaceInfoItem = HsArity Arity | HsDmdSig DmdSig | HsCprSig CprSig - | HsInline (InlinePragma GhcRn) + | HsInline (InlinePragma GhcTc) | HsUnfold Bool -- True <=> isStrongLoopBreaker is true IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -620,11 +620,11 @@ addInlinePrags poly_id prags_for_me | inl@(L _ prag) : inls <- inl_prags = do { traceTc "addInlinePrag" (ppr poly_id $$ ppr prag) ; unless (null inls) (warn_multiple_inlines inl inls) - ; return (poly_id `setInlinePragma` demoteInlinePragmaTc prag) } + ; return (poly_id `setInlinePragma` prag) } | otherwise = return poly_id where - inl_prags = [L loc (promoteInlinePragmaRn prag) | L loc (InlineSig _ _ prag) <- prags_for_me] + inl_prags = [L loc (witnessInlinePragmaPass prag) | L loc (InlineSig _ _ prag) <- prags_for_me] warn_multiple_inlines _ [] = return () @@ -987,7 +987,7 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl) tc_one hs_ty = do { spec_ty <- tcHsSigType (FunSigCtxt name NoRRC) hs_ty ; wrap <- tcSpecWrapper (FunSigCtxt name (lhsSigTypeContextSpan hs_ty)) poly_ty spec_ty - ; return (SpecPrag poly_id wrap (promoteInlinePragmaRn inl)) } + ; return (SpecPrag poly_id wrap (witnessInlinePragmaPass inl)) } tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl) -- For running commentary, see Note [Handling new-form SPECIALISE pragmas] @@ -1050,7 +1050,7 @@ tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl) , spe_bndrs = qevs ++ rule_bndrs' -- Dependency order -- does not matter , spe_call = lhs_call - , spe_inl = promoteInlinePragmaRn inl }] } + , spe_inl = witnessInlinePragmaPass inl }] } tcSpecPrag _ prag = pprPanic "tcSpecPrag" (ppr prag) ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2264,7 +2264,7 @@ mkDefMethBind :: SrcSpan -> DFunId -> Class -> Id -> Name mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec = do { logger <- getLogger ; dm_id <- tcLookupId dm_name - ; let inline_prag = idInlinePragma dm_id + ; let inline_prag = witnessInlinePragmaPass $ idInlinePragma dm_id inline_prags | isAnyInlinePragma inline_prag = [noLocA (InlineSig noAnn fn inline_prag)] | otherwise ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -150,7 +150,7 @@ import GHC.Core.DataCon import GHC.Core.Class import GHC.Core.Multiplicity -import GHC.Hs.Extension (GhcRn) +import GHC.Hs.Extension (GhcTc) import GHC.Types.RepType import GHC.Types.Demand @@ -796,7 +796,7 @@ alwaysActiveUnfoldingFun id -- | Returns an unfolding only if -- (a) not a strong loop breaker and -- (b) active in according to is_active -whenActiveUnfoldingFun :: (Activation GhcRn -> Bool) -> IdUnfoldingFun +whenActiveUnfoldingFun :: (Activation GhcTc -> Bool) -> IdUnfoldingFun whenActiveUnfoldingFun is_active id | is_active (idInlineActivation id) = idUnfolding id | otherwise = NoUnfolding @@ -944,19 +944,19 @@ The inline pragma tells us to be very keen to inline this Id, but it's still OK not to if optimisation is switched off. -} -idInlinePragma :: Id -> InlinePragma GhcRn +idInlinePragma :: Id -> InlinePragma GhcTc idInlinePragma id = inlinePragInfo (idInfo id) -setInlinePragma :: Id -> InlinePragma GhcRn -> Id +setInlinePragma :: Id -> InlinePragma GhcTc -> Id setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id -modifyInlinePragma :: Id -> (InlinePragma GhcRn -> InlinePragma GhcRn) -> Id +modifyInlinePragma :: Id -> (InlinePragma GhcTc -> InlinePragma GhcTc) -> Id modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id -idInlineActivation :: Id -> Activation GhcRn +idInlineActivation :: Id -> Activation GhcTc idInlineActivation id = inlinePragmaActivation (idInlinePragma id) -setInlineActivation :: Id -> Activation GhcRn -> Id +setInlineActivation :: Id -> Activation GhcTc -> Id setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act) idRuleMatchInfo :: Id -> RuleMatchInfo ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -52,7 +52,7 @@ module GHC.Types.Id.Info ( realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding, -- ** The InlinePragInfo type - InlinePragInfo, + InlinePragmaInfo, inlinePragInfo, setInlinePragInfo, -- ** The OccInfo type @@ -100,7 +100,6 @@ import GHC.Core.TyCon import GHC.Core.Type (mkTyConApp) import GHC.Core.PatSyn import GHC.Core.ConLike -import GHC.Hs.Extension import GHC.Types.ForeignCall import GHC.Unit.Module import GHC.Types.Demand @@ -439,7 +438,7 @@ data IdInfo -- See Note [Specialisations and RULES in IdInfo] realUnfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding - inlinePragInfo :: InlinePragma GhcRn, + inlinePragInfo :: InlinePragmaInfo, -- ^ Any inline pragma attached to the 'Id' occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program @@ -553,7 +552,7 @@ tagSigInfo = tagSig setRuleInfo :: IdInfo -> RuleInfo -> IdInfo setRuleInfo info sp = sp `seq` info { ruleInfo = sp } -setInlinePragInfo :: IdInfo -> InlinePragma GhcRn -> IdInfo +setInlinePragInfo :: IdInfo -> InlinePragmaInfo -> IdInfo setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo :: IdInfo -> OccInfo -> IdInfo @@ -704,27 +703,6 @@ ppArityInfo :: Int -> SDoc ppArityInfo 0 = empty ppArityInfo n = hsep [text "Arity", int n] -{- -************************************************************************ -* * -\subsection{Inline-pragma information} -* * -************************************************************************ --} - --- | Inline Pragma Information --- --- Tells when the inlining is active. --- When it is active the thing may be inlined, depending on how --- big it is. --- --- If there was an @INLINE@ pragma, then as a separate matter, the --- RHS will have been made to look small with a Core inline 'Note' --- --- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves --- entirely as a way to inhibit inlining until we want it -type InlinePragInfo = InlinePragma - {- ************************************************************************ * * ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,8 +65,6 @@ import GHC.Core.TyCon import GHC.Core.Class import GHC.Core.DataCon -import GHC.Hs.Extension (GhcRn) - import GHC.Types.Literal import GHC.Types.RepType ( countFunRepArgs, typePrimRep ) import GHC.Types.Name.Set @@ -608,7 +606,7 @@ mkDataConWorkId wkr_name data_con -- See Note [Strict fields in Core] `setLFInfo` wkr_lf_info - wkr_inline_prag :: InlinePragma GhcRn + wkr_inline_prag :: InlinePragmaInfo wkr_inline_prag = alwaysInlineConLikePragma wkr_arity = dataConRepArity data_con @@ -989,7 +987,7 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (unbox_fn expr) } -dataConWrapperInlinePragma :: InlinePragma GhcRn +dataConWrapperInlinePragma :: InlinePragmaInfo -- See Note [DataCon wrappers are conlike] dataConWrapperInlinePragma = alwaysInlineConLikePragma ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -24,6 +24,7 @@ module GHC.Types.InlinePragma -- ** InlinePragma -- *** Data-type InlinePragma(..) + , InlinePragmaInfo -- *** Constants , defaultInlinePragma , alwaysInlinePragma @@ -51,8 +52,7 @@ module GHC.Types.InlinePragma , setInlinePragmaSpec , setInlinePragmaRuleMatchInfo -- *** GHC pass conversions - , demoteInlinePragmaTc - , promoteInlinePragmaRn + , witnessInlinePragmaPass -- *** Pretty-printing , pprInline , pprInlineDebug @@ -148,6 +148,28 @@ instance NFData InlineSaturation where rnf (AppliedToAtLeast !w) = rnf w `seq` () rnf !AnySaturation = () + +{- +************************************************************************ +* * +\subsection{Inline-pragma information} +* * +************************************************************************ +-} + +-- | Inline Pragma Information +-- +-- Tells when the inlining is active. +-- When it is active the thing may be inlined, depending on how +-- big it is. +-- +-- If there was an @INLINE@ pragma, then as a separate matter, the +-- RHS will have been made to look small with a Core inline 'Note' +-- +-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves +-- entirely as a way to inhibit inlining until we want it +type InlinePragmaInfo = InlinePragma GhcTc + data XInlinePragmaGhc = XInlinePragmaGhc { xinl_src :: SourceText -- ^ See Note [Pragma source text] @@ -181,6 +203,14 @@ type instance XInlinePragma GhcTc = XInlinePragmaGhc type instance XXInlinePragma (GhcPass _) = DataConCantHappen type instance XXActivation (GhcPass _) = XXActivationGhc +witnessInlinePragmaPass :: forall p q. + (XInlinePragma (GhcPass p) ~ XInlinePragmaGhc, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) + => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q) +witnessInlinePragmaPass prag@(InlinePragma { inl_ext = src }) = + prag { inl_ext = src + , inl_act = coerceActivation $ inl_act prag + } + -- | The default 'InlinePragma' definition for GHC. -- The type and value of 'inl_ext' provided will differ -- between the passes of GHC. Consequently, it may be @@ -235,18 +265,6 @@ inlinePragmaSaturation :: forall p. (XInlinePragma (GhcPass p) ~ XInlinePragmaGh => InlinePragma (GhcPass p) -> InlineSaturation inlinePragmaSaturation = xinl_sat . inl_ext -promoteInlinePragmaRn :: InlinePragma GhcRn -> InlinePragma GhcTc -promoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) = - prag { inl_ext = src - , inl_act = coerceActivation $ inl_act prag - } - -demoteInlinePragmaTc :: InlinePragma GhcTc -> InlinePragma GhcRn -demoteInlinePragmaTc prag@(InlinePragma { inl_ext = src }) = - prag { inl_ext = src - , inl_act = coerceActivation $ inl_act prag - } - inlinePragmaSpec :: InlinePragma p -> InlineSpec inlinePragmaSpec = inl_inline @@ -339,6 +357,26 @@ coerceActivation = \case AlwaysActive -> AlwaysActive NeverActive -> NeverActive +activeInPhase :: PhaseNum -> Activation (GhcPass p) -> Bool +activeInPhase _ AlwaysActive = True +activeInPhase _ NeverActive = False +activeInPhase _ ActiveFinal = False +activeInPhase p (ActiveAfter n) = p <= n +activeInPhase p (ActiveBefore n) = p > n + +activeInFinalPhase :: Activation (GhcPass p) -> Bool +activeInFinalPhase AlwaysActive = True +activeInFinalPhase ActiveFinal = True +activeInFinalPhase (ActiveAfter {}) = True +activeInFinalPhase _ = False + +isNeverActive, isAlwaysActive :: Activation p -> Bool +isNeverActive NeverActive = True +isNeverActive _ = False + +isAlwaysActive AlwaysActive = True +isAlwaysActive _ = False + activateAfterInitial :: Activation (GhcPass p) -- ^ Active in the first phase after the initial phase activateAfterInitial = activeAfter (nextPhase InitialPhase) ===================================== compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs ===================================== @@ -43,11 +43,6 @@ module Language.Haskell.Syntax.Binds.InlinePragma -- *** Data-type , Activation(..) , PhaseNum - -- *** Queries - , activeInPhase - , activeInFinalPhase - , isAlwaysActive - , isNeverActive ) where import Language.Haskell.Syntax.Extension @@ -310,23 +305,3 @@ instance NFData (XXActivation p) => NFData (Activation p) where ActiveBefore aa -> rnf aa ActiveAfter ab -> rnf ab XActivation x -> rnf x `seq` () - -activeInPhase :: PhaseNum -> Activation p -> Bool -activeInPhase _ AlwaysActive = True -activeInPhase _ NeverActive = False -activeInPhase _ (XActivation _) = False -activeInPhase p (ActiveAfter n) = p <= n -activeInPhase p (ActiveBefore n) = p > n - -activeInFinalPhase :: Activation p -> Bool -activeInFinalPhase AlwaysActive = True -activeInFinalPhase (XActivation {}) = True -activeInFinalPhase (ActiveAfter {}) = True -activeInFinalPhase _ = False - -isNeverActive, isAlwaysActive :: Activation p -> Bool -isNeverActive NeverActive = True -isNeverActive _ = False - -isAlwaysActive AlwaysActive = True -isAlwaysActive _ = False ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -241,8 +241,8 @@ type family XCompleteMatchSig x type family XXSig x -- Inline Pragma families -type family XInlinePragma x -type family XXInlinePragma x +type family XInlinePragma x +type family XXInlinePragma x -- Inline Activation family type family XXActivation x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a5b0700cebe06a8bd3c813409eb748c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a5b0700cebe06a8bd3c813409eb748c... You're receiving this email because of your account on gitlab.haskell.org.