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 1 -- For the allocation
319 size_up (Let (Rec pairs) body)
320 = nukeScrutDiscount (foldr addSize sizeZero [size_up rhs | (_,rhs) <- pairs])
324 length pairs -- For the allocation
326 size_up (Case scrut alts)
327 = nukeScrutDiscount (size_up scrut)
331 size_up_alts (coreExprType scrut) alts
332 -- We charge for the "case" itself in "size_up_alts"
335 -- In an application we charge 0 for type application
336 -- 1 for most anything else
338 size_up_arg (LitArg lit) | isNoRepLit lit = sizeN uNFOLDING_NOREP_LIT_COST
339 size_up_arg (TyArg _) = sizeZero
340 size_up_arg other = sizeOne
343 size_up_alts scrut_ty (AlgAlts alts deflt)
344 = (foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts)
348 size_alg_alt (con,args,rhs) = size_up rhs
349 -- Don't charge for args, so that wrappers look cheap
351 -- NB: we charge N for an alg. "case", where N is
352 -- the number of constructors in the thing being eval'd.
353 -- (You'll eventually get a "discount" of N if you
354 -- think the "case" is likely to go away.)
355 -- It's important to charge for alternatives. If you don't then you
356 -- get size 1 for things like:
357 -- case x of { A -> 1#; B -> 2#; ... lots }
361 = case (splitAlgTyConApp_maybe scrut_ty) of
363 Just (tc,_,_) -> tyConFamilySize tc
365 size_up_alts _ (PrimAlts alts deflt)
366 = foldr (addSize . size_prim_alt) (size_up_deflt deflt) alts
367 -- *no charge* for a primitive "case"!
369 size_prim_alt (lit,rhs) = size_up rhs
372 size_up_deflt NoDefault = sizeZero
373 size_up_deflt (BindDefault binder rhs) = size_up rhs
376 -- We want to record if we're case'ing an argument
377 arg_discount (Var v) | v `is_elem` args = scrutArg v
378 arg_discount other = sizeZero
380 is_elem :: Id -> [Id] -> Bool
381 is_elem = isIn "size_up_scrut"
384 -- These addSize things have to be here because
385 -- I don't want to give them bOMB_OUT_SIZE as an argument
387 addSizeN TooBig _ = TooBig
388 addSizeN (SizeIs n xs d) (I# m)
389 | n_tot -# d <# bOMB_OUT_SIZE = SizeIs n_tot xs d
394 addSize TooBig _ = TooBig
395 addSize _ TooBig = TooBig
396 addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
397 | (n_tot -# d_tot) <# bOMB_OUT_SIZE = SizeIs n_tot xys d_tot
407 Code for manipulating sizes
411 data ExprSize = TooBig
412 | SizeIs Int# -- Size found
413 [Id] -- Arguments cased herein
414 Int# -- Size to subtract if result is scrutinised
415 -- by a case expression
417 sizeZero = SizeIs 0# [] 0#
418 sizeOne = SizeIs 1# [] 0#
419 sizeN (I# n) = SizeIs n [] 0#
420 conSizeN (I# n) = SizeIs n [] n
421 scrutArg v = SizeIs 0# [v] 0#
423 nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
424 nukeScrutDiscount TooBig = TooBig
427 %************************************************************************
429 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
431 %************************************************************************
433 We have very limited information about an unfolding expression: (1)~so
434 many type arguments and so many value arguments expected---for our
435 purposes here, we assume we've got those. (2)~A ``size'' or ``cost,''
436 a single integer. (3)~An ``argument info'' vector. For this, what we
437 have at the moment is a Boolean per argument position that says, ``I
438 will look with great favour on an explicit constructor in this
439 position.'' (4)~The ``discount'' to subtract if the expression
440 is being scrutinised.
442 Assuming we have enough type- and value arguments (if not, we give up
443 immediately), then we see if the ``discounted size'' is below some
444 (semi-arbitrary) threshold. It works like this: for every argument
445 position where we're looking for a constructor AND WE HAVE ONE in our
446 hands, we get a (again, semi-arbitrary) discount [proportion to the
447 number of constructors in the type being scrutinized].
449 If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
450 and the expression in question will evaluate to a constructor, we use
451 the computed discount size *for the result only* rather than
452 computing the argument discounts. Since we know the result of
453 the expression is going to be taken apart, discounting its size
454 is more accurate (see @sizeExpr@ above for how this discount size
458 smallEnoughToInline :: Id -- The function (for trace msg only)
459 -> [Bool] -- Evaluated-ness of value arguments
460 -> Bool -- Result is scrutinised
462 -> Bool -- True => unfold it
464 smallEnoughToInline _ _ _ UnfoldAlways = True
465 smallEnoughToInline _ _ _ UnfoldNever = False
466 smallEnoughToInline id arg_is_evald_s result_is_scruted
467 (UnfoldIfGoodArgs m_tys_wanted n_vals_wanted discount_vec size scrut_discount)
468 = if enough_args n_vals_wanted arg_is_evald_s &&
469 size - discount <= opt_UnfoldingUseThreshold
471 -- pprTrace "small enough" (ppr id <+> int size <+> int discount)
477 enough_args n [] | n > 0 = False -- A function with no value args => don't unfold
478 enough_args _ _ = True -- Otherwise it's ok to try
480 -- We multiple the raw discounts (args_discount and result_discount)
481 -- ty opt_UnfoldingKeenessFactor because the former have to do with
482 -- *size* whereas the discounts imply that there's some extra *efficiency*
483 -- to be gained (e.g. beta reductions, case reductions) by inlining.
486 opt_UnfoldingKeenessFactor *
487 fromInt (args_discount + result_discount)
490 args_discount = sum (zipWith arg_discount discount_vec arg_is_evald_s)
491 result_discount | result_is_scruted = scrut_discount
494 arg_discount no_of_constrs is_evald
495 | is_evald = no_of_constrs * opt_UnfoldingConDiscount
499 We use this one to avoid exporting inlinings that we ``couldn't possibly
500 use'' on the other side. Can be overridden w/ flaggery.
501 Just the same as smallEnoughToInline, except that it has no actual arguments.
504 couldBeSmallEnoughToInline :: Id -> UnfoldingGuidance -> Bool
505 couldBeSmallEnoughToInline id guidance = smallEnoughToInline id (repeat True) True guidance
507 certainlySmallEnoughToInline :: Id -> UnfoldingGuidance -> Bool
508 certainlySmallEnoughToInline id guidance = smallEnoughToInline id (repeat False) False guidance
514 @inlineUnconditionally@ decides whether a let-bound thing can
515 *definitely* be inlined at each of its call sites. If so, then
516 we can drop the binding right away. But remember, you have to be
517 certain that every use can be inlined. So, notably, any ArgOccs
518 rule this out. Since ManyOcc doesn't record FunOcc/ArgOcc
521 inlineUnconditionally :: Bool -> Id -> BinderInfo -> Bool
523 inlineUnconditionally ok_to_dup id occ_info
524 | idMustNotBeINLINEd id = False
526 | isOneFunOcc occ_info
527 && idMustBeINLINEd id = True
529 | isOneSafeFunOcc (ok_to_dup || idWantsToBeINLINEd id) occ_info