summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs30
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Utils.hs20
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs2
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs20
-rw-r--r--compiler/GHC/Hs/Binds.hs4
-rw-r--r--compiler/GHC/HsToCore/Binds.hs8
-rw-r--r--compiler/GHC/HsToCore/Quote.hs8
-rw-r--r--compiler/GHC/Parser.y2
-rw-r--r--compiler/GHC/ThToHs.hs2
-rw-r--r--compiler/GHC/Types/Basic.hs26
-rw-r--r--compiler/GHC/Utils/Binary.hs10
12 files changed, 86 insertions, 48 deletions
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 97d38c8bd1..a746e4feb8 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -1693,14 +1693,16 @@ occAnalUnfolding :: OccEnv
occAnalUnfolding env is_rec mb_join_arity unf
= case unf of
unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src })
- | isStableSource src -> (usage, unf')
- | otherwise -> (emptyDetails, unf)
- where -- For non-Stable unfoldings we leave them undisturbed, but
+ | isStableSource src -> (markAllMany usage, unf')
+ -- markAllMany: see Note [Occurrences in stable unfoldings]
+ | otherwise -> (emptyDetails, unf)
+ -- For non-Stable unfoldings we leave them undisturbed, but
-- don't count their usage because the simplifier will discard them.
-- We leave them undisturbed because nodeScore uses their size info
-- to guide its decisions. It's ok to leave un-substituted
-- expressions in the tree because all the variables that were in
-- scope remain in scope; there is no cloning etc.
+ where
(usage, rhs') = occAnalRhs env is_rec mb_join_arity rhs
unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules]
@@ -1759,6 +1761,28 @@ the FloatIn pass knows to float into join point RHSs; and the simplifier
does not float things out of join point RHSs. But it's a simple, cheap
thing to do. See #14137.
+Note [Occurrences in stable unfoldings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ f p = BIG
+ {-# INLINE g #-}
+ g y = not (f y)
+where this is the /only/ occurrence of 'f'. So 'g' will get a stable
+unfolding. Now suppose that g's RHS gets optimised (perhaps by a rule
+or inlining f) so that it doesn't mention 'f' any more. Now the last
+remaining call to f is in g's Stable unfolding. But, even though there
+is only one syntactic occurrence of f, we do /not/ want to do
+preinlineUnconditionally here!
+
+The INLINE pragma says "inline exactly this RHS"; perhaps the
+programmer wants to expose that 'not', say. If we inline f that will make
+the Stable unfoldign big, and that wasn't what the programmer wanted.
+
+Another way to think about it: if we inlined g as-is into multiple
+call sites, now there's be multiple calls to f.
+
+Bottom line: treat all occurrences in a stable unfolding as "Many".
+
Note [Unfoldings and rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally unfoldings and rules are already occurrence-analysed, so we
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 96d9cfc61e..4ba4b0a797 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -549,7 +549,7 @@ mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
-- See Note [Cast wrappers]
mkCastWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info })
= InlinePragma { inl_src = SourceText "{-# INLINE"
- , inl_inline = NoUserInline -- See Note [Wrapper NoUserInline]
+ , inl_inline = NoUserInlinePrag -- See Note [Wrapper NoUserInline]
, inl_sat = Nothing -- in GHC.Core.Opt.WorkWrap
, inl_act = wrap_act -- See Note [Wrapper activation]
, inl_rule = rule_info } -- in GHC.Core.Opt.WorkWrap
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 41ef2291e0..347542b446 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -1190,7 +1190,7 @@ However, as usual for Gentle mode, do not inline things that are
inactive in the initial stages. See Note [Gentle mode].
Note [Stable unfoldings and preInlineUnconditionally]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Surprisingly, do not pre-inline-unconditionally Ids with INLINE pragmas!
Example
@@ -1210,10 +1210,18 @@ the application is saturated for exactly this reason; and we don't
want PreInlineUnconditionally to second-guess it. A live example is #3736.
c.f. Note [Stable unfoldings and postInlineUnconditionally]
-NB: if the pragma is INLINEABLE, then we don't want to behave in
-this special way -- an INLINEABLE pragma just says to GHC "inline this
-if you like". But if there is a unique occurrence, we want to inline
-the stable unfolding, not the RHS.
+NB: this only applies for INLINE things. Do /not/ switch off
+preInlineUnconditionally for
+
+* INLINABLE. It just says to GHC "inline this if you like". If there
+ is a unique occurrence, we want to inline the stable unfolding, not
+ the RHS.
+
+* NONLINE[n] just switches off inlining until phase n. We should
+ respect that, but after phase n, just behave as usual.
+
+* NoUserInlinePrag. There is no pragma at all. This ends up on wrappers.
+ (See #18815.)
Note [Top-level bottoming Ids]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1247,7 +1255,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
| not (isStableUnfolding unf) = Just (extend_subst_with rhs)
-- Note [Stable unfoldings and preInlineUnconditionally]
- | isInlinablePragma inline_prag
+ | not (isInlinePragma inline_prag)
, Just inl <- maybeUnfoldingTemplate unf = Just (extend_subst_with inl)
| otherwise = Nothing
where
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 57c49cd5c9..14a1e0cda9 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -1524,7 +1524,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- See Note [Specialising imported functions] in "GHC.Core.Opt.OccurAnal"
| InlinePragma { inl_inline = Inlinable } <- inl_prag
- = (inl_prag { inl_inline = NoUserInline }, noUnfolding)
+ = (inl_prag { inl_inline = NoUserInlinePrag }, noUnfolding)
| otherwise
= (inl_prag, specUnfolding simpl_opts spec_bndrs (`mkApps` spec_args)
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 97af84ee68..4994875772 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -446,13 +446,19 @@ Conclusion:
- Otherwise inline wrapper in phase 2. That allows the
'gentle' simplification pass to apply specialisation rules
-
-Note [Wrapper NoUserInline]
+Note [Wrapper NoUserInlinePrag]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The use an inl_inline of NoUserInline on the wrapper distinguishes
-this pragma from one that was given by the user. In particular, CSE
-will not happen if there is a user-specified pragma, but should happen
-for w/w’ed things (#14186).
+We use NoUserInlinePrag on the wrapper, to say that there is no
+user-specified inline pragma. (The worker inherits that; see Note
+[Worker-wrapper for INLINABLE functions].) The wrapper has no pragma
+given by the user.
+
+(Historical note: we used to give the wrapper an INLINE pragma, but
+CSE will not happen if there is a user-specified pragma, but should
+happen for w/w’ed things (#14186). We don't need a pragma, because
+everything we needs is expressed by (a) the stable unfolding and (b)
+the inl_act activation.)
+
-}
tryWW :: DynFlags
@@ -678,7 +684,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
mkStrWrapperInlinePrag :: InlinePragma -> InlinePragma
mkStrWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info })
= InlinePragma { inl_src = SourceText "{-# INLINE"
- , inl_inline = NoUserInline -- See Note [Wrapper NoUserInline]
+ , inl_inline = NoUserInlinePrag -- See Note [Wrapper NoUserInline]
, inl_sat = Nothing
, inl_act = wrap_act
, inl_rule = rule_info } -- RuleMatchInfo is (and must be) unaffected
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index a2d46d35ed..f5e973053a 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -1160,8 +1160,8 @@ ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))
(interpp'SP ty) inl)
where
pragmaSrc = case spec of
- NoUserInline -> "{-# SPECIALISE"
- _ -> "{-# SPECIALISE_INLINE"
+ NoUserInlinePrag -> "{-# SPECIALISE"
+ _ -> "{-# SPECIALISE_INLINE"
ppr_sig (InlineSig _ var inl)
= pragSrcBrackets (inl_src inl) "{-# INLINE" (pprInline inl
<+> pprPrefixOcc (unLoc var))
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 5072fa1fc4..cb9df758d0 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -384,10 +384,10 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
| otherwise
= case inlinePragmaSpec inline_prag of
- NoUserInline -> (gbl_id, rhs)
- NoInline -> (gbl_id, rhs)
- Inlinable -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
- Inline -> inline_pair
+ NoUserInlinePrag -> (gbl_id, rhs)
+ NoInline -> (gbl_id, rhs)
+ Inlinable -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
+ Inline -> inline_pair
where
simpl_opts = initSimpleOpts dflags
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 264fbd26f9..ada90cab6b 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1108,10 +1108,10 @@ rep_specialiseInst ty loc
; return [(loc, pragma)] }
repInline :: InlineSpec -> MetaM (Core TH.Inline)
-repInline NoInline = dataCon noInlineDataConName
-repInline Inline = dataCon inlineDataConName
-repInline Inlinable = dataCon inlinableDataConName
-repInline NoUserInline = notHandled "NOUSERINLINE" empty
+repInline NoInline = dataCon noInlineDataConName
+repInline Inline = dataCon inlineDataConName
+repInline Inlinable = dataCon inlinableDataConName
+repInline NoUserInlinePrag = notHandled "NOUSERINLINE" empty
repRuleMatch :: RuleMatchInfo -> MetaM (Core TH.RuleMatch)
repRuleMatch ConLike = dataCon conLikeDataConName
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index b8a777a8fe..b688b86310 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2513,7 +2513,7 @@ sigdecl :: { LHsDecl GhcPs }
| '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
{% ams (
let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
- (NoUserInline, FunLike) (snd $2)
+ (NoUserInlinePrag, FunLike) (snd $2)
in sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5) inl_prag))
(mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 3f093dd8b8..792b3614c3 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -761,7 +761,7 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
; let (inline', dflt,srcText) = case inline of
Just inline1 -> (cvtInline inline1, dfltActivation inline1,
src inline1)
- Nothing -> (NoUserInline, AlwaysActive,
+ Nothing -> (NoUserInlinePrag, AlwaysActive,
"{-# SPECIALISE")
; let ip = InlinePragma { inl_src = SourceText srcText
, inl_inline = inline'
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 0abf8282de..5942f24d56 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -1467,11 +1467,11 @@ data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
-- | Inline Specification
data InlineSpec -- What the user's INLINE pragma looked like
- = Inline -- User wrote INLINE
- | Inlinable -- User wrote INLINABLE
- | NoInline -- User wrote NOINLINE
- | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE
- -- e.g. in `defaultInlinePragma` or when created by CSE
+ = Inline -- User wrote INLINE
+ | Inlinable -- User wrote INLINABLE
+ | NoInline -- User wrote NOINLINE
+ | NoUserInlinePrag -- User did not write any of INLINE/INLINABLE/NOINLINE
+ -- e.g. in `defaultInlinePragma` or when created by CSE
deriving( Eq, Data, Show )
-- Show needed for GHC.Parser.Lexer
@@ -1481,7 +1481,7 @@ This data type mirrors what you can write in an INLINE or NOINLINE pragma in
the source program.
If you write nothing at all, you get defaultInlinePragma:
- inl_inline = NoUserInline
+ inl_inline = NoUserInlinePrag
inl_act = AlwaysActive
inl_rule = FunLike
@@ -1555,15 +1555,15 @@ isFunLike FunLike = True
isFunLike _ = False
noUserInlineSpec :: InlineSpec -> Bool
-noUserInlineSpec NoUserInline = True
-noUserInlineSpec _ = False
+noUserInlineSpec NoUserInlinePrag = True
+noUserInlineSpec _ = False
defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
:: InlinePragma
defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"
, inl_act = AlwaysActive
, inl_rule = FunLike
- , inl_inline = NoUserInline
+ , inl_inline = NoUserInlinePrag
, inl_sat = Nothing }
alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
@@ -1629,10 +1629,10 @@ instance Outputable RuleMatchInfo where
ppr FunLike = text "FUNLIKE"
instance Outputable InlineSpec where
- ppr Inline = text "INLINE"
- ppr NoInline = text "NOINLINE"
- ppr Inlinable = text "INLINABLE"
- ppr NoUserInline = text "NOUSERINLINE" -- what is better?
+ ppr Inline = text "INLINE"
+ ppr NoInline = text "NOINLINE"
+ ppr Inlinable = text "INLINABLE"
+ ppr NoUserInlinePrag = empty
instance Outputable InlinePragma where
ppr = pprInline
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index d4afa624cf..2975ab2d0d 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -1311,14 +1311,14 @@ instance Binary RuleMatchInfo where
else return FunLike
instance Binary InlineSpec where
- put_ bh NoUserInline = putByte bh 0
- put_ bh Inline = putByte bh 1
- put_ bh Inlinable = putByte bh 2
- put_ bh NoInline = putByte bh 3
+ put_ bh NoUserInlinePrag = putByte bh 0
+ put_ bh Inline = putByte bh 1
+ put_ bh Inlinable = putByte bh 2
+ put_ bh NoInline = putByte bh 3
get bh = do h <- getByte bh
case h of
- 0 -> return NoUserInline
+ 0 -> return NoUserInlinePrag
1 -> return Inline
2 -> return Inlinable
_ -> return NoInline
View Lorry Controller Status