recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: 2d3d798a by Recursion Ninja at 2025-12-18T20:59:28-05:00 Cleaning up trailing whitespace - - - - - 67723c02 by Recursion Ninja at 2025-12-18T21:23:24-05:00 Improving code clarity with more decriptive 'InlineArity' constructor names and better comments throughout. - - - - - 10 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Utils/Binary.hs - libraries/exceptions Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -657,30 +657,30 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn -- See Note [Cast worker/wrapper] -mkCastWrapperInlinePrag 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 - setInlinePragmaArityAsNotExplicit prag - `setInlinePragmaSource` src_txt - -- - -- 2. 'inl_inline': *Preserve* - -- See Note [Worker/wrapper for INLINABLE functions] - -- in GHC.Core.Opt.WorkWrap - -- <SKIP> - -- - -- 3. 'inl_act': Conditionally Update - -- See Note [Wrapper activation] - -- in GHC.Core.Opt.WorkWrap - `setInlinePragmaActivation` wrap_act - -- - -- 4. 'inl_rule': *Preserve* - -- RuleMatchInfo is (and must be) unaffected - -- <SKIP> - -- - -- <DONE> +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 + `setInlinePragmaArity` AnyArity + -- + -- 2. 'inl_inline': *Preserve* + -- See Note [Worker/wrapper for INLINABLE functions] + -- in GHC.Core.Opt.WorkWrap + -- > Changes <NONE> + -- + -- 3. 'inl_act': Conditionally Update + -- See Note [Wrapper activation] + -- in GHC.Core.Opt.WorkWrap + -- > Changes <SOME> + `setInlinePragmaActivation` wrap_act + -- + -- 4. 'inl_rule': *Preserve* + -- RuleMatchInfo is (and must be) unaffected + -- > Changes <NONE> 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/WorkWrap.hs ===================================== @@ -834,7 +834,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div _ -> inl_act wrap_prag srcTxt = SourceText $ fsLit "{-# INLINE" - work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit + work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity , inl_inline = fn_inline_spec , inl_act = work_act , inl_rule = FunLike } @@ -901,7 +901,7 @@ mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl , inl_act = fn_act , inl_rule = rule_info }) rules - = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit + = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity , inl_inline = fn_inl -- See Note [Worker/wrapper for INLINABLE functions] ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -456,7 +456,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs inline_prag = idInlinePragma gbl_id inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs inline_pair - | ArityExplicitly arity <- inlinePragmaArity inline_prag + | AppliedToAtLeast arity <- inlinePragmaArity inline_prag -- Add an Unfolding for an INLINE (but not for NOINLINE) -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] , let real_arity = dict_arity + fromEnum arity ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -1103,7 +1103,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl) TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys - ; return (SpecSig noAnn new_v new_ty (setInlinePragmaArityAsNotExplicit inl), fvs) } + ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` AnyArity), fvs) } where do_one (tys,fvs) ty = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty @@ -1114,11 +1114,11 @@ renameSig _ctxt (SpecSigE _ bndrs spec_e inl) ; fn_name <- lookupOccRn WL_TermVariable fn_rdr -- Checks that the head isn't forall-bound ; bindRuleBndrs (SpecECtx fn_rdr) bndrs $ \_ bndrs' -> do { (spec_e', fvs) <- rnLExpr spec_e - ; return (SpecSigE fn_name bndrs' spec_e' (setInlinePragmaArityAsNotExplicit inl), fvs) } } + ; return (SpecSigE fn_name bndrs' spec_e' (inl `setInlinePragmaArity` AnyArity), fvs) } } renameSig ctxt sig@(InlineSig _ v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (InlineSig noAnn new_v (setInlinePragmaArityAsNotExplicit s), emptyFVs) } + ; return (InlineSig noAnn new_v (s `setInlinePragmaArity` AnyArity), emptyFVs) } renameSig ctxt (FixSig _ fsig) = do { new_fsig <- rnSrcFixityDecl ctxt fsig ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -604,7 +604,7 @@ addInlinePragArity _ sig = sig add_inl_arity :: Arity -> InlinePragma GhcRn -> InlinePragma GhcRn add_inl_arity ar prag@(InlinePragma { inl_inline = inl_spec }) | Inline {} <- inl_spec -- Add arity only for real INLINE pragmas, not INLINABLE - = prag `setInlinePragmaArityAsExplicitly` ar + = prag `setInlinePragmaArity` AppliedToAtLeast ar | otherwise = prag ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2265,7 +2265,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec = do { logger <- getLogger ; dm_id <- tcLookupId dm_name ; let inline_prag :: InlinePragma GhcRn - inline_prag = idInlinePragma dm_id + inline_prag = idInlinePragma dm_id inline_prags | isAnyInlinePragma inline_prag = [noLocA (InlineSig noAnn fn inline_prag)] | otherwise ===================================== compiler/GHC/Types/Arity.hs ===================================== @@ -41,21 +41,21 @@ type FullArgCount = Int -- | The arity /at which to/ inline a function. -- This may differ from the function's syntactic arity. data InlineArity - = ArityExplicitly !Word + = AppliedToAtLeast !Arity -- ^ Inline only when applied to @n@ explicit -- (non-type, non-dictionary) arguments. - -- - -- That is, 'ArityExplicitly' describes the number of + -- + -- That is, 'AppliedToAtLeast' describes the number of -- *source-code* arguments the thing must be applied to. - | ArityNotExplicit + | AnyArity -- ^ There does not exist an explicit number of arguments -- that the inlining process should be applied to. deriving (Eq, Data) instance NFData InlineArity where - rnf (ArityExplicitly !w) = rnf w `seq` () - rnf !ArityNotExplicit = () + rnf (AppliedToAtLeast !w) = rnf w `seq` () + rnf !AnyArity = () -- | Representation Arity -- ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -35,8 +35,7 @@ module GHC.Types.InlinePragma , isOpaquePragma -- *** Mutators , setInlinePragmaSource - , setInlinePragmaArityAsExplicitly - , setInlinePragmaArityAsNotExplicit + , setInlinePragmaArity , setInlinePragmaActivation , setInlinePragmaSpec , setInlinePragmaRuleMatchInfo @@ -111,7 +110,7 @@ import Language.Haskell.Syntax.Extension -- infixl so you can say (prag `set` a `set` b) infixl 1 `setInlinePragmaActivation`, - `setInlinePragmaArityAsExplicitly`, + `setInlinePragmaArity`, `setInlinePragmaRuleMatchInfo`, `setInlinePragmaSource`, `setInlinePragmaSpec` @@ -149,8 +148,8 @@ defaultInlinePragma = let srcTxt = SourceText $ fsLit "{-# INLINE" inlExt = case ghcPass @p of GhcPs -> srcTxt - GhcRn -> XInlinePragmaGhc srcTxt ArityNotExplicit - GhcTc -> XInlinePragmaGhc srcTxt ArityNotExplicit + GhcRn -> XInlinePragmaGhc srcTxt AnyArity + GhcTc -> XInlinePragmaGhc srcTxt AnyArity in InlinePragma { inl_ext = inlExt , inl_act = AlwaysActive @@ -185,16 +184,6 @@ setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInli setInlinePragmaArity prag arity = prag { inl_ext = XInlinePragmaGhc (inlinePragmaSource prag) arity } -setInlinePragmaArityAsExplicitly :: forall a p q. (Integral a, IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) - => InlinePragma (GhcPass p) -> a -> InlinePragma (GhcPass q) -setInlinePragmaArityAsExplicitly prag intVal = prag `setInlinePragmaArity` arity - where - arity = ArityExplicitly . fromIntegral $ abs intVal - -setInlinePragmaArityAsNotExplicit :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) - => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q) -setInlinePragmaArityAsNotExplicit = flip setInlinePragmaArity ArityNotExplicit - inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt where ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -2108,10 +2108,10 @@ instance Binary RuleMatchInfo where else pure FunLike instance Binary InlineArity where - put_ bh ArityNotExplicit = putByte bh 0 - put_ bh (ArityExplicitly w) = putByte bh 1 *> put_ bh w + put_ bh AnyArity = putByte bh 0 + put_ bh (AppliedToAtLeast w) = putByte bh 1 *> put_ bh w get bh = do h <- getByte bh - if h == 0 then pure ArityNotExplicit - else ArityExplicitly <$> get bh + if h == 0 then pure AnyArity + else AppliedToAtLeast <$> get bh ===================================== libraries/exceptions ===================================== @@ -1 +1 @@ -Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056 +Subproject commit b6c4290124eb1138358bf04ad9f33e67f6c5c1d8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7d47d203034f014791a2aa2cfb8fd2... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7d47d203034f014791a2aa2cfb8fd2... You're receiving this email because of your account on gitlab.haskell.org.