Commit a263737b authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Another refactoring on the shape of an Unfolding

I found that a compulsory unfolding was getting dropped on the floor,
so I took that as a hint to tidy up the data type so that it won't
happen again.  No big change in functionality.
parent 545cdeb5
......@@ -510,27 +510,27 @@ substUnfolding subst (DFunUnfolding con args)
substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) })
-- Retain an InlineRule!
= seqExpr new_tmpl `seq`
new_mb_wkr `seq`
unf { uf_tmpl = new_tmpl, uf_guidance = guide { ug_ir_info = new_mb_wkr } }
new_info `seq`
unf { uf_tmpl = new_tmpl, uf_guidance = guide { ir_info = new_info } }
where
new_tmpl = substExpr subst tmpl
new_mb_wkr = substInlineRuleGuidance subst (ug_ir_info guide)
new_tmpl = substExpr subst tmpl
new_info = substInlineRuleInfo subst (ir_info guide)
substUnfolding _ (CoreUnfolding {}) = NoUnfolding -- Discard
-- Always zap a CoreUnfolding, to save substitution work
substUnfolding _ unf = unf -- Otherwise no substitution to do
substUnfolding _ unf = unf -- NoUnfolding, OtherCon
-------------------
substInlineRuleGuidance :: Subst -> InlineRuleInfo -> InlineRuleInfo
substInlineRuleGuidance subst (InlWrapper wkr)
substInlineRuleInfo :: Subst -> InlineRuleInfo -> InlineRuleInfo
substInlineRuleInfo subst (InlWrapper wkr)
= case lookupIdSubst subst wkr of
Var w1 -> InlWrapper w1
other -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr wkr )
InlUnSat -- Worker has got substituted away altogether
InlVanilla -- Worker has got substituted away altogether
-- (This can happen if it's trivial, via
-- postInlineUnconditionally, hence only warning)
substInlineRuleGuidance _ info = info
substInlineRuleInfo _ info = info
------------------
substIdOcc :: Subst -> Id -> Id
......
......@@ -35,7 +35,7 @@ module CoreSyn (
isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
-- * Unfolding data types
Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..),
Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..), InlSatFlag(..),
-- Abstract everywhere but in CoreUnfold.lhs
-- ** Constructing 'Unfolding's
......@@ -440,20 +440,14 @@ data Unfolding
------------------------------------------------
-- | 'UnfoldingGuidance' says when unfolding should take place
data UnfoldingGuidance
= UnfoldAlways -- There is /no original definition/, so you'd better unfold.
-- The unfolding is guaranteed to have no free variables
-- so no need to think about it during dependency analysis
| InlineRule { -- See Note [InlineRules]
-- Be very keen to inline this
= InlineRule { -- Be very keen to inline this; See Note [InlineRules]
-- The uf_tmpl is the *original* RHS; do *not* replace it on
-- each simlifier run. Hence, the *actual* RHS of the function
-- may be different by now, because it may have been optimised.
ug_ir_info :: InlineRuleInfo, -- Supplementary info about the InlineRule
ug_small :: Bool -- True <=> the RHS is so small (eg no bigger than a call)
-- that you should always inline a saturated call,
} -- regardless of how boring the context is
-- See Note [INLINE for small functions] in CoreUnfold]
ir_sat :: InlSatFlag,
ir_info :: InlineRuleInfo
}
| UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the
-- result of a simple analysis of the RHS
......@@ -468,20 +462,29 @@ data UnfoldingGuidance
} -- a context (case (thing args) of ...),
-- (where there are the right number of arguments.)
| UnfoldNever
| UnfoldNever -- A variant of UnfoldIfGoodArgs, used for big RHSs
data InlineRuleInfo
= InlSat -- A user-specifed or compiler injected INLINE pragma
-- ONLY inline when it's applied to 'arity' arguments
= InlAlways -- Inline absolutely always, however boring the context.
-- There is /no original definition/. Only a few primop-like things
-- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding).
| InlSmall -- The RHS is very small (eg no bigger than a call), so inline any
-- /saturated/ application, regardless of context
-- See Note [INLINE for small functions] in CoreUnfold
| InlVanilla
| InlUnSat -- The compiler decided to "capture" the RHS into an
-- InlineRule, but do not require that it appears saturated
| InlWrapper Id -- This unfolding is a the wrapper in a
-- worker/wrapper split from the strictness analyser
-- Used to abbreviate the uf_tmpl in interface files
-- which don't need to contain the RHS;
-- it can be derived from the strictness info
-- [In principle this is orthogonal to the InlSmall/InVanilla thing,
-- but it's convenient to have it here.]
| InlWrapper Id -- This unfolding is a the wrapper in a
-- worker/wrapper split from the strictness analyser
-- Used to abbreviate the uf_tmpl in interface files
-- which don't need to contain the RHS;
-- it can be derived from the strictness info
data InlSatFlag = InlSat | InlUnSat
-- Specifies whether to INLINE only if the thing is applied to 'arity' args
------------------------------------------------
noUnfolding :: Unfolding
......@@ -564,10 +567,10 @@ isInlineRule :: Unfolding -> Bool
isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
isInlineRule _ = False
isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo
isInlineRule_maybe (CoreUnfolding {
uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl
isInlineRule_maybe _ = Nothing
isInlineRule_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag)
isInlineRule_maybe (CoreUnfolding { uf_guidance =
InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat)
isInlineRule_maybe _ = Nothing
isStableUnfolding :: Unfolding -> Bool
-- True of unfoldings that should not be overwritten
......
......@@ -79,21 +79,6 @@ mkImplicitUnfolding :: CoreExpr -> Unfolding
-- For implicit Ids, do a tiny bit of optimising first
mkImplicitUnfolding expr = mkTopUnfolding (simpleOptExpr expr)
mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
mkWwInlineRule id = mkInlineRule (InlWrapper id)
mkInlineRule :: InlineRuleInfo -> CoreExpr -> Arity -> Unfolding
mkInlineRule inl_info expr arity
= mkCoreUnfolding True -- Note [Top-level flag on inline rules]
expr' arity
(InlineRule { ug_ir_info = inl_info, ug_small = small })
where
expr' = simpleOptExpr expr
small = case calcUnfoldingGuidance (arity+1) expr' of
(arity_e, UnfoldIfGoodArgs { ug_size = size_e })
-> uncondInline arity_e size_e
_other {- actually UnfoldNever -} -> False
-- Note [Top-level flag on inline rules]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Slight hack: note that mk_inline_rules conservatively sets the
......@@ -129,9 +114,28 @@ mkCoreUnfolding top_lvl expr arity guidance
mkDFunUnfolding :: DataCon -> [Id] -> Unfolding
mkDFunUnfolding con ops = DFunUnfolding con (map Var ops)
mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
mkWwInlineRule id expr arity
= mkCoreUnfolding True (simpleOptExpr expr) arity
(InlineRule { ir_sat = InlUnSat, ir_info = InlWrapper id })
mkCompulsoryUnfolding :: CoreExpr -> Unfolding
mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
= mkCoreUnfolding True expr 0 UnfoldAlways -- Arity of unfolding doesn't matter
mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
= mkCoreUnfolding True expr 0 -- Arity of unfolding doesn't matter
(InlineRule { ir_info = InlAlways, ir_sat = InlUnSat })
mkInlineRule :: InlSatFlag -> CoreExpr -> Arity -> Unfolding
mkInlineRule sat expr arity
= mkCoreUnfolding True -- Note [Top-level flag on inline rules]
expr' arity
(InlineRule { ir_sat = sat, ir_info = info })
where
expr' = simpleOptExpr expr
info = if small then InlSmall else InlVanilla
small = case calcUnfoldingGuidance (arity+1) expr' of
(arity_e, UnfoldIfGoodArgs { ug_size = size_e })
-> uncondInline arity_e size_e
_other {- actually UnfoldNever -} -> False
\end{code}
......@@ -552,7 +556,6 @@ certainlyWillInline :: Unfolding -> Bool
-- Sees if the unfolding is pretty certain to inline
certainlyWillInline (CoreUnfolding { uf_is_cheap = is_cheap, uf_arity = n_vals, uf_guidance = guidance })
= case guidance of
UnfoldAlways {} -> True
UnfoldNever -> False
InlineRule {} -> True
UnfoldIfGoodArgs { ug_size = size}
......@@ -661,23 +664,19 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
= case guidance of
UnfoldNever -> False
UnfoldAlways -> True
-- UnfoldAlways => there is no top-level binding for
-- these things, so we must inline it. Only a few
-- primop-like things have compulsory unfoldings (see
-- MkId.lhs). Ignore is_active because we want to
-- inline even if SimplGently is on.
InlineRule { ug_ir_info = inl_info, ug_small = uncond_inline }
InlineRule { ir_info = inl_info, ir_sat = sat }
| InlAlways <- inl_info -> True -- No top-level binding, so inline!
-- Ignore is_active because we want to
-- inline even if SimplGently is on.
| not active_inline -> False
| n_val_args < uf_arity -> yes_unsat -- Not enough value args
| uncond_inline -> True -- Note [INLINE for small functions]
| InlSmall <- inl_info -> True -- Note [INLINE for small functions]
| otherwise -> some_benefit -- Saturated or over-saturated
where
-- See Note [Inlining an InlineRule]
yes_unsat = case inl_info of
InlSat -> False
_other -> interesting_args
yes_unsat = case sat of
InlSat -> False
InlUnSat -> interesting_args
UnfoldIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
| not active_inline -> False
......@@ -743,7 +742,7 @@ Consider {-# INLINE f #-}
g y = f y
Then f's RHS is no larger than its LHS, so we should inline it
into even the most boring context. (We do so if there is no INLINE
pragma!) That's the reason for the 'inl_small' flag on an InlineRule.
pragma!) That's the reason for the 'ug_small' flag on an InlineRule.
Note [Things to watch]
......@@ -899,7 +898,7 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
CaseCtxt -> res_discount
_other -> 4 `min` res_discount
-- res_discount can be very large when a function returns
-- construtors; but we only want to invoke that large discount
-- constructors; but we only want to invoke that large discount
-- when there's a case continuation.
-- Otherwise we, rather arbitrarily, threshold it. Yuk.
-- But we want to aovid inlining large functions that return
......
......@@ -379,20 +379,24 @@ showAttributes stuff
\begin{code}
instance Outputable UnfoldingGuidance where
ppr UnfoldNever = ptext (sLit "NEVER")
ppr UnfoldAlways = ptext (sLit "ALWAYS")
ppr (InlineRule { ug_ir_info = inl_info, ug_small = small })
= ptext (sLit "InlineRule") <> ppr (inl_info,small)
ppr (InlineRule { ir_info = info, ir_sat = sat })
= ptext (sLit "InlineRule") <> ppr (sat,info)
ppr (UnfoldIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })
= hsep [ ptext (sLit "IF_ARGS"),
brackets (hsep (map int cs)),
int size,
int discount ]
instance Outputable InlineRuleInfo where
ppr (InlWrapper w) = ptext (sLit "worker=") <> ppr w
instance Outputable InlSatFlag where
ppr InlSat = ptext (sLit "sat")
ppr InlUnSat = ptext (sLit "unsat")
instance Outputable InlineRuleInfo where
ppr (InlWrapper w) = ptext (sLit "worker=") <> ppr w
ppr InlSmall = ptext (sLit "small")
ppr InlAlways = ptext (sLit "always")
ppr InlVanilla = ptext (sLit "-")
instance Outputable Unfolding where
ppr NoUnfolding = ptext (sLit "No unfolding")
ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
......
......@@ -1482,14 +1482,12 @@ toIfaceIdInfo id_info
toIfUnfolding :: Unfolding -> Maybe IfaceInfoItem
toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
= case guidance of
InlineRule { ug_ir_info = InlSat } -> Just (HsUnfold (IfInlineRule arity True (toIfaceExpr rhs)))
InlineRule { ug_ir_info = InlUnSat } -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
InlineRule { ug_ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
InlineRule { ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
InlineRule { ir_sat = InlSat } -> Just (HsUnfold (IfInlineRule arity True (toIfaceExpr rhs)))
InlineRule { ir_sat = InlUnSat } -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
UnfoldNever -> Nothing
UnfoldIfGoodArgs {} -> Just (HsUnfold (IfCoreUnfold (toIfaceExpr rhs)))
UnfoldAlways -> panic "toIfUnfolding:UnfoldAlways"
-- Never happens because we never have
-- bindings for unfold-always things
toIfUnfolding (DFunUnfolding _con ops)
= Just (HsUnfold (IfDFunUnfold (map toIfaceExpr ops)))
-- No need to serialise the data constructor;
......
......@@ -1055,7 +1055,7 @@ tidyUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding
tidyUnfolding tidy_env _ unf@(CoreUnfolding { uf_tmpl = rhs
, uf_guidance = guide@(InlineRule {}) })
= unf { uf_tmpl = tidyExpr tidy_env rhs, -- Preserves OccInfo
uf_guidance = guide { ug_ir_info = tidyInl tidy_env (ug_ir_info guide) } }
uf_guidance = guide { ir_info = tidyInl tidy_env (ir_info guide) } }
tidyUnfolding tidy_env _ (DFunUnfolding con ids)
= DFunUnfolding con (map (tidyExpr tidy_env) ids)
tidyUnfolding _ tidy_rhs (CoreUnfolding {})
......
......@@ -533,7 +533,7 @@ reOrderCycle depth (bind : binds) pairs
-- where df is the exported dictionary. Then df makes a really
-- bad choice for loop breaker
| Just inl_rule_info <- isInlineRule_maybe (idUnfolding bndr)
| Just (inl_rule_info, _) <- isInlineRule_maybe (idUnfolding bndr)
= case inl_rule_info of
InlWrapper {} -> 10 -- Note [INLINE pragmas]
_other -> 3 -- Data structures are more important than this
......
......@@ -410,7 +410,7 @@ Inlining is controlled partly by the SimplifierMode switch. This has two
settings:
SimplGently (a) Simplifying before specialiser/full laziness
(b) Simplifiying inside INLINE pragma
(b) Simplifiying inside InlineRules
(c) Simplifying the LHS of a rule
(d) Simplifying a GHCi expression or Template
Haskell splice
......@@ -431,11 +431,11 @@ running it, we don't want to use -O2. Indeed, we don't want to inline
anything, because the byte-code interpreter might get confused about
unboxed tuples and suchlike.
INLINE pragmas
~~~~~~~~~~~~~~
We don't simplify inside InlineRules (which come from INLINE pragmas).
It really is important to switch off inlinings inside such
expressions. Consider the following example
Note [Simplifying gently inside InlineRules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We don't do much simplification inside InlineRules (which come from
INLINE pragmas). It really is important to switch off inlinings
inside such expressions. Consider the following example
let f = \pq -> BIG
in
......@@ -444,16 +444,14 @@ expressions. Consider the following example
in ...g...g...g...g...g...
Now, if that's the ONLY occurrence of f, it will be inlined inside g,
and thence copied multiple times when g is inlined.
and thence copied multiple times when g is inlined.
This function may be inlinined in other modules, so we
don't want to remove (by inlining) calls to functions that have
specialisations, or that may have transformation rules in an importing
scope.
This function may be inlinined in other modules, so we don't want to
remove (by inlining) calls to functions that have specialisations, or
that may have transformation rules in an importing scope.
E.g. {-# INLINE f #-}
f x = ...g...
f x = ...g...
and suppose that g is strict *and* has specialisations. If we inline
g's wrapper, we deny f the chance of getting the specialised version
......@@ -471,15 +469,14 @@ continuation. That's why the keep_inline predicate returns True for
ArgOf continuations. It shouldn't do any harm not to dissolve the
inline-me note under these circumstances.
Note that the result is that we do very little simplification
inside an InlineMe.
Although we do very little simplification inside an InlineRule,
the RHS is simplified as normal. For example:
all xs = foldr (&&) True xs
any p = all . map p {-# INLINE any #-}
Problem: any won't get deforested, and so if it's exported and the
importer doesn't use the inlining, (eg passes it as an arg) then we
won't get deforestation at all. We havn't solved this problem yet!
The RHS of 'any' will get optimised and deforested; but the InlineRule
will still mention the original RHS.
preInlineUnconditionally
......
......@@ -656,9 +656,10 @@ simplUnfolding env top_lvl _ _ _
(CoreUnfolding { uf_tmpl = expr, uf_arity = arity
, uf_guidance = guide@(InlineRule {}) })
= do { expr' <- simplExpr (setMode SimplGently env) expr
; let mb_wkr' = CoreSubst.substInlineRuleGuidance (mkCoreSubst env) (ug_ir_info guide)
-- See Note [Simplifying gently inside InlineRules] in SimplUtils
; let mb_wkr' = CoreSubst.substInlineRuleInfo (mkCoreSubst env) (ir_info guide)
; return (mkCoreUnfolding (isTopLevel top_lvl) expr' arity
(guide { ug_ir_info = mb_wkr' })) }
(guide { ir_info = mb_wkr' })) }
-- See Note [Top-level flag on inline rules] in CoreUnfold
simplUnfolding _ top_lvl _ occ_info new_rhs _
......
......@@ -29,7 +29,6 @@ import Name
import MkId ( voidArgId, realWorldPrimId )
import FiniteMap
import Maybes ( catMaybes, isJust )
import BasicTypes ( Arity )
import Bag
import Util
import Outputable
......@@ -809,15 +808,12 @@ specDefn subst body_uds fn rhs
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
fn_has_inline_rule :: Maybe (InlineRuleInfo, Arity) -- Gives arity of the *specialised* inline rule
fn_has_inline_rule
| Just inl <- isInlineRule_maybe fn_unf
= case inl of
InlWrapper _ -> Just (InlUnSat, spec_arity)
_ -> Just (inl, spec_arity)
| otherwise = Nothing
where
spec_arity = unfoldingArity fn_unf - n_dicts
fn_has_inline_rule :: Maybe InlSatFlag -- Derive sat-flag from existing thing
fn_has_inline_rule = case isInlineRule_maybe fn_unf of
Just (_,sat) -> Just sat
Nothing -> Nothing
spec_arity = unfoldingArity fn_unf - n_dicts -- Arity of the *specialised* inline rule
(rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs
......@@ -910,9 +906,9 @@ specDefn subst body_uds fn rhs
final_uds = foldr consDictBind rhs_uds dx_binds
-- See Note [Inline specialisations]
final_spec_f | Just (inl, spec_arity) <- fn_has_inline_rule
final_spec_f | Just sat <- fn_has_inline_rule
= spec_f_w_arity `setInlineActivation` inline_act
`setIdUnfolding` mkInlineRule inl spec_rhs spec_arity
`setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
-- I'm not sure this should be unconditionally InlSat
| otherwise
= spec_f_w_arity
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment