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
-
67723c02
by Recursion Ninja at 2025-12-18T21:23:24-05:00
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:
| ... | ... | @@ -657,30 +657,30 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings |
| 657 | 657 | |
| 658 | 658 | mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn
|
| 659 | 659 | -- See Note [Cast worker/wrapper]
|
| 660 | -mkCastWrapperInlinePrag prag =
|
|
| 661 | - -- Consider each field of the 'InlinePragma' constructor
|
|
| 662 | - -- and deterimine what is the appropriate definition for the
|
|
| 663 | - -- corresponding value used within a worker/wrapper.
|
|
| 664 | - --
|
|
| 665 | - -- 1. 'inl_ext': Overwrite
|
|
| 666 | - setInlinePragmaArityAsNotExplicit prag
|
|
| 667 | - `setInlinePragmaSource` src_txt
|
|
| 668 | - --
|
|
| 669 | - -- 2. 'inl_inline': *Preserve*
|
|
| 670 | - -- See Note [Worker/wrapper for INLINABLE functions]
|
|
| 671 | - -- in GHC.Core.Opt.WorkWrap
|
|
| 672 | - -- <SKIP>
|
|
| 673 | - --
|
|
| 674 | - -- 3. 'inl_act': Conditionally Update
|
|
| 675 | - -- See Note [Wrapper activation]
|
|
| 676 | - -- in GHC.Core.Opt.WorkWrap
|
|
| 677 | - `setInlinePragmaActivation` wrap_act
|
|
| 678 | - --
|
|
| 679 | - -- 4. 'inl_rule': *Preserve*
|
|
| 680 | - -- RuleMatchInfo is (and must be) unaffected
|
|
| 681 | - -- <SKIP>
|
|
| 682 | - --
|
|
| 683 | - -- <DONE>
|
|
| 660 | +mkCastWrapperInlinePrag prag = prag
|
|
| 661 | + -- Consider each field of the 'InlinePragma' constructor
|
|
| 662 | + -- and deterimine what is the appropriate definition for the
|
|
| 663 | + -- corresponding value used within a worker/wrapper.
|
|
| 664 | + --
|
|
| 665 | + -- 1. 'inl_ext': Overwrite with defaults
|
|
| 666 | + -- > Changes <SOME>
|
|
| 667 | + `setInlinePragmaSource` src_txt
|
|
| 668 | + `setInlinePragmaArity` AnyArity
|
|
| 669 | + --
|
|
| 670 | + -- 2. 'inl_inline': *Preserve*
|
|
| 671 | + -- See Note [Worker/wrapper for INLINABLE functions]
|
|
| 672 | + -- in GHC.Core.Opt.WorkWrap
|
|
| 673 | + -- > Changes <NONE>
|
|
| 674 | + --
|
|
| 675 | + -- 3. 'inl_act': Conditionally Update
|
|
| 676 | + -- See Note [Wrapper activation]
|
|
| 677 | + -- in GHC.Core.Opt.WorkWrap
|
|
| 678 | + -- > Changes <SOME>
|
|
| 679 | + `setInlinePragmaActivation` wrap_act
|
|
| 680 | + --
|
|
| 681 | + -- 4. 'inl_rule': *Preserve*
|
|
| 682 | + -- RuleMatchInfo is (and must be) unaffected
|
|
| 683 | + -- > Changes <NONE>
|
|
| 684 | 684 | where
|
| 685 | 685 | -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
|
| 686 | 686 | -- But simpler, because we don't need to disable during InitialPhase
|
| ... | ... | @@ -834,7 +834,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div |
| 834 | 834 | _ -> inl_act wrap_prag
|
| 835 | 835 | |
| 836 | 836 | srcTxt = SourceText $ fsLit "{-# INLINE"
|
| 837 | - work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit
|
|
| 837 | + work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity
|
|
| 838 | 838 | , inl_inline = fn_inline_spec
|
| 839 | 839 | , inl_act = work_act
|
| 840 | 840 | , inl_rule = FunLike }
|
| ... | ... | @@ -901,7 +901,7 @@ mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma |
| 901 | 901 | mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
|
| 902 | 902 | , inl_act = fn_act
|
| 903 | 903 | , inl_rule = rule_info }) rules
|
| 904 | - = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit
|
|
| 904 | + = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity
|
|
| 905 | 905 | |
| 906 | 906 | , inl_inline = fn_inl
|
| 907 | 907 | -- See Note [Worker/wrapper for INLINABLE functions]
|
| ... | ... | @@ -456,7 +456,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs |
| 456 | 456 | inline_prag = idInlinePragma gbl_id
|
| 457 | 457 | inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs
|
| 458 | 458 | inline_pair
|
| 459 | - | ArityExplicitly arity <- inlinePragmaArity inline_prag
|
|
| 459 | + | AppliedToAtLeast arity <- inlinePragmaArity inline_prag
|
|
| 460 | 460 | -- Add an Unfolding for an INLINE (but not for NOINLINE)
|
| 461 | 461 | -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
|
| 462 | 462 | , let real_arity = dict_arity + fromEnum arity
|
| ... | ... | @@ -1103,7 +1103,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl) |
| 1103 | 1103 | TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v
|
| 1104 | 1104 | _ -> lookupSigOccRn ctxt sig v
|
| 1105 | 1105 | ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
|
| 1106 | - ; return (SpecSig noAnn new_v new_ty (setInlinePragmaArityAsNotExplicit inl), fvs) }
|
|
| 1106 | + ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` AnyArity), fvs) }
|
|
| 1107 | 1107 | where
|
| 1108 | 1108 | do_one (tys,fvs) ty
|
| 1109 | 1109 | = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty
|
| ... | ... | @@ -1114,11 +1114,11 @@ renameSig _ctxt (SpecSigE _ bndrs spec_e inl) |
| 1114 | 1114 | ; fn_name <- lookupOccRn WL_TermVariable fn_rdr -- Checks that the head isn't forall-bound
|
| 1115 | 1115 | ; bindRuleBndrs (SpecECtx fn_rdr) bndrs $ \_ bndrs' ->
|
| 1116 | 1116 | do { (spec_e', fvs) <- rnLExpr spec_e
|
| 1117 | - ; return (SpecSigE fn_name bndrs' spec_e' (setInlinePragmaArityAsNotExplicit inl), fvs) } }
|
|
| 1117 | + ; return (SpecSigE fn_name bndrs' spec_e' (inl `setInlinePragmaArity` AnyArity), fvs) } }
|
|
| 1118 | 1118 | |
| 1119 | 1119 | renameSig ctxt sig@(InlineSig _ v s)
|
| 1120 | 1120 | = do { new_v <- lookupSigOccRn ctxt sig v
|
| 1121 | - ; return (InlineSig noAnn new_v (setInlinePragmaArityAsNotExplicit s), emptyFVs) }
|
|
| 1121 | + ; return (InlineSig noAnn new_v (s `setInlinePragmaArity` AnyArity), emptyFVs) }
|
|
| 1122 | 1122 | |
| 1123 | 1123 | renameSig ctxt (FixSig _ fsig)
|
| 1124 | 1124 | = do { new_fsig <- rnSrcFixityDecl ctxt fsig
|
| ... | ... | @@ -604,7 +604,7 @@ addInlinePragArity _ sig = sig |
| 604 | 604 | add_inl_arity :: Arity -> InlinePragma GhcRn -> InlinePragma GhcRn
|
| 605 | 605 | add_inl_arity ar prag@(InlinePragma { inl_inline = inl_spec })
|
| 606 | 606 | | Inline {} <- inl_spec -- Add arity only for real INLINE pragmas, not INLINABLE
|
| 607 | - = prag `setInlinePragmaArityAsExplicitly` ar
|
|
| 607 | + = prag `setInlinePragmaArity` AppliedToAtLeast ar
|
|
| 608 | 608 | | otherwise
|
| 609 | 609 | = prag
|
| 610 | 610 |
| ... | ... | @@ -2265,7 +2265,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec |
| 2265 | 2265 | = do { logger <- getLogger
|
| 2266 | 2266 | ; dm_id <- tcLookupId dm_name
|
| 2267 | 2267 | ; let inline_prag :: InlinePragma GhcRn
|
| 2268 | - inline_prag = idInlinePragma dm_id
|
|
| 2268 | + inline_prag = idInlinePragma dm_id
|
|
| 2269 | 2269 | inline_prags | isAnyInlinePragma inline_prag
|
| 2270 | 2270 | = [noLocA (InlineSig noAnn fn inline_prag)]
|
| 2271 | 2271 | | otherwise
|
| ... | ... | @@ -41,21 +41,21 @@ type FullArgCount = Int |
| 41 | 41 | -- | The arity /at which to/ inline a function.
|
| 42 | 42 | -- This may differ from the function's syntactic arity.
|
| 43 | 43 | data InlineArity
|
| 44 | - = ArityExplicitly !Word
|
|
| 44 | + = AppliedToAtLeast !Arity
|
|
| 45 | 45 | -- ^ Inline only when applied to @n@ explicit
|
| 46 | 46 | -- (non-type, non-dictionary) arguments.
|
| 47 | - --
|
|
| 48 | - -- That is, 'ArityExplicitly' describes the number of
|
|
| 47 | + --
|
|
| 48 | + -- That is, 'AppliedToAtLeast' describes the number of
|
|
| 49 | 49 | -- *source-code* arguments the thing must be applied to.
|
| 50 | - | ArityNotExplicit
|
|
| 50 | + | AnyArity
|
|
| 51 | 51 | -- ^ There does not exist an explicit number of arguments
|
| 52 | 52 | -- that the inlining process should be applied to.
|
| 53 | 53 | deriving (Eq, Data)
|
| 54 | 54 | |
| 55 | 55 | instance NFData InlineArity where
|
| 56 | 56 | |
| 57 | - rnf (ArityExplicitly !w) = rnf w `seq` ()
|
|
| 58 | - rnf !ArityNotExplicit = ()
|
|
| 57 | + rnf (AppliedToAtLeast !w) = rnf w `seq` ()
|
|
| 58 | + rnf !AnyArity = ()
|
|
| 59 | 59 | |
| 60 | 60 | -- | Representation Arity
|
| 61 | 61 | --
|
| ... | ... | @@ -35,8 +35,7 @@ module GHC.Types.InlinePragma |
| 35 | 35 | , isOpaquePragma
|
| 36 | 36 | -- *** Mutators
|
| 37 | 37 | , setInlinePragmaSource
|
| 38 | - , setInlinePragmaArityAsExplicitly
|
|
| 39 | - , setInlinePragmaArityAsNotExplicit
|
|
| 38 | + , setInlinePragmaArity
|
|
| 40 | 39 | , setInlinePragmaActivation
|
| 41 | 40 | , setInlinePragmaSpec
|
| 42 | 41 | , setInlinePragmaRuleMatchInfo
|
| ... | ... | @@ -111,7 +110,7 @@ import Language.Haskell.Syntax.Extension |
| 111 | 110 | |
| 112 | 111 | -- infixl so you can say (prag `set` a `set` b)
|
| 113 | 112 | infixl 1 `setInlinePragmaActivation`,
|
| 114 | - `setInlinePragmaArityAsExplicitly`,
|
|
| 113 | + `setInlinePragmaArity`,
|
|
| 115 | 114 | `setInlinePragmaRuleMatchInfo`,
|
| 116 | 115 | `setInlinePragmaSource`,
|
| 117 | 116 | `setInlinePragmaSpec`
|
| ... | ... | @@ -149,8 +148,8 @@ defaultInlinePragma = |
| 149 | 148 | let srcTxt = SourceText $ fsLit "{-# INLINE"
|
| 150 | 149 | inlExt = case ghcPass @p of
|
| 151 | 150 | GhcPs -> srcTxt
|
| 152 | - GhcRn -> XInlinePragmaGhc srcTxt ArityNotExplicit
|
|
| 153 | - GhcTc -> XInlinePragmaGhc srcTxt ArityNotExplicit
|
|
| 151 | + GhcRn -> XInlinePragmaGhc srcTxt AnyArity
|
|
| 152 | + GhcTc -> XInlinePragmaGhc srcTxt AnyArity
|
|
| 154 | 153 | in InlinePragma
|
| 155 | 154 | { inl_ext = inlExt
|
| 156 | 155 | , inl_act = AlwaysActive
|
| ... | ... | @@ -185,16 +184,6 @@ setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInli |
| 185 | 184 | setInlinePragmaArity prag arity =
|
| 186 | 185 | prag { inl_ext = XInlinePragmaGhc (inlinePragmaSource prag) arity }
|
| 187 | 186 | |
| 188 | -setInlinePragmaArityAsExplicitly :: forall a p q. (Integral a, IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc)
|
|
| 189 | - => InlinePragma (GhcPass p) -> a -> InlinePragma (GhcPass q)
|
|
| 190 | -setInlinePragmaArityAsExplicitly prag intVal = prag `setInlinePragmaArity` arity
|
|
| 191 | - where
|
|
| 192 | - arity = ArityExplicitly . fromIntegral $ abs intVal
|
|
| 193 | - |
|
| 194 | -setInlinePragmaArityAsNotExplicit :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc)
|
|
| 195 | - => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q)
|
|
| 196 | -setInlinePragmaArityAsNotExplicit = flip setInlinePragmaArity ArityNotExplicit
|
|
| 197 | - |
|
| 198 | 187 | inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText
|
| 199 | 188 | inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt
|
| 200 | 189 | where
|
| ... | ... | @@ -2108,10 +2108,10 @@ instance Binary RuleMatchInfo where |
| 2108 | 2108 | else pure FunLike
|
| 2109 | 2109 | |
| 2110 | 2110 | instance Binary InlineArity where
|
| 2111 | - put_ bh ArityNotExplicit = putByte bh 0
|
|
| 2112 | - put_ bh (ArityExplicitly w) = putByte bh 1 *> put_ bh w
|
|
| 2111 | + put_ bh AnyArity = putByte bh 0
|
|
| 2112 | + put_ bh (AppliedToAtLeast w) = putByte bh 1 *> put_ bh w
|
|
| 2113 | 2113 | |
| 2114 | 2114 | get bh = do
|
| 2115 | 2115 | h <- getByte bh
|
| 2116 | - if h == 0 then pure ArityNotExplicit
|
|
| 2117 | - else ArityExplicitly <$> get bh |
|
| 2116 | + if h == 0 then pure AnyArity
|
|
| 2117 | + else AppliedToAtLeast <$> get bh |
| 1 | -Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056 |
|
| 1 | +Subproject commit b6c4290124eb1138358bf04ad9f33e67f6c5c1d8 |