2 % (c) The AQUA Project, Glasgow University, 1994-1996
4 \section[CoreUnfold]{Core-syntax unfoldings}
6 Unfoldings (which can travel across module boundaries) are in Core
7 syntax (namely @CoreExpr@s).
9 The type @Unfolding@ sits ``above'' simply-Core-expressions
10 unfoldings, capturing ``higher-level'' things we know about a binding,
11 usually things that the simplifier found out (e.g., ``it's a
12 literal''). In the corner of a @SimpleUnfolding@ unfolding, you will
13 find, unsurprisingly, a Core expression.
17 SimpleUnfolding(..), Unfolding(..), UnfoldingGuidance(..), -- types
19 FormSummary(..), mkFormSummary, whnfOrBottom, exprSmallEnoughToDup,
22 noUnfolding, mkMagicUnfolding, mkUnfolding, getUnfoldingTemplate,
24 smallEnoughToInline, couldBeSmallEnoughToInline,
25 certainlySmallEnoughToInline, inlineUnconditionally,
27 calcUnfoldingGuidance,
29 PragmaInfo(..) -- Re-export
32 #include "HsVersions.h"
34 import {-# SOURCE #-} MagicUFs ( MagicUnfoldingFun, mkMagicUnfoldingFun )
36 import CmdLineOpts ( opt_UnfoldingCreationThreshold,
37 opt_UnfoldingUseThreshold,
38 opt_UnfoldingConDiscount,
39 opt_UnfoldingKeenessFactor
41 import Constants ( uNFOLDING_CHEAP_OP_COST,
42 uNFOLDING_DEAR_OP_COST,
43 uNFOLDING_NOREP_LIT_COST
45 import BinderInfo ( BinderInfo, isOneFunOcc, isOneSafeFunOcc
47 import PragmaInfo ( PragmaInfo(..) )
49 import CoreUtils ( unTagBinders )
50 import OccurAnal ( occurAnalyseGlobalExpr )
51 import CoreUtils ( coreExprType )
52 import Id ( Id, idType, getIdArity, isBottomingId, isDataCon,
53 idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
54 IdSet, GenId{-instances-} )
55 import PrimOp ( fragilePrimOp, primOpCanTriggerGC )
56 import IdInfo ( ArityInfo(..) )
57 import Literal ( isNoRepLit )
58 import TyCon ( tyConFamilySize )
59 import Type ( splitAlgTyConApp_maybe )
60 import Unique ( Unique )
61 import Util ( isIn, panic, assertPanic )
65 %************************************************************************
67 \subsection{@Unfolding@ and @UnfoldingGuidance@ types}
69 %************************************************************************
75 | CoreUnfolding SimpleUnfolding
78 Unique -- Unique of the Id whose magic unfolding this is
83 = SimpleUnfolding -- An unfolding with redundant cached information
84 FormSummary -- Tells whether the template is a WHNF or bottom
85 UnfoldingGuidance -- Tells about the *size* of the template.
86 SimplifiableCoreExpr -- Template
89 noUnfolding = NoUnfolding
91 mkUnfolding inline_prag expr
93 -- strictness mangling (depends on there being no CSE)
94 ufg = calcUnfoldingGuidance inline_prag opt_UnfoldingCreationThreshold expr
95 occ = occurAnalyseGlobalExpr expr
96 cuf = CoreUnfolding (SimpleUnfolding (mkFormSummary expr) ufg occ)
98 cont = case occ of { Var _ -> cuf; _ -> cuf }
100 case ufg of { UnfoldAlways -> cont; _ -> cont }
102 mkMagicUnfolding :: Unique -> Unfolding
103 mkMagicUnfolding tag = MagicUnfolding tag (mkMagicUnfoldingFun tag)
105 getUnfoldingTemplate :: Unfolding -> CoreExpr
106 getUnfoldingTemplate (CoreUnfolding (SimpleUnfolding _ _ expr))
108 getUnfoldingTemplate other = panic "getUnfoldingTemplate"
111 data UnfoldingGuidance
113 | UnfoldAlways -- There is no "original" definition,
114 -- so you'd better unfold. Or: something
115 -- so cheap to unfold (e.g., 1#) that
116 -- you should do it absolutely always.
118 | UnfoldIfGoodArgs Int -- if "m" type args
119 Int -- and "n" value args
121 [Int] -- Discount if the argument is evaluated.
122 -- (i.e., a simplification will definitely
123 -- be possible). One elt of the list per *value* arg.
125 Int -- The "size" of the unfolding; to be elaborated
128 Int -- Scrutinee discount: the discount to substract if the thing is in
129 -- a context (case (thing args) of ...),
130 -- (where there are the right number of arguments.)
134 instance Outputable UnfoldingGuidance where
135 ppr UnfoldAlways = ptext SLIT("_ALWAYS_")
136 ppr (UnfoldIfGoodArgs t v cs size discount)
137 = hsep [ptext SLIT("_IF_ARGS_"), int t, int v,
138 if null cs -- always print *something*
140 else hcat (map (text . show) cs),
146 %************************************************************************
148 \subsection{Figuring out things about expressions}
150 %************************************************************************
154 = VarForm -- Expression is a variable (or scc var, etc)
155 | ValueForm -- Expression is a value: i.e. a value-lambda,constructor, or literal
156 | BottomForm -- Expression is guaranteed to be bottom. We're more gung
157 -- ho about inlining such things, because it can't waste work
158 | OtherForm -- Anything else
160 instance Outputable FormSummary where
161 ppr VarForm = ptext SLIT("Var")
162 ppr ValueForm = ptext SLIT("Value")
163 ppr BottomForm = ptext SLIT("Bot")
164 ppr OtherForm = ptext SLIT("Other")
166 mkFormSummary ::GenCoreExpr bndr Id flexi -> FormSummary
169 = go (0::Int) expr -- The "n" is the number of (value) arguments so far
171 go n (Lit _) = ASSERT(n==0) ValueForm
172 go n (Con _ _) = ASSERT(n==0) ValueForm
173 go n (Prim _ _) = OtherForm
174 go n (SCC _ e) = go n e
175 go n (Coerce _ _ e) = go n e
177 go n (Let (NonRec b r) e) | exprIsTrivial r = go n e -- let f = f' alpha in (f,g)
178 -- should be treated as a value
179 go n (Let _ e) = OtherForm
180 go n (Case _ _) = OtherForm
182 go 0 (Lam (ValBinder x) e) = ValueForm -- NB: \x.bottom /= bottom!
183 go n (Lam (ValBinder x) e) = go (n-1) e -- Applied lambda
184 go n (Lam other_binder e) = go n e
186 go n (App fun arg) | isValArg arg = go (n+1) fun
187 go n (App fun other_arg) = go n fun
189 go n (Var f) | isBottomingId f = BottomForm
190 | isDataCon f = ValueForm -- Can happen inside imported unfoldings
191 go 0 (Var f) = VarForm
192 go n (Var f) = case getIdArity f of
193 ArityExactly a | n < a -> ValueForm
194 ArityAtLeast a | n < a -> ValueForm
197 whnfOrBottom :: FormSummary -> Bool
198 whnfOrBottom VarForm = True
199 whnfOrBottom ValueForm = True
200 whnfOrBottom BottomForm = True
201 whnfOrBottom OtherForm = False
204 @exprIsTrivial@ is true of expressions we are unconditionally happy to duplicate;
205 simple variables and constants, and type applications.
208 exprIsTrivial (Var v) = True
209 exprIsTrivial (Lit lit) = not (isNoRepLit lit)
210 exprIsTrivial (App e (TyArg _)) = exprIsTrivial e
211 exprIsTrivial (Coerce _ _ e) = exprIsTrivial e
212 exprIsTrivial other = False
216 exprSmallEnoughToDup (Con _ _) = True -- Could check # of args
217 exprSmallEnoughToDup (Prim op _) = not (fragilePrimOp op) -- Could check # of args
218 exprSmallEnoughToDup (Lit lit) = not (isNoRepLit lit)
219 exprSmallEnoughToDup (Coerce _ _ e) = exprSmallEnoughToDup e
220 exprSmallEnoughToDup expr
221 = case (collectArgs expr) of { (fun, _, vargs) ->
223 Var v | length vargs <= 4 -> True
230 %************************************************************************
232 \subsection[calcUnfoldingGuidance]{Calculate ``unfolding guidance'' for an expression}
234 %************************************************************************
237 calcUnfoldingGuidance
238 :: PragmaInfo -- INLINE pragma stuff
239 -> Int -- bomb out if size gets bigger than this
240 -> CoreExpr -- expression to look at
243 calcUnfoldingGuidance IMustBeINLINEd bOMB_OUT_SIZE expr = UnfoldAlways -- Always inline if the INLINE pragma says so
244 calcUnfoldingGuidance IWantToBeINLINEd bOMB_OUT_SIZE expr = UnfoldAlways -- Always inline if the INLINE pragma says so
245 calcUnfoldingGuidance IMustNotBeINLINEd bOMB_OUT_SIZE expr = UnfoldNever -- ...and vice versa...
247 calcUnfoldingGuidance NoPragmaInfo bOMB_OUT_SIZE expr
248 = case collectBinders expr of { (ty_binders, val_binders, body) ->
249 case (sizeExpr bOMB_OUT_SIZE val_binders body) of
251 TooBig -> UnfoldNever
253 SizeIs size cased_args scrut_discount
257 (map discount_for val_binders)
262 | is_data && b `is_elem` cased_args = tyConFamilySize tycon
266 = case (splitAlgTyConApp_maybe (idType b)) of
267 Nothing -> (False, panic "discount")
268 Just (tc,_,_) -> (True, tc)
270 is_elem = isIn "calcUnfoldingGuidance" }
274 sizeExpr :: Int -- Bomb out if it gets bigger than this
275 -> [Id] -- Arguments; we're interested in which of these
280 sizeExpr (I# bOMB_OUT_SIZE) args expr
283 size_up (Var v) = sizeZero
284 size_up (Lit lit) | isNoRepLit lit = sizeN uNFOLDING_NOREP_LIT_COST
285 | otherwise = sizeZero
287 size_up (SCC lbl body) = size_up body -- SCCs cost nothing
288 size_up (Coerce _ _ body) = size_up body -- Coercions cost nothing
290 size_up (App fun arg) = size_up fun `addSize` size_up_arg arg
291 -- NB Zero cost for for type applications;
292 -- others cost 1 or more
294 size_up (Con con args) = conSizeN (numValArgs args)
295 -- We don't count 1 for the constructor because we're
296 -- quite keen to get constructors into the open
298 size_up (Prim op args) = sizeN op_cost -- NB: no charge for PrimOp args
300 op_cost = if primOpCanTriggerGC op
301 then uNFOLDING_DEAR_OP_COST
302 -- these *tend* to be more expensive;
303 -- number chosen to avoid unfolding (HACK)
304 else uNFOLDING_CHEAP_OP_COST
306 size_up expr@(Lam _ _)
308 (tyvars, args, body) = collectBinders expr
310 size_up body `addSizeN` length args
312 size_up (Let (NonRec binder rhs) body)
313 = nukeScrutDiscount (size_up rhs)
317 size_up (Let (Rec pairs) body)
318 = nukeScrutDiscount (foldr addSize sizeZero [size_up rhs | (_,rhs) <- pairs])
322 size_up (Case scrut alts)
323 = nukeScrutDiscount (size_up scrut)
327 size_up_alts (coreExprType scrut) alts
328 -- We charge for the "case" itself in "size_up_alts"
331 -- In an application we charge 0 for type application
332 -- 1 for most anything else
334 size_up_arg (LitArg lit) | isNoRepLit lit = sizeN uNFOLDING_NOREP_LIT_COST
335 size_up_arg (TyArg _) = sizeZero
336 size_up_arg other = sizeOne
339 size_up_alts scrut_ty (AlgAlts alts deflt)
340 = (foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts)
344 size_alg_alt (con,args,rhs) = size_up rhs
345 -- Don't charge for args, so that wrappers look cheap
347 -- NB: we charge N for an alg. "case", where N is
348 -- the number of constructors in the thing being eval'd.
349 -- (You'll eventually get a "discount" of N if you
350 -- think the "case" is likely to go away.)
351 -- It's important to charge for alternatives. If you don't then you
352 -- get size 1 for things like:
353 -- case x of { A -> 1#; B -> 2#; ... lots }
357 = case (splitAlgTyConApp_maybe scrut_ty) of
359 Just (tc,_,_) -> tyConFamilySize tc
361 size_up_alts _ (PrimAlts alts deflt)
362 = foldr (addSize . size_prim_alt) (size_up_deflt deflt) alts
363 -- *no charge* for a primitive "case"!
365 size_prim_alt (lit,rhs) = size_up rhs
368 size_up_deflt NoDefault = sizeZero
369 size_up_deflt (BindDefault binder rhs) = size_up rhs
372 -- We want to record if we're case'ing an argument
373 arg_discount (Var v) | v `is_elem` args = scrutArg v
374 arg_discount other = sizeZero
376 is_elem :: Id -> [Id] -> Bool
377 is_elem = isIn "size_up_scrut"
380 -- These addSize things have to be here because
381 -- I don't want to give them bOMB_OUT_SIZE as an argument
383 addSizeN TooBig _ = TooBig
384 addSizeN (SizeIs n xs d) (I# m)
385 | n_tot -# d <# bOMB_OUT_SIZE = SizeIs n_tot xs d
390 addSize TooBig _ = TooBig
391 addSize _ TooBig = TooBig
392 addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
393 | (n_tot -# d_tot) <# bOMB_OUT_SIZE = SizeIs n_tot xys d_tot
403 Code for manipulating sizes
407 data ExprSize = TooBig
408 | SizeIs Int# -- Size found
409 [Id] -- Arguments cased herein
410 Int# -- Size to subtract if result is scrutinised
411 -- by a case expression
413 sizeZero = SizeIs 0# [] 0#
414 sizeOne = SizeIs 1# [] 0#
415 sizeN (I# n) = SizeIs n [] 0#
416 conSizeN (I# n) = SizeIs n [] n
417 scrutArg v = SizeIs 0# [v] 0#
419 nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
420 nukeScrutDiscount TooBig = TooBig
423 %************************************************************************
425 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
427 %************************************************************************
429 We have very limited information about an unfolding expression: (1)~so
430 many type arguments and so many value arguments expected---for our
431 purposes here, we assume we've got those. (2)~A ``size'' or ``cost,''
432 a single integer. (3)~An ``argument info'' vector. For this, what we
433 have at the moment is a Boolean per argument position that says, ``I
434 will look with great favour on an explicit constructor in this
435 position.'' (4)~The ``discount'' to subtract if the expression
436 is being scrutinised.
438 Assuming we have enough type- and value arguments (if not, we give up
439 immediately), then we see if the ``discounted size'' is below some
440 (semi-arbitrary) threshold. It works like this: for every argument
441 position where we're looking for a constructor AND WE HAVE ONE in our
442 hands, we get a (again, semi-arbitrary) discount [proportion to the
443 number of constructors in the type being scrutinized].
445 If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
446 and the expression in question will evaluate to a constructor, we use
447 the computed discount size *for the result only* rather than
448 computing the argument discounts. Since we know the result of
449 the expression is going to be taken apart, discounting its size
450 is more accurate (see @sizeExpr@ above for how this discount size
454 smallEnoughToInline :: [Bool] -- Evaluated-ness of value arguments
455 -> Bool -- Result is scrutinised
457 -> Bool -- True => unfold it
459 smallEnoughToInline _ _ UnfoldAlways = True
460 smallEnoughToInline _ _ UnfoldNever = False
461 smallEnoughToInline arg_is_evald_s result_is_scruted
462 (UnfoldIfGoodArgs m_tys_wanted n_vals_wanted discount_vec size scrut_discount)
463 = if enough_args n_vals_wanted arg_is_evald_s &&
464 size - discount <= opt_UnfoldingUseThreshold
466 pprTrace "small enough" (int size <+> int discount) True
471 enough_args n [] | n > 0 = False -- A function with no value args => don't unfold
472 enough_args _ _ = True -- Otherwise it's ok to try
474 -- We multiple the raw discounts (args_discount and result_discount)
475 -- ty opt_UnfoldingKeenessFactor because the former have to do with
476 -- *size* whereas the discounts imply that there's some extra *efficiency*
477 -- to be gained (e.g. beta reductions, case reductions) by inlining.
480 opt_UnfoldingKeenessFactor *
481 fromInt (args_discount + result_discount)
484 args_discount = sum (zipWith arg_discount discount_vec arg_is_evald_s)
485 result_discount | result_is_scruted = scrut_discount
488 arg_discount no_of_constrs is_evald
489 | is_evald = 1 + no_of_constrs * opt_UnfoldingConDiscount
493 We use this one to avoid exporting inlinings that we ``couldn't possibly
494 use'' on the other side. Can be overridden w/ flaggery.
495 Just the same as smallEnoughToInline, except that it has no actual arguments.
499 couldBeSmallEnoughToInline :: UnfoldingGuidance -> Bool
500 couldBeSmallEnoughToInline guidance = smallEnoughToInline (repeat True) True guidance
502 certainlySmallEnoughToInline :: UnfoldingGuidance -> Bool
503 certainlySmallEnoughToInline guidance = smallEnoughToInline (repeat False) False guidance
509 @inlineUnconditionally@ decides whether a let-bound thing can
510 *definitely* be inlined at each of its call sites. If so, then
511 we can drop the binding right away. But remember, you have to be
512 certain that every use can be inlined. So, notably, any ArgOccs
513 rule this out. Since ManyOcc doesn't record FunOcc/ArgOcc
516 inlineUnconditionally :: Bool -> Id -> BinderInfo -> Bool
518 inlineUnconditionally ok_to_dup id occ_info
519 | idMustNotBeINLINEd id = False
521 | isOneFunOcc occ_info
522 && idMustBeINLINEd id = True
524 | isOneSafeFunOcc (ok_to_dup || idWantsToBeINLINEd id) occ_info