2 % (c) The AQUA Project, Glasgow University, 1994-1998
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 @CoreUnfolding@ unfolding, you will
13 find, unsurprisingly, a Core expression.
17 Unfolding, UnfoldingGuidance, -- Abstract types
19 noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding,
20 mkOtherCon, otherCons,
21 unfoldingTemplate, maybeUnfoldingTemplate,
22 isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
23 hasUnfolding, hasSomeUnfolding, neverUnfold,
25 couldBeSmallEnoughToInline,
32 #include "HsVersions.h"
34 import CmdLineOpts ( opt_UF_CreationThreshold,
36 opt_UF_FunAppDiscount,
38 opt_UF_DearOp, opt_UnfoldCasms,
39 DynFlags, DynFlag(..), dopt
42 import PprCore ( pprCoreExpr )
43 import OccurAnal ( occurAnalyseGlobalExpr )
44 import CoreUtils ( exprIsValue, exprIsCheap, exprIsTrivial )
45 import Id ( Id, idType, isId,
47 isFCallId_maybe, globalIdDetails
49 import DataCon ( isUnboxedTupleCon )
50 import Literal ( isLitLitLit, litSize )
51 import PrimOp ( primOpIsDupable, primOpOutOfLine )
52 import ForeignCall ( okToExposeFCall )
53 import IdInfo ( OccInfo(..), GlobalIdDetails(..) )
54 import Type ( isUnLiftedType )
55 import PrelNames ( hasKey, buildIdKey, augmentIdKey )
61 #if __GLASGOW_HASKELL__ >= 404
62 import GLAEXTS ( Int# )
67 %************************************************************************
69 \subsection{Making unfoldings}
71 %************************************************************************
74 mkTopUnfolding expr = mkUnfolding True {- Top level -} expr
76 mkUnfolding top_lvl expr
77 = CoreUnfolding (occurAnalyseGlobalExpr expr)
84 -- OK to inline inside a lambda
86 (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
87 -- Sometimes during simplification, there's a large let-bound thing
88 -- which has been substituted, and so is now dead; so 'expr' contains
89 -- two copies of the thing while the occurrence-analysed expression doesn't
90 -- Nevertheless, we don't occ-analyse before computing the size because the
91 -- size computation bales out after a while, whereas occurrence analysis does not.
93 -- This can occasionally mean that the guidance is very pessimistic;
94 -- it gets fixed up next round
96 mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
97 = CompulsoryUnfolding (occurAnalyseGlobalExpr expr)
101 %************************************************************************
103 \subsection{The UnfoldingGuidance type}
105 %************************************************************************
108 instance Outputable UnfoldingGuidance where
109 ppr UnfoldNever = ptext SLIT("NEVER")
110 ppr (UnfoldIfGoodArgs v cs size discount)
111 = hsep [ ptext SLIT("IF_ARGS"), int v,
112 brackets (hsep (map int cs)),
119 calcUnfoldingGuidance
120 :: Int -- bomb out if size gets bigger than this
121 -> CoreExpr -- expression to look at
123 calcUnfoldingGuidance bOMB_OUT_SIZE expr
124 = case collect_val_bndrs expr of { (inline, val_binders, body) ->
126 n_val_binders = length val_binders
128 max_inline_size = n_val_binders+2
129 -- The idea is that if there is an INLINE pragma (inline is True)
130 -- and there's a big body, we give a size of n_val_binders+2. This
131 -- This is just enough to fail the no-size-increase test in callSiteInline,
132 -- so that INLINE things don't get inlined into entirely boring contexts,
136 case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_binders body) of
139 | not inline -> UnfoldNever
140 -- A big function with an INLINE pragma must
141 -- have an UnfoldIfGoodArgs guidance
142 | inline -> UnfoldIfGoodArgs n_val_binders
143 (map (const 0) val_binders)
146 SizeIs size cased_args scrut_discount
149 (map discount_for val_binders)
151 (iBox scrut_discount)
153 boxed_size = iBox size
155 final_size | inline = boxed_size `min` max_inline_size
156 | otherwise = boxed_size
158 -- Sometimes an INLINE thing is smaller than n_val_binders+2.
159 -- A particular case in point is a constructor, which has size 1.
160 -- We want to inline this regardless, hence the `min`
162 discount_for b = foldlBag (\acc (b',n) -> if b==b' then acc+n else acc)
166 collect_val_bndrs e = go False [] e
167 -- We need to be a bit careful about how we collect the
168 -- value binders. In ptic, if we see
169 -- __inline_me (\x y -> e)
170 -- We want to say "2 value binders". Why? So that
171 -- we take account of information given for the arguments
173 go inline rev_vbs (Note InlineMe e) = go True rev_vbs e
174 go inline rev_vbs (Lam b e) | isId b = go inline (b:rev_vbs) e
175 | otherwise = go inline rev_vbs e
176 go inline rev_vbs e = (inline, reverse rev_vbs, e)
180 sizeExpr :: Int# -- Bomb out if it gets bigger than this
181 -> [Id] -- Arguments; we're interested in which of these
186 sizeExpr bOMB_OUT_SIZE top_args expr
189 size_up (Type t) = sizeZero -- Types cost nothing
190 size_up (Var v) = sizeOne
192 size_up (Note InlineMe body) = sizeOne -- Inline notes make it look very small
193 -- This can be important. If you have an instance decl like this:
194 -- instance Foo a => Foo [a] where
195 -- {-# INLINE op1, op2 #-}
198 -- then we'll get a dfun which is a pair of two INLINE lambdas
200 size_up (Note _ body) = size_up body -- Other notes cost nothing
202 size_up (App fun (Type t)) = size_up fun
203 size_up (App fun arg) = size_up_app fun [arg]
205 size_up (Lit lit) = sizeN (litSize lit)
207 size_up (Lam b e) | isId b = lamScrutDiscount (size_up e `addSizeN` 1)
208 | otherwise = size_up e
210 size_up (Let (NonRec binder rhs) body)
211 = nukeScrutDiscount (size_up rhs) `addSize`
212 size_up body `addSizeN`
213 (if isUnLiftedType (idType binder) then 0 else 1)
214 -- For the allocation
215 -- If the binder has an unlifted type there is no allocation
217 size_up (Let (Rec pairs) body)
218 = nukeScrutDiscount rhs_size `addSize`
219 size_up body `addSizeN`
220 length pairs -- For the allocation
222 rhs_size = foldr (addSize . size_up . snd) sizeZero pairs
224 size_up (Case (Var v) _ alts)
225 | v `elem` top_args -- We are scrutinising an argument variable
227 {- I'm nuking this special case; BUT see the comment with case alternatives.
229 (a) It's too eager. We don't want to inline a wrapper into a
230 context with no benefit.
231 E.g. \ x. f (x+x) no point in inlining (+) here!
233 (b) It's ineffective. Once g's wrapper is inlined, its case-expressions
234 aren't scrutinising arguments any more
238 [alt] -> size_up_alt alt `addSize` SizeIs 0# (unitBag (v, 1)) 0#
239 -- We want to make wrapper-style evaluation look cheap, so that
240 -- when we inline a wrapper it doesn't make call site (much) bigger
241 -- Otherwise we get nasty phase ordering stuff:
244 -- If we inline g's wrapper, f looks big, and doesn't get inlined
245 -- into h; if we inline f first, while it looks small, then g's
246 -- wrapper will get inlined later anyway. To avoid this nasty
247 -- ordering difference, we make (case a of (x,y) -> ...),
248 -- *where a is one of the arguments* look free.
252 alts_size (foldr addSize sizeOne alt_sizes) -- The 1 is for the scrutinee
253 (foldr1 maxSize alt_sizes)
255 -- Good to inline if an arg is scrutinised, because
256 -- that may eliminate allocation in the caller
257 -- And it eliminates the case itself
260 alt_sizes = map size_up_alt alts
262 -- alts_size tries to compute a good discount for
263 -- the case when we are scrutinising an argument variable
264 alts_size (SizeIs tot tot_disc tot_scrut) -- Size of all alternatives
265 (SizeIs max max_disc max_scrut) -- Size of biggest alternative
266 = SizeIs tot (unitBag (v, iBox (_ILIT 1 +# tot -# max)) `unionBags` max_disc) max_scrut
267 -- If the variable is known, we produce a discount that
268 -- will take us back to 'max', the size of rh largest alternative
269 -- The 1+ is a little discount for reduced allocation in the caller
270 alts_size tot_size _ = tot_size
273 size_up (Case e _ alts) = nukeScrutDiscount (size_up e) `addSize`
274 foldr (addSize . size_up_alt) sizeZero alts
275 -- We don't charge for the case itself
276 -- It's a strict thing, and the price of the call
277 -- is paid by scrut. Also consider
278 -- case f x of DEFAULT -> e
279 -- This is just ';'! Don't charge for it.
282 size_up_app (App fun arg) args
283 | isTypeArg arg = size_up_app fun args
284 | otherwise = size_up_app fun (arg:args)
285 size_up_app fun args = foldr (addSize . nukeScrutDiscount . size_up)
286 (size_up_fun fun args)
289 -- A function application with at least one value argument
290 -- so if the function is an argument give it an arg-discount
292 -- Also behave specially if the function is a build
294 -- Also if the function is a constant Id (constr or primop)
295 -- compute discounts specially
296 size_up_fun (Var fun) args
297 | fun `hasKey` buildIdKey = buildSize
298 | fun `hasKey` augmentIdKey = augmentSize
300 = case globalIdDetails fun of
301 DataConId dc -> conSizeN dc (valArgCount args)
303 FCallId fc -> sizeN opt_UF_DearOp
304 PrimOpId op -> primOpSize op (valArgCount args)
305 -- foldr addSize (primOpSize op) (map arg_discount args)
306 -- At one time I tried giving an arg-discount if a primop
307 -- is applied to one of the function's arguments, but it's
308 -- not good. At the moment, any unlifted-type arg gets a
309 -- 'True' for 'yes I'm evald', so we collect the discount even
310 -- if we know nothing about it. And just having it in a primop
311 -- doesn't help at all if we don't know something more.
313 other -> fun_discount fun `addSizeN`
314 (1 + length (filter (not . exprIsTrivial) args))
315 -- The 1+ is for the function itself
316 -- Add 1 for each non-trivial arg;
317 -- the allocation cost, as in let(rec)
318 -- Slight hack here: for constructors the args are almost always
319 -- trivial; and for primops they are almost always prim typed
320 -- We should really only count for non-prim-typed args in the
321 -- general case, but that seems too much like hard work
323 size_up_fun other args = size_up other
326 size_up_alt (con, bndrs, rhs) = size_up rhs
327 -- Don't charge for args, so that wrappers look cheap
328 -- (See comments about wrappers with Case)
331 -- We want to record if we're case'ing, or applying, an argument
332 fun_discount v | v `elem` top_args = SizeIs 0# (unitBag (v, opt_UF_FunAppDiscount)) 0#
333 fun_discount other = sizeZero
336 -- These addSize things have to be here because
337 -- I don't want to give them bOMB_OUT_SIZE as an argument
339 addSizeN TooBig _ = TooBig
340 addSizeN (SizeIs n xs d) m = mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
342 addSize TooBig _ = TooBig
343 addSize _ TooBig = TooBig
344 addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
345 = mkSizeIs bOMB_OUT_SIZE (n1 +# n2) (xs `unionBags` ys) (d1 +# d2)
348 Code for manipulating sizes
351 data ExprSize = TooBig
352 | SizeIs FastInt -- Size found
353 (Bag (Id,Int)) -- Arguments cased herein, and discount for each such
354 FastInt -- Size to subtract if result is scrutinised
355 -- by a case expression
357 -- subtract the discount before deciding whether to bale out. eg. we
358 -- want to inline a large constructor application into a selector:
359 -- tup = (a_1, ..., a_99)
360 -- x = case tup of ...
362 mkSizeIs max n xs d | (n -# d) ># max = TooBig
363 | otherwise = SizeIs n xs d
365 maxSize TooBig _ = TooBig
366 maxSize _ TooBig = TooBig
367 maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2 = s1
370 sizeZero = SizeIs (_ILIT 0) emptyBag (_ILIT 0)
371 sizeOne = SizeIs (_ILIT 1) emptyBag (_ILIT 0)
372 sizeN n = SizeIs (iUnbox n) emptyBag (_ILIT 0)
374 | isUnboxedTupleCon dc = SizeIs (_ILIT 0) emptyBag (iUnbox n +# _ILIT 1)
375 | otherwise = SizeIs (_ILIT 1) emptyBag (iUnbox n +# _ILIT 1)
376 -- Treat constructors as size 1; we are keen to expose them
377 -- (and we charge separately for their args). We can't treat
378 -- them as size zero, else we find that (iBox x) has size 1,
379 -- which is the same as a lone variable; and hence 'v' will
380 -- always be replaced by (iBox x), where v is bound to iBox x.
382 -- However, unboxed tuples count as size zero
383 -- I found occasions where we had
384 -- f x y z = case op# x y z of { s -> (# s, () #) }
385 -- and f wasn't getting inlined
388 | not (primOpIsDupable op) = sizeN opt_UF_DearOp
389 | not (primOpOutOfLine op) = sizeN (2 - n_args)
390 -- Be very keen to inline simple primops.
391 -- We give a discount of 1 for each arg so that (op# x y z) costs 2.
392 -- We can't make it cost 1, else we'll inline let v = (op# x y z)
393 -- at every use of v, which is excessive.
395 -- A good example is:
396 -- let x = +# p q in C {x}
397 -- Even though x get's an occurrence of 'many', its RHS looks cheap,
398 -- and there's a good chance it'll get inlined back into C's RHS. Urgh!
399 | otherwise = sizeOne
401 buildSize = SizeIs (-2#) emptyBag 4#
402 -- We really want to inline applications of build
403 -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
404 -- Indeed, we should add a result_discount becuause build is
405 -- very like a constructor. We don't bother to check that the
406 -- build is saturated (it usually is). The "-2" discounts for the \c n,
407 -- The "4" is rather arbitrary.
409 augmentSize = SizeIs (-2#) emptyBag 4#
410 -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
411 -- e plus ys. The -2 accounts for the \cn
413 nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
414 nukeScrutDiscount TooBig = TooBig
416 -- When we return a lambda, give a discount if it's used (applied)
417 lamScrutDiscount (SizeIs n vs d) = case opt_UF_FunAppDiscount of { d -> SizeIs n vs (iUnbox d) }
418 lamScrutDiscount TooBig = TooBig
422 %************************************************************************
424 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
426 %************************************************************************
428 We have very limited information about an unfolding expression: (1)~so
429 many type arguments and so many value arguments expected---for our
430 purposes here, we assume we've got those. (2)~A ``size'' or ``cost,''
431 a single integer. (3)~An ``argument info'' vector. For this, what we
432 have at the moment is a Boolean per argument position that says, ``I
433 will look with great favour on an explicit constructor in this
434 position.'' (4)~The ``discount'' to subtract if the expression
435 is being scrutinised.
437 Assuming we have enough type- and value arguments (if not, we give up
438 immediately), then we see if the ``discounted size'' is below some
439 (semi-arbitrary) threshold. It works like this: for every argument
440 position where we're looking for a constructor AND WE HAVE ONE in our
441 hands, we get a (again, semi-arbitrary) discount [proportion to the
442 number of constructors in the type being scrutinized].
444 If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
445 and the expression in question will evaluate to a constructor, we use
446 the computed discount size *for the result only* rather than
447 computing the argument discounts. Since we know the result of
448 the expression is going to be taken apart, discounting its size
449 is more accurate (see @sizeExpr@ above for how this discount size
452 We use this one to avoid exporting inlinings that we ``couldn't possibly
453 use'' on the other side. Can be overridden w/ flaggery.
454 Just the same as smallEnoughToInline, except that it has no actual arguments.
457 couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
458 couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold rhs of
462 certainlyWillInline :: Unfolding -> Bool
463 -- Sees if the unfolding is pretty certain to inline
464 certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
465 = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
466 certainlyWillInline other
470 @okToUnfoldInHifile@ is used when emitting unfolding info into an interface
471 file to determine whether an unfolding candidate really should be unfolded.
472 The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
473 into interface files.
475 The reason for inlining expressions containing _casm_s into interface files
476 is that these fragments of C are likely to mention functions/#defines that
477 will be out-of-scope when inlined into another module. This is not an
478 unfixable problem for the user (just need to -#include the approp. header
479 file), but turning it off seems to the simplest thing to do.
482 okToUnfoldInHiFile :: CoreExpr -> Bool
483 okToUnfoldInHiFile e = opt_UnfoldCasms || go e
485 -- Race over an expression looking for CCalls..
486 go (Var v) = case isFCallId_maybe v of
487 Just fcall -> okToExposeFCall fcall
489 go (Lit lit) = not (isLitLitLit lit)
490 go (App fun arg) = go fun && go arg
491 go (Lam _ body) = go body
492 go (Let binds body) = and (map go (body :rhssOfBind binds))
493 go (Case scrut bndr alts) = and (map go (scrut:rhssOfAlts alts)) &&
494 not (any isLitLitLit [ lit | (LitAlt lit, _, _) <- alts ])
495 go (Note _ body) = go body
500 %************************************************************************
502 \subsection{callSiteInline}
504 %************************************************************************
506 This is the key function. It decides whether to inline a variable at a call site
508 callSiteInline is used at call sites, so it is a bit more generous.
509 It's a very important function that embodies lots of heuristics.
510 A non-WHNF can be inlined if it doesn't occur inside a lambda,
511 and occurs exactly once or
512 occurs once in each branch of a case and is small
514 If the thing is in WHNF, there's no danger of duplicating work,
515 so we can inline if it occurs once, or is small
517 NOTE: we don't want to inline top-level functions that always diverge.
518 It just makes the code bigger. Tt turns out that the convenient way to prevent
519 them inlining is to give them a NOINLINE pragma, which we do in
520 StrictAnal.addStrictnessInfoToTopId
523 callSiteInline :: DynFlags
524 -> Bool -- True <=> the Id can be inlined
525 -> Bool -- 'inline' note at call site
528 -> [Bool] -- One for each value arg; True if it is interesting
529 -> Bool -- True <=> continuation is interesting
530 -> Maybe CoreExpr -- Unfolding, if any
533 callSiteInline dflags active_inline inline_call occ id arg_infos interesting_cont
534 = case idUnfolding id of {
535 NoUnfolding -> Nothing ;
536 OtherCon cs -> Nothing ;
538 CompulsoryUnfolding unf_template -> Just unf_template ;
539 -- CompulsoryUnfolding => there is no top-level binding
540 -- for these things, so we must inline it.
541 -- Only a couple of primop-like things have
542 -- compulsory unfoldings (see MkId.lhs).
543 -- We don't allow them to be inactive
545 CoreUnfolding unf_template is_top is_value is_cheap guidance ->
548 result | yes_or_no = Just unf_template
549 | otherwise = Nothing
551 n_val_args = length arg_infos
554 | not active_inline = False
555 | otherwise = case occ of
556 IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False
557 IAmALoopBreaker -> False
558 OneOcc in_lam one_br -> (not in_lam || is_cheap) && consider_safe in_lam True one_br
559 NoOccInfo -> is_cheap && consider_safe True False False
561 consider_safe in_lam once once_in_one_branch
562 -- consider_safe decides whether it's a good idea to inline something,
563 -- given that there's no work-duplication issue (the caller checks that).
564 -- once_in_one_branch = True means there's a unique textual occurrence
568 -- Be very keen to inline something if this is its unique occurrence:
570 -- a) Inlining gives a good chance of eliminating the original
571 -- binding (and hence the allocation) for the thing.
572 -- (Provided it's not a top level binding, in which case the
573 -- allocation costs nothing.)
575 -- b) Inlining a function that is called only once exposes the
576 -- body function to the call site.
578 -- The only time we hold back is when substituting inside a lambda;
579 -- then if the context is totally uninteresting (not applied, not scrutinised)
580 -- there is no point in substituting because it might just increase allocation,
581 -- by allocating the function itself many times
582 -- Note [Jan 2002]: this comment looks out of date. The actual code
583 -- doesn't inline *ever* in an uninteresting context. Why not? I
584 -- think it's just because we don't want to inline top-level constants
585 -- into uninteresting contexts, lest we (for example) re-nest top-level
588 -- Note: there used to be a '&& not top_level' in the guard above,
589 -- but that stopped us inlining top-level functions used only once,
591 = WARN( not is_top && not in_lam, ppr id )
592 -- If (not in_lam) && one_br then PreInlineUnconditionally
593 -- should have caught it, shouldn't it? Unless it's a top
595 notNull arg_infos || interesting_cont
599 UnfoldNever -> False ;
600 UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
602 | enough_args && size <= (n_vals_wanted + 1)
603 -- Inline unconditionally if there no size increase
604 -- Size of call is n_vals_wanted (+1 for the function)
608 -> some_benefit && small_enough
611 some_benefit = or arg_infos || really_interesting_cont ||
612 (not is_top && (once || (n_vals_wanted > 0 && enough_args)))
613 -- If it occurs more than once, there must be something interesting
614 -- about some argument, or the result context, to make it worth inlining
616 -- If a function has a nested defn we also record some-benefit,
617 -- on the grounds that we are often able to eliminate the binding,
618 -- and hence the allocation, for the function altogether; this is good
619 -- for join points. But this only makes sense for *functions*;
620 -- inlining a constructor doesn't help allocation unless the result is
621 -- scrutinised. UNLESS the constructor occurs just once, albeit possibly
622 -- in multiple case branches. Then inlining it doesn't increase allocation,
623 -- but it does increase the chance that the constructor won't be allocated at all
624 -- in the branches that don't use it.
626 enough_args = n_val_args >= n_vals_wanted
627 really_interesting_cont | n_val_args < n_vals_wanted = False -- Too few args
628 | n_val_args == n_vals_wanted = interesting_cont
629 | otherwise = True -- Extra args
630 -- really_interesting_cont tells if the result of the
631 -- call is in an interesting context.
633 small_enough = (size - discount) <= opt_UF_UseThreshold
634 discount = computeDiscount n_vals_wanted arg_discounts res_discount
635 arg_infos really_interesting_cont
638 if dopt Opt_D_dump_inlinings dflags then
639 pprTrace "Considering inlining"
640 (ppr id <+> vcat [text "active:" <+> ppr active_inline,
641 text "occ info:" <+> ppr occ,
642 text "arg infos" <+> ppr arg_infos,
643 text "interesting continuation" <+> ppr interesting_cont,
644 text "is value:" <+> ppr is_value,
645 text "is cheap:" <+> ppr is_cheap,
646 text "guidance" <+> ppr guidance,
647 text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO",
649 text "Unfolding =" <+> pprCoreExpr unf_template
656 computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Bool -> Int
657 computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used
658 -- We multiple the raw discounts (args_discount and result_discount)
659 -- ty opt_UnfoldingKeenessFactor because the former have to do with
660 -- *size* whereas the discounts imply that there's some extra
661 -- *efficiency* to be gained (e.g. beta reductions, case reductions)
664 -- we also discount 1 for each argument passed, because these will
665 -- reduce with the lambdas in the function (we count 1 for a lambda
667 = 1 + -- Discount of 1 because the result replaces the call
668 -- so we count 1 for the function itself
669 length (take n_vals_wanted arg_infos) +
670 -- Discount of 1 for each arg supplied, because the
671 -- result replaces the call
672 round (opt_UF_KeenessFactor *
673 fromIntegral (arg_discount + result_discount))
675 arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
677 mk_arg_discount discount is_evald | is_evald = discount
680 -- Don't give a result discount unless there are enough args
681 result_discount | result_used = res_discount -- Over-applied, or case scrut