[Git][ghc/ghc][wip/ttg/types/basic] 2 commits: Removed matches on XCInlinePragma since ghc understands those are impossible
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Mon Oct 28 18:56:34 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg/types/basic at Glasgow Haskell Compiler / GHC
Commits:
0b50be42 by Hassan Al-Awwadi at 2024-10-28T19:55:31+01:00
Removed matches on XCInlinePragma since ghc understands those are impossible
- - - - -
b8c8b323 by Hassan Al-Awwadi at 2024-10-28T19:56:12+01:00
whitespace
- - - - -
16 changed files:
- compiler/GHC/Core/Opt/CSE.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/InlinePragma.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
Changes:
=====================================
compiler/GHC/Core/Opt/CSE.hs
=====================================
@@ -513,7 +513,7 @@ noCSE id
where
unf = idUnfolding id
user_activation_control = not (isAlwaysActive (idInlineActivation id))
- && not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))
+ && not (noUserInlineSpec (inl_inline (idInlinePragma id)))
yes_cse = False
no_cse = True
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -70,8 +70,6 @@ import GHC.Utils.Monad ( mapAccumLM, liftIO )
import GHC.Utils.Logger
import GHC.Utils.Misc
-import Language.Haskell.Syntax.Extension (dataConCantHappen)
-
import Control.Monad
{-
@@ -657,7 +655,6 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings
; return (mkFloatBind env (NonRec bndr rhs)) }
mkCastWrapperInlinePrag :: InlinePragma (GhcPass p) -> InlinePragma (GhcPass p)
-mkCastWrapperInlinePrag (XCInlinePragma impossible) = dataConCantHappen impossible
-- See Note [Cast worker/wrapper]
mkCastWrapperInlinePrag (InlinePragma { inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info })
= InlinePragma { inl_ext = InlExt (SourceText $ fsLit "{-# INLINE") Nothing
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1490,7 +1490,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
one_occ _ = False
pre_inline_unconditionally = sePreInline env
- active = isActive (sePhase env) (inlinePragmaActivation inline_prag)
+ active = isActive (sePhase env) (inl_act inline_prag)
-- See Note [pre/postInlineUnconditionally in gentle mode]
inline_prag = idInlinePragma bndr
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1668,7 +1668,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
fn_arity = idArity fn
fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here
inl_prag = idInlinePragma fn
- inl_act = inlinePragmaActivation inl_prag
+ activat = inl_act inl_prag
is_local = isLocalId fn
is_dfun = isDFunId fn
dflags = se_dflags env
@@ -1681,7 +1681,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
already_covered :: SpecEnv -> [CoreRule] -> [CoreExpr] -> Bool
already_covered env new_rules args -- Note [Specialisations already covered]
- = isJust (specLookupRule env fn args (beginPhase inl_act)
+ = isJust (specLookupRule env fn args (beginPhase activat)
(new_rules ++ existing_rules))
-- Rules: we look both in the new_rules (generated by this invocation
-- of specCalls), and in existing_rules (passed in to specCalls)
@@ -1799,7 +1799,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 activat
herald fn rule_bndrs rule_lhs_args
(mkVarApps (Var spec_fn) spec_bndrs)
=====================================
compiler/GHC/Core/Opt/WorkWrap.hs
=====================================
@@ -40,7 +40,6 @@ import GHC.Utils.Panic
import GHC.Utils.Monad
import GHC.Core.DataCon
import GHC.Hs.Extension (GhcTc)
-import Language.Haskell.Syntax.Extension (dataConCantHappen)
{-
We take Core bindings whose binders have:
@@ -831,8 +830,8 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
work_rhs = work_fn (mkLams fn_args fn_body)
work_act = case fn_inline_spec of -- See Note [Worker activation]
- NoInline _ -> inl_act' fn_inl_prag
- _ -> inl_act' wrap_prag
+ NoInline _ -> inl_act fn_inl_prag
+ _ -> inl_act wrap_prag
work_prag = InlinePragma { inl_ext = InlExt (SourceText $ fsLit "{-# INLINE") Nothing
, inl_inline = fn_inline_spec
@@ -893,19 +892,11 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
-- about a loop breaker with an INLINE rule
fn_inl_prag = inlinePragInfo fn_info
- fn_inline_spec = inl_inline' fn_inl_prag
+ fn_inline_spec = inl_inline fn_inl_prag
fn_unfolding = realUnfoldingInfo fn_info
fn_rules = ruleInfoRules (ruleInfo fn_info)
- inl_inline' (XCInlinePragma imp) = dataConCantHappen imp
- inl_inline' (InlinePragma{ inl_inline = inline }) = inline
-
- inl_act' (XCInlinePragma imp) = dataConCantHappen imp
- inl_act' (InlinePragma{ inl_act = act }) = act
-
-
mkStrWrapperInlinePrag :: InlinePragma GhcTc -> [CoreRule] -> InlinePragma GhcTc
-mkStrWrapperInlinePrag (XCInlinePragma impossible) _ = dataConCantHappen impossible
mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
, inl_act = fn_act
, inl_rule = rule_info }) rules
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -685,7 +685,6 @@ toIfaceVar v
toIfaceInlinePragma :: InlinePragma (GhcPass p) -> IfaceInlinePragma
toIfaceInlinePragma (InlinePragma s a b c)
= IfInlinePragma (inl_txt s) (toIfaceInlineSpec a) (inl_arr s) (toIfaceActivation b) c
-toIfaceInlinePragma (XCInlinePragma impossible) = dataConCantHappen impossible
toIfaceInlineSpec :: InlineSpec (GhcPass p) -> IfaceInlineSpec
toIfaceInlineSpec (Inline src) = IfInline src
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -866,7 +866,6 @@ ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))
pragmaSrc = case spec of
NoUserInlinePrag _ -> "{-# " ++ extractSpecPragName (inl_src inl)
_ -> "{-# " ++ extractSpecPragName (inl_src inl) ++ "_INLINE"
-ppr_sig (InlineSig _ _ (XCInlinePragma imp)) = dataConCantHappen imp
ppr_sig (InlineSig _ var inl@(InlinePragma{}))
= ppr_pfx <+> pprInline inl <+> pprPrefixOcc (unLoc var) <+> text "#-}"
where
@@ -899,7 +898,6 @@ ppr_sig (CompleteMatchSig (_, src) cs mty)
ppr_sig (XSig x) = case ghcPass @p of
GhcRn | IdSig id <- x -> pprVarSig [id] (ppr (varType id))
GhcTc | IdSig id <- x -> pprVarSig [id] (ppr (varType id))
-ppr_sig (SpecSig _ _ _ (XCInlinePragma impossible)) = dataConCantHappen impossible
hsSigDoc :: forall p. IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc (TypeSig {}) = text "type signature"
@@ -908,9 +906,7 @@ hsSigDoc (ClassOpSig _ is_deflt _ _)
| is_deflt = text "default type signature"
| otherwise = text "class method signature"
hsSigDoc (SpecSig _ _ _ (InlinePragma{inl_inline = spec})) = inlinePragmaName spec <+> text "pragma"
-hsSigDoc (SpecSig _ _ _ (XCInlinePragma imp)) = dataConCantHappen imp
hsSigDoc (InlineSig _ _ (InlinePragma{inl_inline = spec})) = inlinePragmaName spec <+> text "pragma"
-hsSigDoc (InlineSig _ _ (XCInlinePragma imp)) = dataConCantHappen imp
-- Using the 'inlinePragmaName' function ensures that the pragma name for any
-- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted
-- from the InlineSpec field of the pragma.
=====================================
compiler/GHC/Hs/InlinePragma.hs
=====================================
@@ -21,13 +21,9 @@ module GHC.Hs.InlinePragma(
isAnyInlinePragma, alwaysInlineConLikePragma,
inlinePragmaSource,
inlinePragmaName, inlineSpecSource,
- inlinePragmaSpec, inlinePragmaSat,
- inlinePragmaActivation, inlinePragmaRuleMatchInfo,
- setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
+ setInlinePragmaActivation, setInlinePragmaRuleMatchInfo, setInlinePragmaArity,
pprInline, pprInlineDebug,
convertInlinePragma, convertInlineSpec, convertActivation,
-
- set_pragma_activation, set_pragma_rule, set_pragma_sat
) where
import GHC.Prelude
@@ -223,15 +219,12 @@ data InlinePragmaExt = InlExt
deriving Eq
inl_src :: InlinePragma (GhcPass p) -> SourceText
-inl_src (XCInlinePragma impossible) = dataConCantHappen impossible
inl_src (InlinePragma s _ _ _) = inl_txt s
inl_sat :: InlinePragma (GhcPass p) -> Maybe Arity
-inl_sat (XCInlinePragma impossible) = dataConCantHappen impossible
inl_sat (InlinePragma s _ _ _) = inl_arr s
convertInlinePragma :: InlinePragma (GhcPass p) -> InlinePragma (GhcPass p')
-convertInlinePragma (XCInlinePragma impossible) = XCInlinePragma impossible
convertInlinePragma (InlinePragma s a b c) = InlinePragma s (convertInlineSpec a) (convertActivation b) c
convertInlineSpec :: InlineSpec (GhcPass p) -> InlineSpec (GhcPass p')
@@ -246,8 +239,7 @@ noUserInlineSpec :: InlineSpec (GhcPass p) -> Bool
noUserInlineSpec (NoUserInlinePrag _) = True
noUserInlineSpec _ = False
-defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
- :: InlinePragma (GhcPass p)
+defaultInlinePragma :: InlinePragma (GhcPass p)
defaultInlinePragma = InlinePragma { inl_ext = InlExt (SourceText $ fsLit "{-# INLINE") Nothing
, inl_act = AlwaysActive noExtField
, inl_rule = FunLike
@@ -256,33 +248,17 @@ defaultInlinePragma = InlinePragma { inl_ext = InlExt (SourceText $ fsLit "{-# I
set_pragma_inline :: InlinePragma (GhcPass p) -> InlineSpec (GhcPass p) -> InlinePragma (GhcPass p)
set_pragma_inline inl@(InlinePragma{}) spec = inl{ inl_inline = spec}
-set_pragma_inline (XCInlinePragma imp) _ = dataConCantHappen imp
-
-set_pragma_activation :: InlinePragma (GhcPass p) -> Activation (GhcPass p) -> InlinePragma (GhcPass p)
-set_pragma_activation inl@(InlinePragma{}) act = inl{ inl_act = act}
-set_pragma_activation (XCInlinePragma imp) _ = dataConCantHappen imp
-
-set_pragma_rule :: InlinePragma (GhcPass p) -> RuleMatchInfo -> InlinePragma (GhcPass p)
-set_pragma_rule inl@(InlinePragma{}) act = inl{ inl_rule = act}
-set_pragma_rule (XCInlinePragma imp) _ = dataConCantHappen imp
-
-set_pragma_sat :: InlinePragma (GhcPass p) -> Maybe Arity -> InlinePragma (GhcPass p)
-set_pragma_sat inl@(InlinePragma{ inl_ext = ext}) sat = inl{ inl_ext = ext{inl_arr = sat} }
-set_pragma_sat (XCInlinePragma imp) _ = dataConCantHappen imp
+alwaysInlinePragma :: InlinePragma (GhcPass p)
alwaysInlinePragma = set_pragma_inline defaultInlinePragma $ Inline (inlinePragmaSource defaultInlinePragma)
-neverInlinePragma = set_pragma_activation defaultInlinePragma $ NeverActive noExtField
+neverInlinePragma :: InlinePragma (GhcPass p)
+neverInlinePragma = setInlinePragmaActivation defaultInlinePragma $ NeverActive noExtField
alwaysInlineConLikePragma :: InlinePragma (GhcPass p)
-alwaysInlineConLikePragma = set_pragma_rule alwaysInlinePragma ConLike
-
-inlinePragmaSpec :: InlinePragma (GhcPass p) -> InlineSpec (GhcPass p)
-inlinePragmaSpec inl@(InlinePragma{}) = inl_inline inl
-inlinePragmaSpec (XCInlinePragma imp) = dataConCantHappen imp
+alwaysInlineConLikePragma = setInlinePragmaRuleMatchInfo alwaysInlinePragma ConLike
inlinePragmaSource :: InlinePragma (GhcPass p) -> SourceText
-inlinePragmaSource (XCInlinePragma imp) = dataConCantHappen imp
inlinePragmaSource prag = case inl_inline prag of
Inline x -> x
Inlinable y -> y
@@ -304,9 +280,10 @@ inlineSpecSource spec = case spec of
-- exprIsConApp_maybe can "see" its unfolding
-- (However, its actual Unfolding is a DFunUnfolding, which is
-- never inlined other than via exprIsConApp_maybe.)
+dfunInlinePragma :: InlinePragma (GhcPass p)
dfunInlinePragma = let
- always_active = set_pragma_activation defaultInlinePragma (AlwaysActive noExtField)
- always_active_conlike = set_pragma_rule always_active ConLike
+ always_active = setInlinePragmaActivation defaultInlinePragma (AlwaysActive noExtField)
+ always_active_conlike = setInlinePragmaRuleMatchInfo always_active ConLike
in always_active_conlike
isDefaultInlinePragma :: InlinePragma (GhcPass p) -> Bool
@@ -314,27 +291,23 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation
, inl_rule = match_info
, inl_inline = inline })
= noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
-isDefaultInlinePragma (XCInlinePragma impossible) = dataConCantHappen impossible
isInlinePragma :: InlinePragma (GhcPass p) -> Bool
isInlinePragma prag@(InlinePragma{}) = case inl_inline prag of
Inline _ -> True
_ -> False
-isInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isInlinablePragma :: InlinePragma (GhcPass p) -> Bool
isInlinablePragma prag@(InlinePragma{}) =
case inl_inline prag of
Inlinable _ -> True
_ -> False
-isInlinablePragma (XCInlinePragma imp) = dataConCantHappen imp
isNoInlinePragma :: InlinePragma (GhcPass p) -> Bool
isNoInlinePragma prag@(InlinePragma{}) =
case inl_inline prag of
NoInline _ -> True
_ -> False
-isNoInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isAnyInlinePragma :: InlinePragma (GhcPass p) -> Bool
-- INLINE or INLINABLE
@@ -343,35 +316,22 @@ isAnyInlinePragma prag@(InlinePragma{}) =
Inline _ -> True
Inlinable _ -> True
_ -> False
-isAnyInlinePragma (XCInlinePragma imp) = dataConCantHappen imp
isOpaquePragma :: InlinePragma (GhcPass p) -> Bool
isOpaquePragma prag@(InlinePragma{}) =
case inl_inline prag of
Opaque _ -> True
_ -> False
-isOpaquePragma (XCInlinePragma imp) = dataConCantHappen imp
-
-inlinePragmaSat :: InlinePragma (GhcPass p) -> Maybe Arity
-inlinePragmaSat prag@(InlinePragma{}) = inl_sat prag
-inlinePragmaSat (XCInlinePragma imp) = dataConCantHappen imp
-
-inlinePragmaActivation :: InlinePragma (GhcPass p) -> Activation (GhcPass p)
-inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
-inlinePragmaActivation (XCInlinePragma impossible) = dataConCantHappen impossible
-inlinePragmaRuleMatchInfo :: InlinePragma (GhcPass p) -> RuleMatchInfo
-inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
-inlinePragmaRuleMatchInfo (XCInlinePragma impossible) = dataConCantHappen impossible
setInlinePragmaActivation :: InlinePragma (GhcPass p) -> Activation (GhcPass p) -> InlinePragma (GhcPass p)
setInlinePragmaActivation prag@(InlinePragma{}) activation = prag { inl_act = activation }
-setInlinePragmaActivation (XCInlinePragma impossible) _ = dataConCantHappen impossible
setInlinePragmaRuleMatchInfo :: InlinePragma (GhcPass p) -> RuleMatchInfo -> InlinePragma (GhcPass p)
setInlinePragmaRuleMatchInfo prag@(InlinePragma{}) rule = prag { inl_rule = rule }
-setInlinePragmaRuleMatchInfo (XCInlinePragma impossible) _ = dataConCantHappen impossible
+setInlinePragmaArity :: InlinePragma (GhcPass p) -> Maybe Arity -> InlinePragma (GhcPass p)
+setInlinePragmaArity inl@(InlinePragma{ inl_ext = ext}) sat = inl{ inl_ext = ext{inl_arr = sat} }
{-
************************************************************************
@@ -609,7 +569,6 @@ pprInline' emptyInline (InlinePragma
| otherwise = empty
pp_info | isFunLike info = empty
| otherwise = ppr info
-pprInline' _ (XCInlinePragma impossible) = dataConCantHappen impossible
instance Binary RuleMatchInfo where
put_ bh FunLike = putByte bh 0
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -443,7 +443,6 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
| otherwise
= case inline_prag of
- XCInlinePragma imp -> dataConCantHappen imp
InlinePragma{inl_inline = spec} -> case spec of
NoUserInlinePrag{} -> (gbl_id, rhs)
NoInline {} -> (gbl_id, rhs)
@@ -456,7 +455,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
- | Just arity <- inlinePragmaSat inline_prag
+ | Just arity <- inl_sat 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 + arity
@@ -895,16 +894,16 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
-- Get the INLINE pragma from SPECIALISE declaration, or,
-- failing that, from the original Id
- spec_prag_act = inlinePragmaActivation spec_inl
+ spec_prag_act = inl_act spec_inl
-- See Note [Activation pragmas for SPECIALISE]
-- no_act_spec is True if the user didn't write an explicit
-- phase specification in the SPECIALISE pragma
- no_act_spec = case inlinePragmaSpec spec_inl of
+ no_act_spec = case inl_inline spec_inl of
NoInline _ -> isNeverActive spec_prag_act
Opaque _ -> isNeverActive spec_prag_act
_ -> isAlwaysActive spec_prag_act
- rule_act | no_act_spec = inlinePragmaActivation id_inl -- Inherit
+ rule_act | no_act_spec = inl_act id_inl -- Inherit
| otherwise = spec_prag_act -- Specified by user
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1075,7 +1075,6 @@ rep_inline :: LocatedN Name
-> InlinePragma (GhcPass p) -- Never defaultInlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_inline _ (XCInlinePragma imp) _ = dataConCantHappen imp
rep_inline nm ispec loc
| Opaque {} <- inl_inline ispec
= do { nm1 <- lookupLOcc nm
@@ -1094,7 +1093,6 @@ rep_inline nm ispec loc
rep_specialise :: LocatedN Name -> LHsSigType GhcRn -> InlinePragma (GhcPass p)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_specialise _ _ (XCInlinePragma imp) _ = dataConCantHappen imp
rep_specialise nm ty ispec loc
= do { nm1 <- lookupLOcc nm
; ty1 <- repHsSigType ty
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -90,7 +90,7 @@ import GHC.Types.Tickish
import GHC.Types.TypeEnv
import GHC.Tc.Utils.TcType (tcSplitNestedSigmaTys)
-import GHC.Hs.InlinePragma(isNeverActive, inlinePragmaActivation)
+import GHC.Hs.InlinePragma(isNeverActive, InlinePragma(..))
import GHC.Unit.Module
import GHC.Unit.Module.ModGuts
@@ -803,7 +803,7 @@ addExternal opts id
idinfo = idInfo id
unfolding = realUnfoldingInfo idinfo
show_unfold = show_unfolding unfolding
- never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
+ never_active = isNeverActive (inl_act (inlinePragInfo idinfo))
loop_breaker = isStrongLoopBreaker (occInfo idinfo)
-- bottoming_fn: don't inline bottoming functions, unless the
-- RHS is very small or trivial (UnfWhen), in which case we
=====================================
compiler/GHC/Tc/Deriv/Generics.hs
=====================================
@@ -377,7 +377,7 @@ mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
max_fields = maximum $ map dataConSourceArity datacons
inline1 f = L loc'' . InlineSig noAnn (L loc' f)
- $ set_pragma_activation alwaysInlinePragma (ActiveAfter NoSourceText 1)
+ $ setInlinePragmaActivation alwaysInlinePragma (ActiveAfter NoSourceText 1)
-- The topmost M1 (the datatype metadata) has the exact same type
-- across all cases of a from/to definition, and can be factored out
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -589,10 +589,9 @@ addInlinePragArity _ sig = sig
add_inl_arity :: Arity -> InlinePragma (GhcPass p) -> InlinePragma (GhcPass p)
add_inl_arity ar prag@(InlinePragma { inl_inline = inl_spec })
| Inline {} <- inl_spec -- Add arity only for real INLINE pragmas, not INLINABLE
- = set_pragma_sat prag (Just ar)
+ = setInlinePragmaArity prag (Just ar)
| otherwise
= prag
-add_inl_arity _ (XCInlinePragma imp) = dataConCantHappen imp
lhsBindArity :: LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity
lhsBindArity (L _ (FunBind { fun_id = id, fun_matches = ms })) env
@@ -615,8 +614,8 @@ addInlinePrags poly_id prags_for_me
warn_multiple_inlines _ [] = return ()
warn_multiple_inlines inl1@(L loc prag1) (inl2@(L _ prag2) : inls)
- | inlinePragmaActivation prag1 == inlinePragmaActivation prag2
- , noUserInlineSpec (inlinePragmaSpec prag1)
+ | inl_act prag1 == inl_act prag2
+ , noUserInlineSpec (inl_inline prag1)
= -- Tiresome: inl1 is put there by virtue of being in a hs-boot loop
-- and inl2 is a user NOINLINE pragma; we don't want to complain
warn_multiple_inlines inl2 inls
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -1378,7 +1378,7 @@ addDFunPrags :: DFunId -> [Id] -> DFunId
addDFunPrags dfun_id sc_meth_ids
| is_newtype
= dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity defaultSimpleOpts StableSystemSrc 0 con_app
- `setInlinePragma` (alwaysInlinePragma `set_pragma_sat` Just 0)
+ `setInlinePragma` (alwaysInlinePragma `setInlinePragmaArity` Just 0)
| otherwise
= dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args
`setInlinePragma` dfunInlinePragma
=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -950,13 +950,13 @@ modifyInlinePragma :: Id -> (InlinePragma GhcTc -> InlinePragma GhcTc) -> Id
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
idInlineActivation :: Id -> Activation GhcTc
-idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
+idInlineActivation id = inl_act (idInlinePragma id)
setInlineActivation :: Id -> Activation GhcTc -> Id
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
idRuleMatchInfo :: Id -> RuleMatchInfo
-idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
+idRuleMatchInfo id = inl_rule (idInlinePragma id)
isConLikeId :: Id -> Bool
isConLikeId id = isConLike (idRuleMatchInfo id)
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -618,7 +618,7 @@ mkDataConWorkId wkr_name data_con
-- See Note [Strict fields in Core]
`setLFInfo` wkr_lf_info
- wkr_inline_prag = set_pragma_rule defaultInlinePragma ConLike
+ wkr_inline_prag = setInlinePragmaRuleMatchInfo defaultInlinePragma ConLike
wkr_arity = dataConRepArity data_con
wkr_sig = mkClosedDmdSig wkr_dmds topDiv
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c990bcdb31be117fa85d28dc2708f82d10874f...b8c8b323b7dc24b5a891894571d3628709a2cb91
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c990bcdb31be117fa85d28dc2708f82d10874f...b8c8b323b7dc24b5a891894571d3628709a2cb91
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241028/dead570b/attachment-0001.html>
More information about the ghc-commits
mailing list